ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/util/guilds.pl
Revision: 1.6
Committed: Sun Dec 3 12:03:58 2006 UTC (17 years, 6 months ago) by pippijn
Content type: text/plain
Branch: MAIN
Changes since 1.5: +37 -9 lines
Log Message:
added age option for membercount

File Contents

# User Rev Content
1 pippijn 1.1 #!/usr/bin/env perl
2    
3 pippijn 1.4 # Script to help drawing conclusions on guild activity
4 pippijn 1.1 # Usage is at the bottom
5    
6     use strict;
7 pippijn 1.3 use List::Util qw(max);
8 pippijn 1.1
9     my $PLAYERDIR = "/var/crossfire/players";
10    
11     my $NOW = time;
12    
13 pippijn 1.3 my %slaying = (
14     bs => "black_shield",
15     dh => "damned_heretics",
16     ds => "dreaming_sage",
17     db => "drunken_barbarian",
18     ls => "laughing_skull",
19     mf => "mailed_fist",
20     pd => "poisoned_dagger",
21     pb => "purple_butterfly",
22     sc => "smoking_cauldron",
23     ki => "ketsueki_itsuryuu",
24     ny => "nenshou_youso",
25     zdr => "zaseki_dzuki_ryoku"
26     );
27    
28     my %members;
29     my %count;
30    
31     sub init {
32     chdir $PLAYERDIR;
33    
34     for my $pl (<*>) {
35     my $pldata = do { local $/; open my $fh, "<$pl/$pl.pl" or die "$pl/$pl.pl: $!"; <$fh> };
36    
37     for my $guild (keys %slaying) {
38     $pldata =~ /^slaying $slaying{$guild}$/m && push @{ $members{$guild} }, $pl;
39     }
40     }
41    
42     for my $guild (keys %slaying) {
43     $count{$guild} = @{ $members{$guild} };
44     }
45     }
46 pippijn 1.1
47 pippijn 1.6 sub init_with_age {
48     my ($age) = @_;
49     chdir $PLAYERDIR;
50    
51     for my $pl (<*>) {
52     my $mtime = (stat $pl)[9];
53     my $pldata = do { local $/; open my $fh, "<$pl/$pl.pl" or die "$pl/$pl.pl: $!"; <$fh> };
54    
55     for my $guild (keys %slaying) {
56     $pldata =~ /^slaying $slaying{$guild}$/m && push @{ $members{$guild} }, $pl
57     if ($NOW - $mtime < $age * 24 * 3600);
58     }
59     }
60    
61     for my $guild (keys %slaying) {
62     $count{$guild} = @{ $members{$guild} } if $members{$guild};
63     }
64     }
65    
66 pippijn 1.1 sub in_days {
67     my ($secs) = @_;
68     ($NOW - $secs) / 3600 / 24;
69     }
70    
71 pippijn 1.3 sub guild_list {
72 pippijn 1.5 print STDERR "short name full name\n";
73     print STDERR "-" x 27 . "\n";
74 pippijn 1.3 print "$_" . (length $_ == 3 ? "" : " ") . " " x 15 . $slaying{$_} . "\n" for keys %slaying;
75     }
76    
77 pippijn 1.1 sub members_mtime_avg {
78 pippijn 1.5 my %mtime;
79 pippijn 1.3 init;
80 pippijn 1.6
81 pippijn 1.5 print STDERR "Guild: mtime:\n";
82     print STDERR "-" x 26 . "\n";
83 pippijn 1.3 for my $guild (keys %slaying) {
84     for my $member (@{ $members{$guild} }) {
85     $mtime{$guild} += (stat "$member")[9];
86     }
87     $mtime{$guild} /= $count{$guild};
88     print $slaying{$guild} . " " x (20 - length $slaying{$guild}) . in_days($mtime{$guild}) . "\n";
89 pippijn 1.1 }
90     }
91    
92     sub members_mtime_max {
93 pippijn 1.5 my %mtime;
94 pippijn 1.3 init;
95 pippijn 1.6
96 pippijn 1.5 print STDERR "Guild: mtime:\n";
97     print STDERR "-" x 26 . "\n";
98 pippijn 1.3 for my $guild (keys %slaying) {
99     for my $member (@{ $members{$guild} }) {
100     $mtime{$guild} = max +(stat $member)[9], $mtime{$guild};
101     }
102     print $slaying{$guild} . " " x (20 - length $slaying{$guild}) . in_days($mtime{$guild}) . "\n";
103 pippijn 1.1 }
104     }
105    
106 pippijn 1.2 sub members_cnt {
107 pippijn 1.6 my ($age) = @_;
108     init_with_age $age
109     if $age;
110     init
111     unless $age;
112    
113 pippijn 1.5 print STDERR "Guild: members:\n";
114 pippijn 1.6 print STDERR "-" x 28 . "\n";
115     print $slaying{$_} . " " x (20 - length $slaying{$_}) . ($count{$_} or 0) . "\n"
116 pippijn 1.3 for keys %slaying;
117 pippijn 1.6 }
118 pippijn 1.3
119     sub members_list {
120 pippijn 1.5 my ($guild, $age) = @_;
121 pippijn 1.3 init;
122    
123     if ($guild) {
124 pippijn 1.5 print STDERR "Members for guild " . $slaying{$guild} . ":\n";
125     print STDERR "-" x 31 . "\n";
126    
127     if ($age) {
128     for my $member (@{ $members{$guild} }) {
129     if ($NOW - (stat $member)[9] < $age * 24 * 3600) {
130     print "$member\n";
131     }
132     }
133     } else {
134     print "$_\n" for @{ $members{$guild} };
135     }
136 pippijn 1.3 } else {
137     guild_list;
138     return;
139     }
140 pippijn 1.2 }
141    
142 pippijn 1.1 sub usage {
143     print <<USAGE;
144 pippijn 1.6 \033[1mUsage: perl guilds.pl max|avg|cnt|lst <guild> [<max age>]\033[0m
145 pippijn 1.1
146     max: max(mtime of all guild members) for each guild
147     avg: average mtime of all guild members for each guild
148 pippijn 1.2 cnt: member count (number of players owning a key)
149 pippijn 1.6 lst: list members for \033[1m<guild>\033[0m. lst without \033[1m<guild>\033[0m lists all guild names
150    
151     The optional <max age> is the maximum time in days a player can be
152     logged out and still appear on the list. \033[1m<max age>\033[0m only applies
153     to \033[1mcnt\033[0m and \033[1mlst\033[0m.
154 pippijn 1.1
155     Copyright (C) 2006 The Crossfire+ Development Team
156     USAGE
157     }
158    
159     if ($ARGV[0] eq "max") {
160     members_mtime_max;
161     } elsif ($ARGV[0] eq "avg") {
162     members_mtime_avg;
163 pippijn 1.2 } elsif ($ARGV[0] eq "cnt") {
164 pippijn 1.6 members_cnt $ARGV[1];
165 pippijn 1.3 } elsif ($ARGV[0] eq "lst") {
166 pippijn 1.5 members_list $ARGV[1], $ARGV[2];
167 pippijn 1.1 } else {
168     usage;
169     }