#! /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); } #### #! /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)}); }