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 $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;
      }
   }

   for my $guild (keys %slaying) {
      $count{$guild} = @{ $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 {
   init;
   print STDERR "Guild:              members:\n";
   print $slaying{$_} . " " x (20 - length $slaying{$_}) . $count{$_} . "\n"
      for keys %slaying;
}

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

   if ($guild) {
      print STDERR "Members for guild " . $slaying{$guild} . ":\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;
Usage: perl guilds.pl [max|avg|cnt|lst <guild> [<max age>]]

   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 <guild>. lst without <guild> lists all guild names
         <max age> is the maximum time in days a player can be logged out
         and still appear on the list

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;
} elsif ($ARGV[0] eq "lst") {
   members_list $ARGV[1], $ARGV[2];
} else {
   usage;
}
Revision:	1.5
Committed:	Sun Dec 3 01:27:45 2006 UTC (17 years, 6 months ago) by pippijn
Content type:	text/plain
Branch:	MAIN
Changes since 1.4:	+26 -12 lines
Log Message:	- added the option to provide a maximum age for players to show up in the lst <guild> function - I am now writing comments in output to STDERR. this allows me to do things like "perl guilds.pl max \| sort -k2n" without also sorting the comments
#	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 $mtime = (stat $pl)[9];
36			my $pldata = do { local $/; open my $fh, "<$pl/$pl.pl" or die "$pl/$pl.pl: $!"; <$fh> };
37
38			for my $guild (keys %slaying) {
39			$pldata =~ /^slaying $slaying{$guild}$/m && push @{ $members{$guild} }, $pl;
40			}
41			}
42
43			for my $guild (keys %slaying) {
44			$count{$guild} = @{ $members{$guild} };
45			}
46			}
47	pippijn	1.1
48			sub in_days {
49			my ($secs) = @_;
50			($NOW - $secs) / 3600 / 24;
51			}
52
53	pippijn	1.3	sub guild_list {
54	pippijn	1.5	print STDERR "short name full name\n";
55			print STDERR "-" x 27 . "\n";
56	pippijn	1.3	print "$_" . (length $_ == 3 ? "" : " ") . " " x 15 . $slaying{$_} . "\n" for keys %slaying;
57			}
58
59	pippijn	1.1	sub members_mtime_avg {
60	pippijn	1.5	my %mtime;
61	pippijn	1.3	init;
62	pippijn	1.5	print STDERR "Guild: mtime:\n";
63			print STDERR "-" x 26 . "\n";
64	pippijn	1.3	for my $guild (keys %slaying) {
65			for my $member (@{ $members{$guild} }) {
66			$mtime{$guild} += (stat "$member")[9];
67			}
68			$mtime{$guild} /= $count{$guild};
69			print $slaying{$guild} . " " x (20 - length $slaying{$guild}) . in_days($mtime{$guild}) . "\n";
70	pippijn	1.1	}
71			}
72
73			sub members_mtime_max {
74	pippijn	1.5	my %mtime;
75	pippijn	1.3	init;
76	pippijn	1.5	print STDERR "Guild: mtime:\n";
77			print STDERR "-" x 26 . "\n";
78	pippijn	1.3	for my $guild (keys %slaying) {
79			for my $member (@{ $members{$guild} }) {
80			$mtime{$guild} = max +(stat $member)[9], $mtime{$guild};
81			}
82			print $slaying{$guild} . " " x (20 - length $slaying{$guild}) . in_days($mtime{$guild}) . "\n";
83	pippijn	1.1	}
84			}
85
86	pippijn	1.2	sub members_cnt {
87	pippijn	1.3	init;
88	pippijn	1.5	print STDERR "Guild: members:\n";
89	pippijn	1.3	print $slaying{$_} . " " x (20 - length $slaying{$_}) . $count{$_} . "\n"
90			for keys %slaying;
91			}
92
93			sub members_list {
94	pippijn	1.5	my ($guild, $age) = @_;
95	pippijn	1.3	init;
96
97			if ($guild) {
98	pippijn	1.5	print STDERR "Members for guild " . $slaying{$guild} . ":\n";
99			print STDERR "-" x 31 . "\n";
100
101			if ($age) {
102			for my $member (@{ $members{$guild} }) {
103			if ($NOW - (stat $member)[9] < $age * 24 * 3600) {
104			print "$member\n";
105			}
106			}
107			} else {
108			print "$_\n" for @{ $members{$guild} };
109			}
110	pippijn	1.3	} else {
111			guild_list;
112			return;
113			}
114	pippijn	1.2	}
115
116	pippijn	1.1	sub usage {
117			print <<USAGE;
118	pippijn	1.5	Usage: perl guilds.pl [max\|avg\|cnt\|lst <guild> [<max age>]]
119	pippijn	1.1
120			max: max(mtime of all guild members) for each guild
121			avg: average mtime of all guild members for each guild
122	pippijn	1.2	cnt: member count (number of players owning a key)
123	pippijn	1.3	lst: list members for <guild>. lst without <guild> lists all guild names
124	pippijn	1.5	<max age> is the maximum time in days a player can be logged out
125			and still appear on the list
126	pippijn	1.1
127			Copyright (C) 2006 The Crossfire+ Development Team
128			USAGE
129			}
130
131			if ($ARGV[0] eq "max") {
132			members_mtime_max;
133			} elsif ($ARGV[0] eq "avg") {
134			members_mtime_avg;
135	pippijn	1.2	} elsif ($ARGV[0] eq "cnt") {
136			members_cnt;
137	pippijn	1.3	} elsif ($ARGV[0] eq "lst") {
138	pippijn	1.5	members_list $ARGV[1], $ARGV[2];
139	pippijn	1.1	} else {
140			usage;
141			}