#!/usr/bin/perl use strict; use warnings; use CGI ':standard'; use DBI; use File::Basename 'basename'; use Getopt::Std; use LWP::Simple; use HTML::TableExtract; use File::Temp 'tempfile'; my %opt; Get_Args(); Get_Data() if $opt{u}; my @top = map { [ '', '', '', '', '', 100 ] } 0 .. $opt{t}; my @items = qw(id name xp total higher p); Get_Stats(); Print_Stats(); sub Build_DB { if ( -e $opt{d} ) { unlink $opt{d} or die "Unable to remove $opt{d}"; } $opt{file} = basename( $opt{file} ); my $dbh = DBI->connect( "dbi:SQLite:dbname=$opt{d}" ) or die $DBI::errstr; $dbh->do( "CREATE TABLE pm (node_id, name, xp)" ) or die $dbh->errstr; $dbh->do( "COPY pm FROM '$opt{file}'" ) or die $dbh->errstr; $dbh->disconnect; } sub Get_Args { my $Usage = qq{Usage: $0 options -h : This help message. -d : Database name -m : Maximum number of monks to check -o : Output file -p : Per page monks to check -s : Skip monks with XP less than this number -t : Top number of monks for report -u : Update database } . "\n"; getopts( 'hd:m:o:p:s:t:u' , \%opt ) or die $Usage; die $Usage if $opt{h}; $opt{d} ||= 'pmstats.db'; $opt{m} ||= 2000; $opt{p} ||= 50; $opt{s} ||= 0; $opt{t} ||= 50; $opt{t}--; $opt{u} = 1 if exists $opt{u}; } sub Get_Data { my $table = new HTML::TableExtract( headers => [ 'Rank', 'Node ID', 'Name', 'Experience' ], ); my $url = 'http://tinymicros.com/pm/index.php?goto=MonkStats&start='; my $offset = 0; while ( $offset < $opt{m} ) { my $html = get( $url . $offset ); $table->parse( $html ); $offset += $opt{p}; } ( my $fh, $opt{file} ) = tempfile( UNLINK => 1, DIR => '.' ); for my $table_state ( $table->table_states ) { for my $row ( $table_state->rows ) { print $fh join "\t" , @{$row}[1..3]; print $fh "\n"; } } Build_DB(); } sub Get_Stats { my $dbh = DBI->connect( "dbi:SQLite:dbname=$opt{d}" ) or die $DBI::errstr; my $sth = $dbh->prepare("SELECT * FROM pm"); my $sth_t = $dbh->prepare("SELECT COUNT(*) FROM pm WHERE node_id > ?"); my $sth_h = $dbh->prepare("SELECT COUNT(*) FROM pm WHERE node_id > ? AND xp > ?"); $sth->execute() or die $dbh->errstr; while ( my @rec = $sth->fetchrow_array ) { next if ! $rec[2] || $rec[2] < $opt{s}; $sth_t->execute( $rec[0] ) or die $dbh->errstr; $sth_h->execute( $rec[0], $rec[2] ) or die $dbh->errstr; my ($total) = $sth_t->fetchrow_array; next if ! $total; my ($higher) = $sth_h->fetchrow_array; my $percent = ($higher / $total) * 100; next if $percent > $top[-1][5]; for my $id ( 0 .. $opt{t} ) { if ( $percent < $top[$id][5] ) { my @stats = ($total, $higher, $percent); splice @top, $id, 0, [ @rec, @stats]; pop @top; last; } } } $sth_t->finish(); $sth_h->finish(); $dbh->disconnect; } sub Print_Stats { if ( $opt{o} ) { open( HTML, '>', $opt{o} ) or die "Unable to open $opt{o} for writing : $!"; select HTML; } my $url = 'http://www.perlmonks.org/index.pl?node_id='; print start_html( -title => "Fastest Rising Monks", -bgcolor => "#ffffcc" ), div( { -align => "center" }, p(h1( "Monks XP Compared To Newer Monk's XP" ) ), p(h2( "Selected from the top $opt{m} monks" ) ), p(h3( "Skipped Monks with XP less than $opt{s}" ) ), table( { -bgcolor => "#000000", -border => "0", -cellpadding => "2", -cellspacing => "1", }, Tr( { -style => "background-color:#CCCCCC" }, th( [ qw(Rank Monk XP), '# After', '# > XP', 'Percent' ] ), ), Tr( { -style => "background-color:#CCCCCC" }, [ map {td([ $_ + 1, a({ href=>$url . $top[$_][0]}, $top[$_][1] ), $top[$_][2], $top[$_][3], $top[$_][4], sprintf( "%.4f", $top[$_][5] ), ]), } 0 .. $opt{t} ] ), ), ), end_html; }