Category: PerlMonks Related Scripts
Author/Contact Info ase
Description: Here's my contribution to statistics nuts like myself.
This utility Logs in to Perlmonks (using ZZamboni's PerlmonksChat module), gets your writeup page and creates 3 plots from the data, which are ftp'd to a server of your choice.
I run it every few days to update the graphs. All modules besides are available at CPAN. See my home node for an example of the results.

Update: I no longer post the graphs on my home node. The updated code given in the replies to this node is more modern. Thanks to everyone for the kind comments I received when I first wrote this.

#!/usr/bin/perl -w
#mstats Version 1.0
#7/29/2000 by ase  (
#Freely redistributable under the same terms as perl itself.
use strict;              #Of course.
use PerlMonksChat;       #access perlmonks and get the page
use HTML::TableExtract;  #extract the HTML table 
use Date::Manip;         #manipulate the Create times
use GD::Graph::lines3d;  #create the plots
use Net::FTP;            #Send them to a webserver

#user configuration
$Date::Manip::TZ='PST5PDT';  #timezone:see Date::Manip docs 
my $user = 'ase';            #monk Username (change)

#ftp info
my $ftpurl  = 'CHANGETHIS.ftp';  #ftp url
my $ftpuser = 'CHANGETHIS';   #user name
my $ftppass = '*******';    #passwd (protect this script)
#end of user configuration

#users home node (shouldn't have to change)
my $url = "" .
          "node=Perl+Monks+User+Search&" .

my $p = new PerlMonksChat;   #Create Chat Object
$p->add_cookies();           #Get the login cookie

my $c = $p->getpage($url);       #get the users home node
$c=~s/bgcolor=>/bgcolor="">/mg;  #makes HTML::TableExtract happy

my $te = new HTML::TableExtract(headers=>['Rep','Create Time'] )
         ->parse($c); #Create the parser and get the table

#process the table data into a hash
my %data;                 
for my $ts ($te->table_states) {  #only one table should be returned
   for my $row ($ts->rows) {      #the row contains [rep, create time]
      if ($row->[1]) {            #if there's a create time
          my $key = UnixDate($row->[1],"%Q");  #makes key 'yyyymmdd'
             if(defined($row->[0])) {             #if there's a Rep
              $data{$key}{REP}+=$row->[0];  #add it to the rep total f
+or that day
            $data{$key}{NUM}++;   #increment number of posts for that 

#create a list of lists for the plot objects
my ($count,$rep);  #running total number of writeups and reps
my @data;          #the data: munged for GD::graph::lines3d objects
my $flag;          #has $birth been set?
my $birth;         #earliest create time in the data

for my $key (sort keys %data) {   #loop through dates from earliest to
+ latest;
    if(!$flag) {                  #first item? (earliest)
       $birth=$key;               #Set it
       $flag=1;                   #don't set it again.
    $count+=$data{$key}{NUM};     #Add days writeups to total
    $rep+=$data{$key}{REP};       #add days rep to total
    push @{$data[0]},             #days since $birth
    push @{$data[1]},$count/($data[0][-1]+1); #avg post/day to date
    push @{$data[2]},$rep/($data[0][-1]+1);   #avg rep/day to date
    push @{$data[3]},sprintf("%.3f",$rep/$count); #avg rep/post to dat

#create some plot settings
my %plot= (avg=>{
             ylabel => 'Reputation/Writeup',
             title  => 'Rep/Writeup',
             column => 3,
                ylabel => 'Writeups/Day',
                title  => 'Writeups/Day',
                column => 1,
                ylabel => 'Reputation/Day',
        title  => 'Rep/Day',
                column => 2,

#this does most of the work in actually making the plots
for my $key (keys %plot) {
    $plot{$key}{GD} = new GD::Graph::lines3d(350,200);
           ->set(x_label => 'Days since ' . UnixDate($birth,"%b %d, %Y
                 y_label => 'Avg ' . $plot{$key}{ylabel},
                 title   => sprintf("%s %.3f)","Recent Avg. " . 
                                    $plot{$key}{title} .
    $plot{$key}{PLOT} = $plot{$key}{GD}
    open(IMG,">$key.png") or die $!;
    binmode IMG;
    print IMG $plot{$key}{PLOT}->png;
    close IMG;

#Now send them to our webserver
my $ftp = Net::FTP->new($ftpurl);

for my $file (keys %plot) {