I understand that [id://456234|XP isn't everything]. It's not even a good indicator of anything past some vague idea of participation in PerlMonks. However, it is a guage of that participation, as are a few other stats you can easily get from your own homenode.

I initially wrote a quick tool to entertain myself with XP stats. In fact, I wrote it soon enough after joining PM that I also put in the ability to save my XP for the day to a CSV file, by date, for historical purposes.

Since then, I've used it in CB a few times as a cheap parlour trick to entertain a number of the other monks. And since it's just a simple perl script that does all the calculations immediately, it looks like I do this very quickly. That's what parlour tricks are for, right?

As it has been requested a few times now, here it is. I wonder what others would add to the stats?

#! /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.' . $user);
    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 . ";csv_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 stats')->[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 where 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 = ?', undef, $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_seconds($per), RESET);
}

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] - $total), $markers[0][0]
          ) if @markers;
    printf("Best day: %s at %dXP!\n", @best{qw(DATE XP)});
}

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.

The stats shown are quite simple: how long the user has been a monk, total XP (and XP per day, and average time between XP gains), writeups (and writeups per day, and average time between writeups), and XP per writeup. If you are running this on a user whose stats you're monitoring (likely just yourself), you get output that's relatively easy to read. For others, you get output that's relatively easy to paste in to the CB to entertain others. Of course, that's still pretty trivial to change.

Yesterday, [chargrill] was asking "me next!" after I had posted someone else's stats. He was a might bit disappointed with what the stats showed him. Since then, I see he has nearly doubled his XP and his writeups. I imagine he is suddenly a larger participant because of this game. And that's what XP is about, right? Encouraging positive participation? :-) (I'll leave [chargrill]'s exact stats to anyone who wants to run this...)