#!/usr/bin/perl -w # # Graph the state of Top 100 SETI folks in Ireland. I'm in red. Gives # deltas for the last time checked: position change (negative for # moving up the ranks) and number of units completed. Needs to be # hacked to cope with what happens when I run off the right-hand side # of the graph. Also would be nice to cope in the event of me falling # off the top 100 (continue and find out where I am, I guess) # # March 2003: crude hack to left-shift # colour people doing better than me vs. people doing worse use LWP::UserAgent; use HTML::Parser; use Date::Parse; use Storable; use GD; use Getopt::Long; my %rankings; $| = 1; # Load up the database, if possible my $oldest = time; my $maxcount = 0; my $graphonly = 0; eval { my $foo = retrieve( $ENV{'HOME'} . "/.setiranks" ); %rankings = %{$foo}; for my $name ( keys %rankings ) { my $data = $rankings{$name}; next unless $data; my @points = @$data; if ( @points ) { for my $p ( 0..$#points ) { my ( $t, $c, undef ) = @{$points[$p]}; if ( $t < $oldest ) { $oldest = $t; } if ( $c > $maxcount ) { $maxcount = $c; } } } } }; my $ua = new LWP::UserAgent; $ua->agent( "GeekToy/0.1" . $ua->agent ); $ua->env_proxy(); my $notable = 0; my $interest = 0; my @fields; my $update; my $dead; my $SCALE = 5; my %seen; my $im = new GD::Image( 100 * $SCALE, 100 * $SCALE ); my $white = $im->colorAllocate(255,255,255); my $black = $im->colorAllocate(0,0,0); my $red = $im->colorAllocate(255,0,0); my $blue = $im->colorAllocate(0,0,255); my $yellow = $im->colorAllocate( 0,255,255 ); $im->fill( 0, 0, $black ); $im->transparent( $black ); my $verbose = $ENV{'DEBUG'}; my @list; my $myrate = 0; GetOptions( "graphonly" => \$graphonly, "verbose" => \$verbose ); open( HTML, ">$ENV{'HOME'}/public_html/misc/seti.html" ); print HTML <<"EOH"; SETI Ireland Stats

SETI Ireland Stats


Source: SETI Ireland Statistics
EOH print STDERR "Getting page..." if $verbose; my $req = new HTTP::Request GET => 'http://setiathome.ssl.berkeley.edu/stats/country_103.html'; my $res = $ua->request( $req ); print STDERR "done\n" if $verbose; if ( $res->is_success ) { my $page = $res->content; $update = $page; $update =~ s|^.*Last updated: (.*?) \<.*$|$1|s; chomp( $update ); # convert to unix time $update = str2time( $update ); my $parser = HTML::Parser->new( api_version => 3, start_h => [\&start, "tagname, attr" ], text_h => [ \&text, "text" ], end_h => [\&end, "tagname"], ); $parser->parse( $page ); $parser->eof; for my $rank ( 1..100 ) { my ( $count, $name, $comment ) = split( /\0/, $list[$rank - 1]); my ( $rate ) = $comment =~ /units: (\d+)/; $rate ||= 0; my $color = $rate > $myrate ? "yellow" : "green"; $color = "red" if $name =~ /waider/i; $name = "$name"; print HTML <<"EOF"; \n EOF } if ( !$graphonly ) { store \%rankings, $ENV{'HOME'} . "/.setiranks"; } print HTML <<"EOH";
$rank$count$name$comment
EOH open( IMAGE, ">$ENV{'HOME'}/public_html/misc/seti-graph.png" ); binmode( IMAGE ); print IMAGE $im->png; close( IMAGE ); close( HTML ); } else { die "Failed to get page! ($res->code)"; } sub start { if (!$notable) { $notable = ( $_[0] eq "table" ); return if $notable; } else { if ( $_[0] eq "tr" ) { $interest = 1; @fields = ( "", "", "", "" ); } if ( $_[0] eq "td" ) { $interest ++; } } } sub end { if ( $_[0] =~ /^tr$/ ) { $interest = 0; return unless $fields[0]; return unless $fields[1]; for my $i ( 0..4 ) { $fields[$i] =~ s/^\s*//; $fields[$i] =~ s/\s*$//; } my ( $rank, $name ) = $fields[0] =~ /^\s*(\d+)(.*)$/; $name =~ s/\) ?//; # because some tosser's managed to get himself on the list twice return if defined( $seen{$name}); $seen{$name} = "seen"; my ( undef, $count, $tot, $avg, $last ) = @fields; $last = str2time( $last ); $last ||= 0; my $comment = ""; if ( $update - $last > ( 60 * 60 * 24 * 365 )) { $dead++; } # ignore people with no name if ( $name ) { my @points; my ( $data ) = $rankings{$name}; @points = @$data if $data; my ( $lasttime, $lastcount, $lastpos ); ( $lasttime, $lastcount, $lastpos ) = @{$points[-1]} if @points; if ( !defined( $lasttime ) or ( $lasttime != $last )) { push @points, [ $update, $count, $rank ]; $rankings{$name} = \@points; } if ( defined( $lasttime )) { $comment = "(rank: " . ( $rank - $lastpos ) . ", units: " . ( $count - $lastcount ) . ")"; } if ( $name =~ /waider/i ) { $myrate = $count - ( $lastcount || 0); } while ( $#points > 100 ) { print STDERR " Chopping down data for $name\n" if $verbose; shift @points; } my $first = $points[0]; while ( $#points < 99 ) { unshift @points, $first; } $rankings{$name} = \@points; if ( @points and $rank <= 100 ) { print STDERR " $name has " . scalar(@points) . " points on record\n" if $verbose; my ( $time, $count, $pos ); ( $oldtime, $oldcount, $oldpos ) = @{$points[0]}; print STDERR "processing $rank...\n" if $verbose; my ( $x1, $y1, $x2, $y2 ); for my $p ( 0..100 ) { next unless defined( $points[$p] ); # ???? ( $time, $count, $pos ) = @{$points[$p]}; print STDERR ", $pos" if $verbose; # old $x1 = ( $p - 1 ) * $SCALE; $y1 = $oldpos * $SCALE; $x2 = $p * $SCALE; $y2 = $pos * $SCALE; $im->line( $x1, $y1, $x2, $y2, ( $name =~ /waider/i ? $red : $white )); $oldpos = $pos; $oldtime = $time; $oldcount = $count; } # old $x1 = ( 100 - $#points ) * $SCALE; $y1 = $oldpos * $SCALE; $x2 = 0 * $SCALE; $y2 = $oldpos * $SCALE; print STDERR "done\n" if $verbose; } } else { delete $rankings{$name}; } return if $rank > 100; if ( $name =~ /waider/i ) { $name = "$name"; } my $line = sprintf( "%d%d%s%s\n", $rank, $count, $name, $comment ); # print HTML $line; push @list, "$count\0$name\0$comment"; } } sub text { if ( $interest > 1 ) { $_[0] =~ s/[\r\n]/ /g; $fields[ $interest - 2 ] .= $_[0]; $fields[ $interest - 2 ] =~ s/ +/ /g; $fields[ $interest - 2 ] =~ s/ //g; $fields[ $interest - 2 ] =~ s/&/&/g; } }