Added support for collecting data about users, posts, and comments.

1 files changed, 210 insertions, 14 deletions

diff --git a/stats.pl b/stats.pl
index 5c5b407..cb65417 100755
--- a/stats.pl
+++ b/stats.pl
@@ -6,6 +6,8 @@ use warnings;
 use LWP::Simple;
 use Data::Dumper;
 use RRD::Simple ();
+use LWP::UserAgent;
+use LWP::Protocol::socks;
 
 my $rrd_path = "/home/marius/appdrift";
 my $score_url = "http://128.39.121.4/purser/scoreboard.txt";
@@ -17,6 +19,17 @@ my @group_colors = qw(
 		000066 3366CC CC00CC 800000 CC0099
 	);
 
+sub proxy_get {
+	my $remote = shift;
+
+	my $ua = new LWP::UserAgent(agent => 'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.0.5) Gecko/20060719 Firefox/1.5.0.5');
+	$ua->proxy([ qw(http https) ] => 'socks://localhost:9090');
+
+	my $response = $ua->get($remote);
+
+	return $response->content;
+}
+
 my $groups = {};
 
 my @content = split /^-+$/m, get($score_url);
@@ -51,21 +64,47 @@ for my $section (@content) {
 	$groups->{$user} = {
 		position	=> $position,
 		balance		=> $balance,
+		server		=> $endpoint,
 		time_up		=> $time_up,
 		time_maint	=> $time_maint,
 		time_down	=> $time_down,
 	}
 }
 
-my $position_rrd = RRD::Simple->new( file => "$rrd_path/rrd/positions.rrd" );
-my $balance_rrd = RRD::Simple->new( file => "$rrd_path/rrd/balance.rrd" );
+for my $group (sort keys %$groups) {
+	my ($users, $posts, $comments) = (undef);
+
+	my $content = proxy_get("http://".$groups->{$group}->{'server'});
+
+	for my $line (split /\n/, $content) {
+		last if (defined($users) && defined($posts) && defined($comments));
+		last if ($line =~ /Last activity/i);
+		next if (length $line < 1);
+
+		if ($line =~ /Users:[^0-9]*(\d+)/i) {
+			$users = $1;
+		} elsif ($line =~ /Posts:[^0-9]*(\d+)/i) {
+			$posts = $1;
+		} elsif ($line =~ /Comments:[^0-9]*(\d+)/i) {
+			$comments = $1;
+		}
+	}
+
+	$groups->{$group}->{'users'} = defined($users) ? $users : 0;
+	$groups->{$group}->{'posts'} = defined($posts) ? $posts : 0;
+	$groups->{$group}->{'comments'} = defined($comments) ? $comments : 0;
+}
 
 my %rrd_groups = ();
 my %positions = ();
 my %balance = ();
