#! /usr/bin/perl

use strict;
use warnings;

use LWP::Simple qw();
use HTML::Parser;
use Date::Parse;
use Data::Dumper;
use Term::ANSIColor qw(:constants);

use DBI;
use FindBin;

my $user = shift or die "Need to pass in user name!";

my @convert = (
               [  1, '%02d',  'sec' ],
               [ 60, '%02d:', 'min' ],
               [ 60, '%2d:', 'hr'  ],
               [ 24, '%d ',   'd'   ],
              );
sub convert_seconds
{
    my $sec = shift;
    my @c = @convert;
    my @vals = ($sec);
    my $output = ' %s';

    while (my $c = shift @c)
    {
        if ($vals[0] > $c->[0])
        {
            $output = $c->[1] . $output;
            unshift @vals, int($vals[0] / $c->[0]);
            $vals[1] %= $c->[0];
            $vals[-1] = $c->[2];
        }
        else
        {
            last;
        }
    }

    sprintf $output, @vals;
}


my $html = LWP::Simple::get('http://www.perlmonks.org/index.pl?node=' 
+. $user);


if ($html)
{
    my %data = (done => 1);
    my $p = HTML::Parser->new(api_version => 3);
    $p->report_tags(qw(tr td));
    $p->handler(start => sub
                {
                    return if $data{done};
                    my ($tagname, $attr) = @_;

                    if ($tagname eq 'tr')
                    {
                        delete $data{key};
                        delete $data{td};
                    }

                    return unless $tagname eq 'td';
                    #return if keys %$attr;
                    $data{start} = $tagname;
                }, 'tagname, attr');
    $p->handler(end => sub
                {
                    return if $data{done};
                    my ($tagname) = @_;

                    return unless $tagname eq 'td';

                    if (exists $data{key})
                    {
                        $data{$data{key}} = $data{td};
                        delete $data{key};
                        delete $data{td};
                    }
                    elsif (exists $data{td})
                    {
                        $data{key} = $data{td};
                        delete $data{td};
                    }

                    delete $data{start};
                    if ($tagname =~ /Scratchpad:/)
                    {
                        $data{done}++;
                    }
                }, 'tagname');
    $p->handler(text => sub
                {
                    return if $data{done};
                    my $text = shift;
                    $text =~ s/^\s+//;
                    $text =~ s/[:\s]+$//;
                    $data{td} .= $text;
                    #delete $data{start};
                }, 'text');
    $p->handler(comment => sub
                {
                    my ($tagname) = @_;
                    if ($tagname =~ /contained/)
                    {
                        $data{done} = $tagname =~ m./contained.;
                    }
                }, 'tagname'
               );

    $p->parse($html);
    $p->eof();

    my $table_file = File::Spec->catfile($FindBin::Bin,'stats.' . $use
+r);
    my $eol = -e $table_file ? "\n" : ', ';
    my $since = $data{'User since'};
    $since =~ s/\s\S*$//;
    $since =~ s/at //;
    my $tbegin = str2time($since, 'GMT');
    my $tdiff = time - $tbegin;
    my $duration = $tdiff / (60 * 60 * 24);

    if ($eol =~ /^\s*$/)
    {
        print $user,$/;
        print '-' x (length $user), $/;
    }
    else
    {
        print "[$user] stats: ";
    }
    printf "Member for: %.3f days%s", $duration, $eol;
    println('Experience: ', $data{Experience}, $duration);
    print $eol;
    println('Writeups:   ', $data{Writeups}, $duration);
    print $eol;
    printf("Which makes it %s%.3f%s XP per writeup!\n",
           BOLD.RED,
           ($data{Experience} / $data{Writeups}, RESET)); #/));

    if (-e $table_file)
    {
        my $dbh = DBI->connect('dbi:CSV:f_dir=' . $FindBin::Bin . ";cs
+v_eol=\n")
            or warn "Can't connect to DBI";
        $dbh->{csv_tables}->{stats} = {
            file => $table_file,
        };

        my $total = $dbh->selectall_arrayref('select sum(xp) from stat
+s')->[0][0];
        if ($total != $data{Experience})
        {
            require Time::localtime;
            my $lt = Time::localtime::localtime(time() + (2 * 60 * 60)
+);
            my $date = sprintf("%04d-%02d-%02d", $lt->year + 1900, $lt
+->mon + 1, $lt->mday);
            #print "Today is $date\n";
            my $count = $dbh->selectall_arrayref('select count(*) from
+ stats where date = ?', {}, $date)->[0][0];
            my $cur = $dbh->selectall_arrayref('select xp from stats w
+here date = ?', {}, $date);
            $cur = $cur->[0] while $cur and ref $cur;
            my $gained = $data{Experience} - $total;
            printf "%s %s%d%s XP!\n", $gained > 0 ? "Gained" : "Lost",
+ RED.BOLD, abs($gained), RESET;
            if ($count)
            {
                $cur += $gained;
                print "Updating today ($date) to be XP = $cur\n";
                $dbh->do('update stats set xp = ? where date = ?', und
+ef, $cur, $date);
            }
            else
            {
                $cur = $gained;
                print "Inserting into today to be XP = $cur\n";
                $dbh->do('insert into stats (date,xp) values(?,?)', {}
+, $date,$cur);
            }
        }
    }

}
else
{
    print "Can't get node for $user\n";
}


sub println
{
    my ($type, $data, $duration) = @_;
    my $rate = $data / $duration;
    my $per  = 24 * 60 * 60 / $rate;
    printf("%s %d (%s%.3f%s per day, or 1 per %s%s%s)",
           $type, $data, BLUE.BOLD, $rate, RESET, BOLD.BLUE, convert_s
+econds($per), RESET);
}
[download]

And then there is a tool I use to read my own stats. To get this working, you need to create the csv file as "stats.<username>" before running the above script. This allows you to track multiple users if you so wish.

#! /usr/bin/perl5.8

use warnings;
use strict;

use IO::File;
use FindBin;
use File::Spec;
use DBI;

my $user = shift;

my $dbh = DBI->connect('dbi:CSV:f_dir=' . $FindBin::Bin . ";csv_eol=\n
+")
    or warn "Can't connect to DBI";

my $table_file = File::Spec->catfile($dbh->{f_dir},'stats');
$table_file .= '.'.$user if -e "$table_file.$user";

$dbh->{csv_tables}->{stats} = {
    file => $table_file,
#    col_names => [qw(DATE XP)],
};

my @markers_old = (
                   [ Initiate =>    0 ],
                   [ Novice   =>   20 ],
                   [ Acolyte  =>   50 ],
                   [ Scribe   =>  100 ],
                   [ Monk     =>  200 ],
                   [ Friar    =>  500 ],
                   [ Abbot    => 1000 ],
                   [ Bishop   => 1600 ],
                   [ Pontiff  => 2300 ],
                   [ Saint    => 3000 ],
                  );
my @markers = (
               [ Initiate     =>      0 ],
               [ Novice       =>     20 ],
               [ Acolyte      =>     50 ],
               [ Sexton       =>     90 ],
               [ Beadle       =>    150 ],
               [ Scribe       =>    250 ],
               [ Monk         =>    400 ],
               [ Pilgrim      =>    600 ],
               [ Friar        =>    900 ],
               [ Hermit       =>   1300 ],
               [ Chaplain     =>   1800 ],
               [ Deacon       =>   2400 ],
               [ Curate       =>   3000 ],
               [ Priest       =>   4000 ],
               [ Vicar        =>   5400 ],
               [ Parson       =>   7000 ],
               [ Prior        =>   9000 ],
               [ Monsignor    =>  12000 ],
               [ Abbot        =>  16000 ],
               [ Canon        =>  22000 ],
               [ Chancellor   =>  30000 ],
               [ Bishop       =>  40000 ],
               [ Archbishop   =>  50000 ],
               [ Cardinal     =>  60000 ],
               [ Sage         =>  70000 ],
               [ Saint        =>  80000 ],
               [ Apostle      =>  90000 ],
               [ Pope         => 100000 ],
              );

my $total;
my %best = ( XP => 0 );
#my $sth = $dbh->prepare('select * from stats order by date');
#$sth->execute();
#while (my $line = $sth->fetchrow_hashref())

my $query = $dbh->selectall_arrayref('select * from stats',
                                    {Slice=>{}});

my @lens;
my @data;

foreach my $line (@$query)
{
    next unless length $line->{XP};

    $total += $line->{XP};

    my @d = ( $line->{DATE}, $total );

    if ($line->{XP})
    {
        push @d, sprintf "%s%d", $line->{XP} > 0 ? '+' : '',  $line->{
+XP};
    }
    else
    {
        push @d, '0';
    }

    my @made = '';
    unless ($best{XP} >= $line->{XP})
    {
        %best = %$line;
        push @made, 'New daily record!';
    }
    unless (@markers)
    {
        if (int($total / 1000) > int(($total - $line->{XP})/1000))
        {
            push @made, sprintf "(Reached %d000 XP!)", int($total/1000
+);
        }
    }
    while (@markers and $total >= $markers[0][1])
    {
        push @made, sprintf "(Made %s!)", $markers[0][0];
        shift @markers;
    }
    push @d, join ' ', @made;

    push @data, \@d;
}

use Text::Table;
my $sep = '|';
my $tb = Text::Table->new('Date',\$sep, 'Total',\$sep, "Gain\n&right",
+\$sep, 'Notes');
$tb->load(@data);

my @col_range = $tb->colrange(-1);
foreach (@data)
{
    my $notes = $_->[-1];
    $_->[-1] = '*' x ($_->[2] * $col_range[1] / $best{XP}) if $_->[2] 
+> 0;
    substr($_->[-1], 0, length($notes)) = $notes;
}
$tb->clear()->load(@data);

print $tb;



#$sth->finish();
if ($total)
{
    printf(
           "Only %d more XP to becoming %s!\n", ($markers[0][1] - $tot
+al), $markers[0][0]
          ) if @markers;
    printf("Best day: %s at %dXP!\n", @best{qw(DATE XP)});
}
[download]

Note how both the old levels and the new levels are there. This means I know when I became a Pilgrim, for example (Jan 25, 2005). Or Friar (Jan 31, 2005). Or Deacon (Mar 10, 2005). Or Prior (Sep 29, 2005). All dates prior to actually doing the changeover. ;-)

Of course, if you haven't kept track of your daily XP to this point, this won't help with the historical data. But can still be entertaining of itself.