deliantra/util/guilds.pl

#!/usr/bin/env perl

# Script to help drawing conclusions on guild activity
# Usage is at the bottom

use strict;
use List::Util qw(max);

my $PLAYERDIR = "/var/crossfire/players";

my $NOW = time;

my %slaying = (
   bs  => "black_shield",
   dh  => "damned_heretics",
   ds  => "dreaming_sage",
   db  => "drunken_barbarian",
   ls  => "laughing_skull",
   mf  => "mailed_fist",
   pd  => "poisoned_dagger",
   pb  => "purple_butterfly",
   sc  => "smoking_cauldron",
   ki  => "ketsueki_itsuryuu",
   ny  => "nenshou_youso",
   zdr => "zaseki_dzuki_ryoku"
);

my %members;
my %count;

sub init {
   chdir $PLAYERDIR;

   for my $pl (<*>) {
      my $pldata = do { local $/; open my $fh, "<$pl/$pl.pl" or die "$pl/$pl.pl: $!"; <$fh> };

      for my $guild (keys %slaying) {
         $pldata =~ /^slaying $slaying{$guild}$/m && push @{ $members{$guild} }, $pl;
      }
   }

   for my $guild (keys %slaying) {
      $count{$guild} = @{ $members{$guild} };
   }
}

sub init_with_age {
   my ($age) = @_;
   chdir $PLAYERDIR;

   for my $pl (<*>) {
      my $mtime = (stat $pl)[9];
      my $pldata = do { local $/; open my $fh, "<$pl/$pl.pl" or die "$pl/$pl.pl: $!"; <$fh> };

      for my $guild (keys %slaying) {
         $pldata =~ /^slaying $slaying{$guild}$/m && push @{ $members{$guild} }, $pl
            if ($NOW - $mtime < $age * 24 * 3600);
      }
   }

   for my $guild (keys %slaying) {
      $count{$guild} = @{ $members{$guild} } if $members{$guild};
   }
}

sub in_days {
   my ($secs) = @_;
   ($NOW - $secs) / 3600 / 24;
}

sub guild_list {
   print STDERR "short name        full name\n";
   print STDERR "-" x 27 . "\n";
   print "$_" . (length $_ == 3 ? "" : " ") . " " x 15 . $slaying{$_} . "\n" for keys %slaying;
}

sub members_mtime_avg {
   my %mtime;
   init;

   print STDERR "Guild:              mtime:\n";
   print STDERR "-" x 26 . "\n";
   for my $guild (keys %slaying) {
      for my $member (@{ $members{$guild} }) {
         $mtime{$guild} += (stat "$member")[9];
      }
      $mtime{$guild} /= $count{$guild};
      print $slaying{$guild} . " " x (20 - length $slaying{$guild}) . in_days($mtime{$guild}) . "\n";
   }
}

sub members_mtime_max {
   my %mtime;
   init;

   print STDERR "Guild:              mtime:\n";
   print STDERR "-" x 26 . "\n";
   for my $guild (keys %slaying) {
      for my $member (@{ $members{$guild} }) {
         $mtime{$guild} = max +(stat $member)[9], $mtime{$guild};
      }
      print $slaying{$guild} . " " x (20 - length $slaying{$guild}) . in_days($mtime{$guild}) . "\n";
   }
}

sub members_cnt {
   my ($age) = @_;
   if ($age) {
      init_with_age $age;
      print STDERR "Guild member count for members with mtime < $age days\n";
   } else {
      init;
      print STDERR "Guild member count\n";
   }

   print STDERR "Guild:              members:\n";
   print STDERR "-" x 28 . "\n";
   print $slaying{$_} . " " x (20 - length $slaying{$_}) . ($count{$_} or 0) . "\n"
      for keys %slaying;
} 

sub members_list {
   my ($guild, $age) = @_;
   init;

   if ($guild) {
      print STDERR "Members for guild " . $slaying{$guild} . ($age ? " with mtime < $age" : "") . ":\n";
      print STDERR "-" x 31 . "\n";

      if ($age) {
         for my $member (@{ $members{$guild} }) {
            if ($NOW - (stat $member)[9] < $age * 24 * 3600) {
               print "$member\n";
            }
         }
      } else {
         print "$_\n" for @{ $members{$guild} };
      }
   } else {
      guild_list;
      return;
   }
}