+my %www_users = ();
+my %posts = ();
+my %comments = ();
 
 for my $group (sort keys %$groups) {
 	my $uptime_rrd = RRD::Simple->new( file => "$rrd_path/rrd/$group-uptime.rrd" );
+	my $users_rrd  = RRD::Simple->new( file => "$rrd_path/rrd/$group-users.rrd" );
 
 	unless ( -f "$rrd_path/rrd/$group-uptime.rrd" ) {
 		$uptime_rrd->create(
@@ -75,18 +114,36 @@ for my $group (sort keys %$groups) {
 			);
 	}
 
+	unless ( -f "$rrd_path/rrd/$group-users.rrd" ) {
+		$users_rrd->create(
+				users		=> "GAUGE",
+				maintenance	=> "GAUGE",
+				downtime	=> "GAUGE",
+			);
+	}
+
 	$uptime_rrd->update(
 			uptime		=> $groups->{$group}->{'time_up'},
 			maintenance	=> $groups->{$group}->{'time_maint'},
 			downtime	=> $groups->{$group}->{'time_down'},
 		);
 	
-	unless ( -d "$rrd_path/graph/$group" ) {
-		mkdir "$rrd_path/graph/$group";
+	$users_rrd->update(
+			users		=> $groups->{$group}->{'users'},
+			posts		=> $groups->{$group}->{'posts'},
+			comments	=> $groups->{$group}->{'comments'},
+		);
+	
+	unless ( -d "$rrd_path/graph/score/$group" ) {
+		mkdir "$rrd_path/graph/score/$group";
+	}
+
+	unless ( -d "$rrd_path/graph/users/$group" ) {
+		mkdir "$rrd_path/graph/users/$group";
 	}
 
 	my %times_rtn = $uptime_rrd->graph(
-			destination		=> "$rrd_path/graph/$group",
+			destination		=> "$rrd_path/graph/score/$group",
 			basename		=> "all-times",
 			sources			=> [ qw(uptime maintenance downtime) ],
 			source_colors	=> [ qw(00CC00 0000FF FF0000) ],
@@ -99,7 +156,7 @@ for my $group (sort keys %$groups) {
 		);
 
 	my %uptime_rtn = $uptime_rrd->graph(
-			destination		=> "$rrd_path/graph/$group",
+			destination		=> "$rrd_path/graph/score/$group",
 			basename		=> "uptime",
 			sources			=> [ qw(uptime) ],
 			source_colors	=> [ qw(00CC00) ],
@@ -112,7 +169,7 @@ for my $group (sort keys %$groups) {
 		);
 	
 	my %mainttime_rtn = $uptime_rrd->graph(
-			destination		=> "$rrd_path/graph/$group",
+			destination		=> "$rrd_path/graph/score/$group",
 			basename		=> "maintenance",
 			sources			=> [ qw(maintenance) ],
 			source_colors	=> [ qw(0000FF) ],
@@ -125,7 +182,7 @@ for my $group (sort keys %$groups) {
 		);
 
 	my %downtime_rtn = $uptime_rrd->graph(
-			destination		=> "$rrd_path/graph/$group",
+			destination		=> "$rrd_path/graph/score/$group",
 			basename		=> "downtime",
 			sources			=> [ qw(downtime) ],
 			source_colors	=> [ qw(FF0000) ],
@@ -137,16 +194,83 @@ for my $group (sort keys %$groups) {
 			timestamp		=> "both",
 		);
 
+	my %all_stats_rtn = $users_rrd->graph(
+			destination		=> "$rrd_path/graph/users/$group",
+			basename		=> "all",
+			sources			=> [ qw(users posts comments) ],
+			source_colors	=> [ qw(00CC00 0000FF FF0000) ],
+			periods			=> [ qw(day week month) ],
+			title			=> "Users/Posts/Comments for $group",
+			vertical_label	=> "Count",
+			interlaced		=> "",
+			extended_legend	=> "true",
+			timestamp		=> "both",
+		);
+	
+	my %users_rtn = $users_rrd->graph(
+			destination		=> "$rrd_path/graph/users/$group",
+			basename		=> "users",
+			sources			=> [ qw(users) ],
+			source_colors	=> [ qw(00CC00) ],
+			periods			=> [ qw(day week month) ],
+			title			=> "User count for $group",
+			vertical_label	=> "Nr. of users",
+			interlaced		=> "",
+			extended_legend	=> "true",
+			timestamp		=> "both",
+		);
+
+	my %posts_rtn = $users_rrd->graph(
+			destination	=> "$rrd_path/graph/users/$group",
+			basename		=> "posts",
+			sources			=> [ qw(posts) ],
+			source_colors	=> [ qw(0000FF) ],
+			periods			=> [ qw(day week month) ],
+			title			=> "Post count for $group",
+			vertical_label	=> "Nr. of posts",
+			interlaced		=> "",
+			extended_legend	=> "true",
+			timestamp		=> "both",
+		);
+
+	my %comments_rtn = $users_rrd->graph(
+			destination		=> "$rrd_path/graph/users/$group",
+			basename		=> "comments",
+			sources			=> [ qw(comments) ],
+			source_colors	=> [ qw(FF0000) ],
+			periods			=> [ qw(day week month) ],
+			title			=> "Comment count for $group",
+			vertical_label	=> "Nr. of comments",
+			interlaced		=> "",
+			extended_legend	=> "true",
+			timestamp		=> "both",
+		);
+
 	$rrd_groups{$group} = "GAUGE";
 	$positions{$group} = $groups->{$group}->{'position'};
 	$balance{$group} = $groups->{$group}->{'balance'};
+	$www_users{$group} = $groups->{$group}->{'users'};
+	$posts{$group} = $groups->{$group}->{'posts'};
+	$comments{$group} = $groups->{$group}->{'comments'};
 }
 
 my $pos_rrd = "$rrd_path/rrd/positions.rrd";
 my $bal_rrd = "$rrd_path/rrd/balance.rrd";
+my $usr_rrd = "$rrd_path/rrd/users.rrd";
+my $pst_rrd = "$rrd_path/rrd/posts.rrd";
+my $cmt_rrd = "$rrd_path/rrd/comments.rrd";
+
+my $position_rrd = RRD::Simple->new( file => "$pos_rrd" );
+my $balance_rrd = RRD::Simple->new( file => "$bal_rrd" );
+my $user_rrd = RRD::Simple->new( file => "$usr_rrd" );
+my $post_rrd = RRD::Simple->new( file => "$pst_rrd" );
+my $comment_rrd = RRD::Simple->new( file => "$cmt_rrd" );
 
 $position_rrd->create( %rrd_groups ) unless ( -f "$pos_rrd" );
 $balance_rrd->create( %rrd_groups ) unless ( -f "$bal_rrd" );
+$user_rrd->create( %rrd_groups ) unless ( -f "$usr_rrd" );
+$post_rrd->create( %rrd_groups ) unless ( -f "$pst_rrd" );
+$comment_rrd->create( %rrd_groups ) unless ( -f "$cmt_rrd" );
 
 my @pos_sources = $position_rrd->sources("$pos_rrd");
 pos_sources: for my $group (keys %positions) {
@@ -154,7 +278,7 @@ pos_sources: for my $group (keys %positions) {
 		next pos_sources if ($source eq $group);
 	}
 
-	$position_rrd->add_source("$pos_rrd", $group => $rrd_groups{$group})
+	$position_rrd->add_source("$pos_rrd", $group => $rrd_groups{$group});
 }
 
 my @bal_sources = $balance_rrd->sources("$bal_rrd");
@@ -163,17 +287,49 @@ bal_sources: for my $group (keys %balance) {
 		next bal_sources if ($source eq $group);
 	}
 
-	$balance_rrd->add_source("$bal_rrd", $group => $rrd_groups{$group})
+	$balance_rrd->add_source("$bal_rrd", $group => $rrd_groups{$group});
+}
+
+my @usr_sources = $user_rrd->sources("$usr_rrd");
+usr_sources: for my $group (keys %www_users) {
+	for my $source (@usr_sources) {
+		next usr_sources if ($source eq $group);
+	}
+
+	$user_rrd->add_source("$usr_rrd", $group => $rrd_groups{$group});
+}
+
+my @pst_sources = $user_rrd->sources("$pst_rrd");
+pst_sources: for my $group (keys %posts) {
+	for my $source (@pst_sources) {
+		next pst_sources if ($source eq $group);
+	}
+
+	$post_rrd->add_source("$pst_rrd", $group => $rrd_groups{$group});
+}
+
+my @cmt_sources = $comment_rrd->sources("$cmt_rrd");
+cmt_sources: for my $group (keys %posts) {
+	for my $source (@cmt_sources) {
+		next cmt_sources if ($source eq $group);
+	}
+
+	$comment_rrd->add_source("$cmt_rrd", $group => $rrd_groups{$group});
 }
 
 $position_rrd->update( %positions );
 $balance_rrd->update( %balance );
+$user_rrd->update( %www_users );
+$post_rrd->update( %posts );
+$comment_rrd->update( %comments );
+
 
 my @group_names = sort(keys(%$groups));
 $#group_colors = $#group_names;
 
 my %position_rtn = $position_rrd->graph(
-		destination		=> "$rrd_path/graph",
+		destination		=> "$rrd_path/graph/score",
+		basename		=> "positions",
 		periods			=> [ qw(day week month) ],
 		sources			=> [ @group_names ],
 		source_colors	=> [ @group_colors ],
@@ -185,7 +341,8 @@ my %position_rtn = $position_rrd->graph(
 	);
 
 my %balance_rtn = $balance_rrd->graph(
-		destination		=> "$rrd_path/graph",
+		destination		=> "$rrd_path/graph/score",
+		basename		=> "balance",
 		periods			=> [ qw(day week month) ],
 		sources			=> [ @group_names ],
 		source_colors	=> [ @group_colors ],
@@ -196,9 +353,48 @@ my %balance_rtn = $balance_rrd->graph(
 		timestamp		=> "both",
 	);
 
+my %users_rtn = $user_rrd->graph(
+		destination		=> "$rrd_path/graph/users",
+		basename		=> "users",
+		periods			=> [ qw(day week month) ],
+		sources			=> [ @group_names ],
+		source_colors	=> [ @group_colors ],
+		title			=> "Number of users per group",
+		vertical_label	=> "Nr. of users",
+		interlaced		=> "",
+		extended_legend	=> "true",
+		timestamp		=> "both",
+	);
+
+my %posts_rtn = $post_rrd->graph(
+		destination		=> "$rrd_path/graph/users",
+		basename		=> "posts",
+		periods			=> [ qw(day week month) ],
+		sources			=> [ @group_names ],
+		source_colors	=> [ @group_colors ],
+		title			=> "Number of posts per group",
+		vertical_label	=> "Nr. of posts",
+		interlaced		=> "",
+		extended_legend	=> "true",
+		timestamp		=> "both",
+	);
+
+my %comments_rtn = $comment_rrd->graph(
+		destination		=> "$rrd_path/graph/users",
+		basename		=> "comments",
+		periods			=> [ qw(day week month) ],
+		sources			=> [ @group_names ],
+		source_colors	=> [ @group_colors ],
+		title			=> "Number of comments per group",
+		vertical_label	=> "Nr. of comments",
+		interlaced		=> "",
+		extended_legend	=> "true",
+		timestamp		=> "both",
+	);
+
 for my $group (@group_names) {
 	my %grp_bal = $balance_rrd->graph(
-			destination		=> "$rrd_path/graph/$group",
+			destination		=> "$rrd_path/graph/score/$group",
 			basename		=> "balance",
 			periods			=> [ qw(day week month) ],
 			sources			=> [ $group ],
@@ -211,7 +407,7 @@ for my $group (@group_names) {
 		);
 
 	my %grp_pos = $position_rrd->graph(
-			destination		=> "$rrd_path/graph/$group",
+			destination		=> "$rrd_path/graph/score/$group",
 			basename		=> "position",
 			periods			=> [ qw(day week month) ],
 			sources			=> [ $group ],