sub usage {
   print <<USAGE;
\033[1mUsage: perl guilds.pl max|avg|cnt|lst <guild> [<max age>]\033[0m

   max:  max(mtime of all guild members) for each guild
   avg:  average mtime of all guild members for each guild
   cnt:  member count (number of players owning a key)
   lst:  list members for \033[1m<guild>\033[0m. lst without \033[1m<guild>\033[0m lists all guild names

   The optional <max age> is the maximum time in days a player can be
   logged out and still appear on the list. \033[1m<max age>\033[0m only applies
   to \033[1mcnt\033[0m and \033[1mlst\033[0m.

Copyright (C) 2006 The Crossfire+ Development Team
USAGE
}

if ($ARGV[0] eq "max") {
   members_mtime_max;
} elsif ($ARGV[0] eq "avg") {
   members_mtime_avg;
} elsif ($ARGV[0] eq "cnt") {
   members_cnt $ARGV[1];
} elsif ($ARGV[0] eq "lst") {
   members_list $ARGV[1], $ARGV[2];
} else {
   usage;
}
Revision:	1.9
Committed:	Fri Jan 5 23:59:06 2007 UTC (17 years, 4 months ago) by pippijn
Content type:	text/plain
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.8:	+0 -0 lines
State:	*FILE REMOVED*
Log Message:	moved file
#	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	pippijn	1.7	if ($age) {
109			init_with_age $age;
110			print STDERR "Guild member count for members with mtime < $age days\n";
111			} else {
112			init;
113			print STDERR "Guild member count\n";
114			}
115	pippijn	1.6
116	pippijn	1.5	print STDERR "Guild: members:\n";
117	pippijn	1.6	print STDERR "-" x 28 . "\n";
118			print $slaying{$_} . " " x (20 - length $slaying{$_}) . ($count{$_} or 0) . "\n"
119	pippijn	1.3	for keys %slaying;
120	pippijn	1.6	}
121	pippijn	1.3
122			sub members_list {
123	pippijn	1.5	my ($guild, $age) = @_;
124	pippijn	1.3	init;
125
126			if ($guild) {
127	pippijn	1.8	print STDERR "Members for guild " . $slaying{$guild} . ($age ? " with mtime < $age" : "") . ":\n";
128	pippijn	1.5	print STDERR "-" x 31 . "\n";
129
130			if ($age) {
131			for my $member (@{ $members{$guild} }) {
132			if ($NOW - (stat $member)[9] < $age * 24 * 3600) {
133			print "$member\n";
134			}
135			}
136			} else {
137			print "$_\n" for @{ $members{$guild} };
138			}
139	pippijn	1.3	} else {
140			guild_list;
141			return;
142			}
143	pippijn	1.2	}
144
145	pippijn	1.1	sub usage {
146			print <<USAGE;
147	pippijn	1.6	\033[1mUsage: perl guilds.pl max\|avg\|cnt\|lst <guild> [<max age>]\033[0m
148	pippijn	1.1
149			max: max(mtime of all guild members) for each guild
150			avg: average mtime of all guild members for each guild
151	pippijn	1.2	cnt: member count (number of players owning a key)
152	pippijn	1.6	lst: list members for \033[1m<guild>\033[0m. lst without \033[1m<guild>\033[0m lists all guild names
153
154			The optional <max age> is the maximum time in days a player can be
155			logged out and still appear on the list. \033[1m<max age>\033[0m only applies
156			to \033[1mcnt\033[0m and \033[1mlst\033[0m.
157	pippijn	1.1
158			Copyright (C) 2006 The Crossfire+ Development Team
159			USAGE
160			}
161
162			if ($ARGV[0] eq "max") {
163			members_mtime_max;
164			} elsif ($ARGV[0] eq "avg") {
165			members_mtime_avg;
166	pippijn	1.2	} elsif ($ARGV[0] eq "cnt") {
167	pippijn	1.6	members_cnt $ARGV[1];
168	pippijn	1.3	} elsif ($ARGV[0] eq "lst") {
169	pippijn	1.5	members_list $ARGV[1], $ARGV[2];
170	pippijn	1.1	} else {
171			usage;
172			}