Node trackers allow users to keep track of changes in their stats, such as writeup reputation, C!s and some items that are not always visible in the statistics nodelet. The "classic" node tracker was written and operated by Cow of Doom. The typical node tracker is a Perl script that takes the username and password you give it and uses it to log in to E2 and retrieve the necessary account and writeup information. It then compares the result to the data previously stored on the tracker's server and shows you the differences since the last update. The exception to this is the first time you use a tracker in which case of course it has nothing to compare against but will display the current stats and store them for later comparisons. Keep in mind that you're trusting the tracker's operator with your password and writeup stats.
CoD's node tracker temporarily went offline at some point in Aug or Sep 2001 and two substitute trackers (running his code) surfaced and made themselves available to the noding public. A couple more made their appearance later, run by folks like conform and sui. There also used to be add-on, a little toy called the homenode list generator, written by wick.
By 2007 all trackers had, one by one, faded away. The last operational one is mine at http://e2info.apatrix.net/ though I confess that its code is outdated and has not kept up with changes to the site.
The node tracker (hint: this is a hard link for a reason) has been ported to E2 itself by kthejoker so you can now all enjoy an on-site node tracker, as long as you promise not to ask what took us so long. This tracker is equipped to handle the new writeup types as well as all the newer, fancy mathematics involved in calculating user stats so I will recommend it to all but the most loyal users of my tracker, which will probably follow the others into oblivion one day. Final note: It was retired in May 2008
This writeup will be updated as needed to reflect the State Of The Trackers. Drop news items and updates in my message inbox. (Last update: 2008-05-27)
You can allow me that in two ways:
Example output:
Changed nodes ---------------- Rep | C | Name ====================== -6 Where do I come when I masturbate?
Revision history:
Version teufelkunst:
#!/usr/bin/perl -w ## Source notes: ## The code isn't very perl-ish, I'd imagine, but forgive me, I'm coming from ## C(++). It does work though. I stole the socket parts from TheNastyCanasty's ## MetaNoder, rest is my own creations. Feel free to drop me notes about ## anything concerning anything, preferably over kaatunut@iki.fi ## As for license, well, let's say it's GPL. I hope it's applicable to source- ## form (non-compilable) software. ## Most of the code by me, except that... ## - waleed@cse.unsw.edu.au: proxy support and stty fix for password prompt ## - flamingweasel: bug fix to printstat() ## -Kaatunut use Socket; use FileHandle; use CGI qw(escape); use Time::Local; use POSIX qw(strftime); sub viewnodes; sub printstat; sub print_report; sub savenodes; sub loadnodes; sub getnodes; sub parse_file; sub hotfh; sub consock; $nodelist_head= "%s\n". "--------------------\n". "Rep | Name\n". "==========================\n"; $nodelist_line= "%+3d/%-+3d %2s | %-50s %s\n"; #"%4d/%-3d %2s | %-50s %s\n"; $nodelist_changedline= "%+3d/%-+3d %2s | %-50s %s\n"; #"%+4d/%-3d %2s | %-50s %s\n"; $nodelist_long_head= "%s\n". "---------------------------------------\n". "Rep | Date | Type | Name\n". "=============================================\n"; $nodelist_long_line= "%4d/%-3d %2s | %5s | %6s | %-50s %s\n"; #$nodelist_long_changedline= #"%+4d/%-3d %2s | %5s | %6s | %-50s %s\n"; $E2server="everything2.com"; $E2port=80; $dataname="getnodes.dat"; $SIG{'INT'} = "cleanup"; ## Just in case someone does a control-c. Added by ymelup if (!@ARGV) { push @ARGV,"-help"; } while (@ARGV) { $t=shift(@ARGV); if ($t eq "-help") { print <<EOF Usage: $0 [parameters] -userpass NAME:PASS Supplies username and password needed for login. -login Will prompt you for the username and password interactively. -cookie COOKIE Sets the cookie variable \"userpass\"'s value directly in parameter -cookie-file COOKIEFILE Reads the cookie variable's contents from file -cookie-data COOKIEFILE Reads variable from cookies-datafile, typically at ~/.netscape/cookies or ~/.lynx_cookies -server SERVER Sets the address for E2 server (everything2.com) -port PORT Sets the port to use (80) -data NAME Name of the datafile for storing old nodes -proxy SERVER:PORT Use a proxy, with the proxy server SERVER in port PORT (port number IS required) Action modes (one must be chosen): View modes (when used alone, processes saved nodes, with -update, downloaded ones): -view Lists all your nodes -stat List general statistics about your nodespace -stat-graph name.png Outputs some graphs to a PNG file. Requires GD::Graph and gd-1.8.3 -update Fetch new nodedata from server, print a report of changes and save the new nodedata -update-no-save Fetch new nodedata from server, print a report of changes but don't save the data -update-no-report Fetch new nodedata from server and save it, but don't print the report ... But what cookie? Well, to see the rep of your nodes I need to be able to "login" as you. I felt this was the simplest way; using the cookie supplied by E2. So, login with your favourite browser, and, if you're using netscape, lynx or other browser with compatible cookiedata, give me the location of that file. If not, find the cookie's contents and give it directly to me. EOF ; exit; } elsif ($t eq "-cookie") { $cookie=shift(@ARGV); } elsif ($t eq "-cookie-file") { open(COOKIEFILE,shift(@ARGV)) || die "can't open cookiefile!"; $cookie=<COOKIEFILE>; close(COOKIEFILE); } elsif ($t eq "-cookie-data") { open(COOKIEDATA,shift(@ARGV)) || die "can't open cookiedata!"; while (<COOKIEDATA>) { if ($_ =~ /^(?:www.)?everything2.(?:com|org).*userpass\s+(.*)$/) { $cookie=$1; last; } } die "no cookie for E2 in cookiefile!" if (!$cookie); } elsif ($t eq "-userpass") { shift(@ARGV) =~ /^(.*?):(.*)$/; $login=1; $username=$1; $userpass=$2; } elsif ($t eq "-login") { $login=2; } elsif ($t eq "-server") { $E2server=shift(@ARGV); } elsif ($t eq "-port") { $E2port=shift(@ARGV); } elsif ($t eq "-data") { $dataname=shift(@ARGV); } elsif ($t eq "-view") { $view=1; } elsif ($t eq "-update") { $get_data=1; $print_report=1; $save_data=1; } elsif ($t eq "-update-no-save") { $get_data=1; $print_report=1; $save_data=0; } elsif ($t eq "-update-no-report") { $get_data=1; $print_report=0; $save_data=1; } elsif ($t eq "-stat") { $printstat=1; $print_stat_general=1; } elsif ($t eq "-stat-graph") { $printstat=1; $print_stat_graph=shift(@ARGV); print "Attempting to use GD\n"; require GD::Graph::bars; require GD::Graph::mixed; } elsif ($t eq "-proxy") { # Modified by ymelup@hotmail.com to allow proxies to be used. $use_proxy = 1; ($proxyhost, $proxyport) = split(/:/, shift(@ARGV)); print "Proxy host is: $proxyhost Proxy port is: $proxyport\n"; } else { print "Unknown parameter: $t!\n"; } } if (defined($login) && ($login == 2)) { print "Username: "; chomp($username=<STDIN>); $username=escape($username); ## Modified by ymelup to not print characters on screen when asking for password system "stty", "-echo"; print "Password: "; chomp($userpass=<STDIN>); $userpass=escape($userpass); system "stty", "echo"; print "\n"; # Need this, since user's return won't be echoed } loadnodes($dataname,\%oldnode); if ($get_data) { if (!$cookie) { if (!$login) { print "You must define a cookie or username ". "and password so I can login. See $0 -help.\n"; exit; } else { print "Logging in... "; if($use_proxy){ consock(HTTP, $proxyhost, $proxyport) || die "can't connect to proxy!"; } else { consock(HTTP,$E2server,$E2port) || die "can't connect to server!"; } hotfh(HTTP); print HTTP "GET ". ($use_proxy ? "http://$E2server:$E2port" : ""). "/?op=login&node_id=109&lastnode_id=0&". "user=$username&passwd=$userpass HTTP/1.0\r\n\r\n"; while (<HTTP>) { if (/Set-Cookie: userpass=(.*?); /mi) { $cookie=$1; last; } } if (!$cookie) { die "couldn't log in!"; } } } getnodes(\%newnode,0); } if ($view) { if (!$get_data) { viewnodes(\%oldnode); } else { viewnodes(\%newnode); } } printreport(\%oldnode,\%newnode) if $print_report; print_stat($get_data ? \%newnode : \%oldnode, $print_stat_general, $print_stat_graph) if $printstat; savenodes($dataname,\%newnode) if $save_data; # viewnodes(nodehash-ref) sub viewnodes { print scalar(keys %{$_[0]})," nodes\n"; printf $nodelist_long_head,"Your nodes"; foreach $i (keys %{$_[0]}) { printf $nodelist_long_line, # ${$_[0]}{$i}{"rep"}, # ${$_[0]}{$i}{"cast"}, (${$_[0]}{$i}{"cast"}+${$_[0]}{$i}{"rep"})/2, (${$_[0]}{$i}{"rep"}-${$_[0]}{$i}{"cast"})/2, ${$_[0]}{$i}{"C"} ? "${$_[0]}{$i}{C}C!" : "", strftime("%m/%d",localtime ${$_[0]}{$i}{"time"}), ${$_[0]}{$i}{"type"}, $i, ${$_[0]}{$i}{"C_by"} ? ("| C! by ".${$_[0]}{$i}{"C_by"}) : ""; } } # printstat(nodehash-ref) sub print_stat { # IMHO C! is worth +10, not +30 like XP rate would suggest my $C_worth=10; my($rep_sum,$effrep_sum,$cool_count,$negrep_count,$zerorep_count,$posrep_count); my($node_num,$xp_worth,$average_xp,$average_rep,$average_effrep); my @node_sort; my ($top90node,$rep_counter); my(%type_count,%cer_count,@cer_top); if (!($node_num=keys %{$_[0]})) { print "Hmm, looks like you have no nodes. Did you run '-update' first?"; return; } if ($_[1]) { for $i (keys %{$_[0]}) { $xp_worth++; $xp_worth+=${$_[0]}{$i}{"rep"} / 3.0; $xp_worth+=3*${$_[0]}{$i}{"C"} if ${$_[0]}{$i}{"C"}; $effrep_sum+=${$_[0]}{$i}{"rep"}; $effrep_sum+=$C_worth*${$_[0]}{$i}{"C"} if ${$_[0]}{$i}{"C"}; $cool_count+=${$_[0]}{$i}{"C"} if ${$_[0]}{$i}{"C"}; $rep_sum+=${$_[0]}{$i}{"rep"}; $negrep_count++ if ${$_[0]}{$i}{"rep"}<0; $zerorep_count++ if !${$_[0]}{$i}{"rep"}; $posrep_count++ if ${$_[0]}{$i}{"rep"}>0; $type_counter{${$_[0]}{$i}{"type"}}++; $cer_count{${$_[0]}{$i}{"C_by"}}++ if ${$_[0]}{$i}{"C_by"}; } $average_xp=$xp_worth/$node_num; $average_rep=$rep_sum/$node_num; $average_effrep=$effrep_sum/$node_num; $rep_counter=0; @node_sort=sort { ${$_[0]}{$b}{"rep"} <=> ${$_[0]}{$a}{"rep"} } keys %{$_[0]}; for ($i=0; $i<=$#node_sort && ($rep_counter+=${$_[0]}{$node_sort[$i]}{"rep"}) < ($rep_sum*9/10); ++$i) { } $top90node=$i; @cer_top=sort{$cer_count{$b}<=>$cer_count{$a}} keys %cer_count; } if ($_[1]) { printf "Number of nodes: %d\n",$node_num; printf "Direct XP worth: %d\n",$xp_worth; printf "Number of cools: %d\n",$cool_count; printf "Average rep: %.1f\n",$average_rep; printf "Average XPworth: %.1f\n",$average_xp; printf "Average effective rep (C! is worth %d votes): %.1f\n", $C_worth,$average_effrep; print "\n"; print "XP (direct) division:\n"; printf "%2.1f%% from writeup count\n",100.0*$node_num/$xp_worth; printf "%2.1f%% from votes\n",100.0*$rep_sum/3.0/$xp_worth; printf "%2.1f%% from cools\n",100.0*$cool_count*10.0/$xp_worth; print "\n"; print "Note: \"direct\" XP means XP gained from rep changes, new writeups\n"; print "and C!s. It does not include non-writeup means such as using votes,\n"; print "blesses or curses, nor indirect like E2quests.\n"; print "\n"; print "Ratios:\n"; printf "%2.1f%% (%d) of your nodes are C!d\n", 100.0*$cool_count/$node_num,$cool_count; printf "%2.1f%% (%d) of your nodes have negative,\n", 100.0*$negrep_count/$node_num,$negrep_count; printf "%2.1f%% (%d) of your nodes have zero, and\n", 100.0*$zerorep_count/$node_num,$zerorep_count; printf "%2.1f%% (%d) of your nodes have positive reputation.\n", 100.0*$posrep_count/$node_num,$posrep_count; print "\n"; print "Type breakup:\n"; for $i (sort keys %type_counter) { printf " %-6s %2d%% (%d)\n",$i, 100*$type_counter{$i}/$node_num,$type_counter{$i}; } print "\nCool ants:\n"; for ($i=0;$i<5 && $i<=$#cer_top;++$i) { printf " %-15s cooled %3d of your nodes (%2d%%)\n", $cer_top[$i],$cer_count{$cer_top[$i]}, 100*$cer_count{$cer_top[$i]}/$cool_count; } print "\n"; printf $nodelist_head,"Top 5 nodes"; for ($i=0;$i<5;++$i) { printf $nodelist_line, # ${$_[0]}{$node_sort[$i]}{"rep"}, # ${$_[0]}{$node_sort[$i]}{"cast"}, (${$_[0]}{$node_sort[$i]}{"cast"}+${$_[0]}{$node_sort[$i]}{"rep"})/2, (${$_[0]}{$node_sort[$i]}{"rep"}-${$_[0]}{$node_sort[$i]}{"cast"})/2, ${$_[0]}{$node_sort[$i]} ? "${$_[0]}{$node_sort[$i]}C!" : "", $node_sort[$i], ${$_[0]}{$node_sort[$i]}{"C"} ? ("| C! by ".${$_[0]}{$node_sort[$i]}{"C"}) : ""; } @node_sort=reverse @node_sort; print "\n"; printf $nodelist_head,"Bottom 5 nodes"; for ($i=0;$i<5;++$i) { printf $nodelist_line, # ${$_[0]}{$node_sort[$i]}{"rep"}, # ${$_[0]}{$node_sort[$i]}{"cast"}, (${$_[0]}{$node_sort[$i]}{"cast"}+${$_[0]}{$node_sort[$i]}{"rep"})/2, (${$_[0]}{$node_sort[$i]}{"rep"}-${$_[0]}{$node_sort[$i]}{"cast"})/2, ${$_[0]}{$node_sort[$i]} ? "${$_[0]}{$node_sort[$i]}C!" : "", $node_sort[$i], ${$_[0]}{$node_sort[$i]}{"C"} ? ("| C! by ".${$_[0]}{$node_sort[$i]}{"C"}) : ""; } printf "\n90%% of your reputation comes from the top %d%% of your nodes\n", 100*$top90node/$node_num; } if ($_[2]) { # jakauma rep vs. tiheys # rep vs aika sekä aw7 my %rep_density; my($rep_img,$time_img,$out_img); my($w,$h)=(400,300); { my($minx,$maxx,$maxy); my @rep_density_data; for $i (keys %{$_[0]}) { $rep_density{${$_[0]}{$i}{"rep"}}++; $minx=${$_[0]}{$i}{"rep"} if !$minx || ${$_[0]}{$i}{"rep"}<$minx; $maxx=${$_[0]}{$i}{"rep"} if !$maxx || ${$_[0]}{$i}{"rep"}>$maxx; } for $i ($minx .. $maxx) { if (exists $rep_density{$i}) { $maxy=$rep_density{$i} if !$maxy || $rep_density{$i}>$maxy; } else { $rep_density{$i}=0; } } for $i (sort { $a <=> $b } keys %rep_density) { push @{$rep_density_data[0]},$i; push @{$rep_density_data[1]},$rep_density{$i}; } my $graph=new GD::Graph::bars($w,$h); $graph->set("transparent" => 0, "title"=>"Reputation division", y_max_value=>$maxy, x_label_skip=>int ($maxx-$minx)/10, ); $rep_img=$graph->plot(\@rep_density_data); } { my($minx,$maxx,$miny,$maxy); my(@time_data,@avg_data,@aw7_data); my($lb,$pb); for $i (sort { ${$_[0]}{$a}{"time"} <=> ${$_[0]}{$b}{"time"} } keys %{$_[0]}) { $minx=${$_[0]}{$i}{"time"} if !$minx; push @{$time_data[0]},${$_[0]}{$i}{"time"}; push @{$time_data[1]},${$_[0]}{$i}{"rep"}; $miny=${$_[0]}{$i}{"rep"} if !$miny || ${$_[0]}{$i}{"rep"}<$miny; $maxy=${$_[0]}{$i}{"rep"} if !$maxy || ${$_[0]}{$i}{"rep"}>$maxy; $maxx=${$_[0]}{$i}{"time"}; } $miny-=5; $maxy+=5; for ($i=0;$i<=$#{$time_data[0]};++$i) { $pb=int(($time_data[0][$i] -$time_data[0][0]) / 604800); if ((!defined $lb) || ($pb!=$lb)) { if (defined $lb) { $avg_data[$lb]=$bs/$bn; } $bs=$bn=0; $lb=$pb; } $bs+=$time_data[1][$i]; $bn++; } for ($i=0,my $p=0;$i<=$#avg_data;++$i) { my $tim=$time_data[0][0]+$i*604800+302400; if (!defined $avg_data[$i]) { $avg_data[$i]=0; } if (!$i) { $aw7_data[$i]=$avg_data[$i]; } else { $aw7_data[$i]=($avg_data[$i]+ 6*$aw7_data[$i-1])/7; } while ($time_data[0][$p] < $tim) { $p++; } splice @{$time_data[0]},$p,0,$tim; splice @{$time_data[1]},$p,0,undef; $time_data[2][$p]=$avg_data[$i]; $time_data[3][$p]=$aw7_data[$i]; $p++; } # $tw=($maxx-minx)/($t*604800) # where $t is smallest possible integer # with $tw<=13 my $tw=($maxx-$minx) /(604800*(int(($maxx-$minx)/(13*604800))+1)); my $graph=new GD::Graph::mixed($w,$h); $graph->set("types"=>["points","lines","lines"], "dclrs"=>["blue","red","black"], "line_width"=>2, "transparent" => 0, "bgclr"=>"white", "title"=>"Reputation by time", "marker_size"=>1, x_tick_number=>$tw, x_min_value=>$minx, x_max_value=>$maxx, x_number_format => sub { strftime("%m/%d",localtime $_[0]) }, y_min_value=>$miny, y_max_value=>$maxy, ); $time_img=$graph->plot(\@time_data); } $out_img=new GD::Image($w,$h*2); $out_img->copy($rep_img,0,0,0,0,$w,$h); $out_img->copy($time_img,0,$h,0,0,$w,$h); open(FILE,">$_[2]") or die "can't open $_[2] for writing!"; print FILE $out_img->png; close(FILE); } } # printreport(oldnode-ref,newnode-ref) # source format: name => [ noderep, nodeC ] sub printreport { my(%newnodes,%changednodes,%removednodes,%source); my($name,$rep,$C); # changes: hashes by name, elements in hashes: # newnodes: [ noderep, nodeC ] # changednodes: [ repchange, Cd_by ] # removednodes: [ hadrep, hadC ] %source=%{$_[0]}; foreach $i (keys %{$_[1]}) { if (!exists $source{$i}) { $newnodes{$i}=${$_[1]}{$i}; } else { if (($source{$i}{"rep"}!=${$_[1]}{$i}{"rep"}) || ($source{$i}{"C"} != ${$_[1]}{$i}{"C"}) || ($source{$i}{"cast"} != ${$_[1]}{$i}{"cast"}) ) { $changednodes{$i}{"rep"}=${$_[1]}{$i}{"rep"} -$source{$i}{"rep"}; $changednodes{$i}{"cast"}=${$_[1]}{$i}{"cast"} -$source{$i}{"cast"}; $changednodes{$i}{"C"}=${$_[1]}{$i}{"C"} -$source{$i}{"C"}; } delete $source{$i}; } } foreach $i (keys %source) { $removednodes{$i}=$source{$i}; delete $source{$i}; } print "Events:\n"; if (keys %newnodes) { printf $nodelist_head,"New nodes"; foreach $i (sort { $newnodes{$b}{"cast"} <=> $newnodes{$a}{"cast"} or $newnodes{$b}{"rep"} <=> $newnodes{$b}{"rep"} } keys %newnodes) { printf $nodelist_line, # $newnodes{$i}{"rep"}, $newnodes{$i}{"cast"}, ($newnodes{$i}{"cast"}+$newnodes{$i}{"rep"})/2, ($newnodes{$i}{"rep"}-$newnodes{$i}{"cast"})/2, $newnodes{$i}{"C"} ? "$newnodes{$i}{C}C!" : "", $i, $newnodes{$i}{"C_by"} ? ("| C! by ".$newnodes{$i}{"C_by"}) : ""; } } if (keys %changednodes) { print "\n"; printf $nodelist_head,"Changed nodes"; foreach $i (sort { $changednodes{$b}{"cast"} <=> $changednodes{$a}{"cast"} or $changednodes{$b}{"rep"} <=> $changednodes{$a}{"rep"} } keys %changednodes) { printf $nodelist_changedline, # $changednodes{$i}{"rep"}, $changednodes{$i}{"cast"}, ($changednodes{$i}{"cast"}+$changednodes{$i}{"rep"})/2, ($changednodes{$i}{"rep"}-$changednodes{$i}{"cast"})/2, $changednodes{$i}{"C"} ? "$changednodes{$i}{C}C!" : "", $i, $changednodes{$i}{"C_by"} ? ("| C! by ".$changednodes{$i}{"C_by"}) : ""; } } if (keys %removednodes) { print "\n"; printf $nodelist_head,"Removed nodes"; foreach $i (keys %removednodes) { printf $nodelist_line, # $removednodes{$i}{"rep"}, $removednodes{$i}{"cast"}, ($removednodes{$i}{"cast"}+$removednodes{$i}{"rep"})/2, ($removednodes{$i}{"rep"}-$removednodes{$i}{"cast"})/2, $removednodes{$i}{"C"} ? "$removednodes{$i}{C}C!" : "", $i, $removednodes{$i}{"C_by"} ? ("| C! by ".$removednodes{$i}{"C_by"}) : ""; } } } # savenodes(filename,nodearray-ref) # filename=filename to save into # nodearray-ref=ref 2-dim array with elements of [ nodetitle, noderep, hascool ] sub savenodes { open(DATA,">" . $_[0]) || die "can't open savefile!"; foreach $i (keys %{$_[1]}) { print DATA "name: $i\n"; print DATA "type: ${$_[1]}{$i}{'type'}\n"; print DATA "rep: ${$_[1]}{$i}{'rep'}\n"; print DATA "cast: ${$_[1]}{$i}{'cast'}\n"; print DATA "C: ${$_[1]}{$i}{'C'}\n"; print DATA "C_by: ${$_[1]}{$i}{C_by}\n" if ${$_[1]}{$i}{C_by}; print DATA "time: ${$_[1]}{$i}{'time'}\n"; print DATA "node_id: ${$_[1]}{$i}{'node_id'}\n"; print DATA "\n"; } close(DATA) || die "can't close savefile!"; } # loadnodes(filename,nodearray-ref) # filename=filename to load from # nodearray-ref=ref to 2-dim array to save the nodes into # name => [ rep, C, type, time ] sub loadnodes { my($name,$type,$rep,$C,$time); open(DATA,$_[0]) || return; while (<DATA>) { chomp; /^(name|type|rep|cast|C|C_by|time|node_id): (.*)/ or next; if ($1 eq "name") { $name=$2; } else { ${$_[1]}{$name}{$1}=$2; } } close(DATA) || die "can't close datafile!"; } # getnodes(target,type) # if type=0: # target=list of arrays. 1st dim is the node index, contained array is as # follows: [ nodetitle, noderep, hascool ] # so, if you do getnodes(mynodes,0), then $mynodes[0][0] should # contain the name of the first node # if type=1: # target=name of the file to save the nodeinfo to sub getnodes { $|++; print "Read nodes: "; print "connecting... "; if($use_proxy){ consock(HTTP,$proxyhost,$proxyport) || die "can't connect to proxy!"; } else { consock(HTTP,$E2server,$E2port) || die "can't connect to server!"; } hotfh(HTTP); $request= "GET ". ($use_proxy ? "http://$E2server:$E2port" : ""). "/?node_id=762826 HTTP/1.0\r\n". "Cookie: userpass=$cookie\r\n". "\r\n"; print "sending data... "; print HTTP $request; print "reading data... "; parse_file(*HTTP,$_[0],$_[1]); print "done.\n"; } # parse_file(*FILEHANDLE,target,target_type) # see getnodes() for notes about target and target_type, but this is an internal # function now, sort of # btw, I wonder if there's something wrong with how I'm passing filehandles... # it seems to work but the books don't seem to like it, they just don't tell why sub parse_file { local *E2 = $_[0]; my $data_read=0; my $old_data_read=0; my $DATAREAD_REPORTFREQ=4000; if ($_[2]==1) { # target: file open(DATAOUT,"$_[1]"); } while (<E2>) { $old_data_read=$data_read; $data_read+=length($_); if ($_ =~ /<writeup\s[^>]*? node_id="(\d+)"\s+ createtime="(\d+)-(\d+)-(\d+)\s(\d+):(\d+):(\d+)"\s+ upvotes="([^"]*)"\s+ cooled="(\d+)"\s+ parent_e2node="(\d+)"\s+ downvotes="([^"]*)"\s+ reputation="([^"]*)"\s+ cooledby_user="(.*?)">(.*?)\s\((thing|idea|person|place)\) <\/writeup>/x) { $name=$14; ${$_[1]}{$name}{"cast"}=$8+$11; ${$_[1]}{$name}{"rep"}=$12; ${$_[1]}{$name}{"up"}=$8; ${$_[1]}{$name}{"down"}=$11; ${$_[1]}{$name}{"C"}=$9; ${$_[1]}{$name}{"C_by"}=$13 || "[unknown user]" if $9; ${$_[1]}{$name}{"parent"}=$10; ${$_[1]}{$name}{"type"}=$15; ${$_[1]}{$name}{"time"}=timelocal($7,$6,$5,$4,$3-1,$2); ${$_[1]}{$name}{"node_id"}=$1; } if ($DATAREAD_REPORTFREQ && ((($data_read-$old_data_read)>$DATAREAD_REPORTFREQ) || ($data_read % $DATAREAD_REPORTFREQ) < ($old_data_read % $DATAREAD_REPORTFREQ))) { printf("%.fk ",$data_read/1000); } } close(E2); close(DATAOUT) if $_[2]==1; # return $nodes_read; } # these two functions stolen from TheNastyCanasty's Everything2 Metanoder sub hotfh { my $ofh; $ofh = select $_[0]; $|++; select $ofh; } sub consock { # SYNTAX: consock(filehandle, address, port) my ($remote, $port, $iaddr, $paddr, $proto, $fh, $sval); $fh = $_[0]; $remote = $_[1]; $port = $_[2]; if (!($iaddr = inet_aton($remote))) { return; } $paddr = sockaddr_in($port, $iaddr); $proto = getprotobyname('tcp'); socket($fh, PF_INET, SOCK_STREAM, $proto); $sval = connect($fh, $paddr); return $sval; } sub cleanup { system "stty", "echo"; print "Aborted!\n"; exit(2); }
NEATO UPDATE: If you'd like to test drive my node tracker, see my homenode for the address. Use "update" to save your stats, and "check" to compare current stats to the saved stats. It saves the data on my machine, encrypted so even I can't read them. And it does NOTHING AT ALL with your password. I promise. I am a Cow Of Honor as well as of Doom. Also that version has nifty features that this one doesn't. Give it a shot.
"What is this talk of 'release'? Klingons do not make software 'releases'. Our software 'escapes' leaving a bloody trail of designers and quality assurance people in its wake."
--from "top 12 things likely to be overheard from your klingon programmer"
With that in mind, I present my node tracking perl script. I've been working on it for a long while now - this is actually the third version of it I've written. It's finally grown large enough to escape gibbering and howling into the night.
It's a bit more perlish than kaatunut's version. They share no common code that I know of. Mine's a little over a third as long as his, and vastly less understandable to non-perl programmers. But it was fun to write it that way. It also contains some short subroutines that might be useful to others who want to undertake a similar task.
It gives the following statistics:
It requires the following perl modules, which you can get very easily from CPAN:
Copy, paste, and save the following to a file. Name it 'e2info.pl', or something like that. Netscape has a tendency to add extra spaces to copied text, so you might want to filter them out, by doing:
sed -e 's/^ //' e2info.pl > e2info2.pl mv e2info2.pl e2info.pl
Next, make it executable:
chmod +x e2info.pl
and then move it into your web server's cgi-bin dir. Make sure you change the variables marked under "SET THESE VARIABLES TO MATCH YOUR SITE, FOO", and make sure the directory $datafiledir is writeable for the webserver. You Windows folks out there will want to read dotc's writeup, below.
(old) example output:
Logging in...ok. Getting homenode...ok. Doing user search...ok. Reading node info...done. Reading data file...ok. E2 USER INFO: last update Mon Nov 27 14:56:52 2000 ----------------------------------------------------------------- nodes: 195 xp: 2281 (+9) cools: 72 (+1) maxrep: 86 (+5) minrep: -3 totalrep: 1273 (+12) nodefu: 11.70 WNF: 11.22 coolratio: 36.92% person: 6.2% place: 2.6% thing: 36.9% idea: 54.4% ----------------------------------------------------------------- Created/Nuked/Renamed: Change Title ----------------------------------------------------------------- Created | E2 node tracker Nuked | Suggestions for E2 ----------------------------------------------------------------- Reputation Changes / Cools: Rep +/- C! Title ----------------------------------------------------------------- 6 | +6 | C! | E2 node tracker 86 | +5 | | quotes from sleeping people 4 | +1 | | beer -1 | -1 | | Line Dancing to Depeche Mode in West Virgina 14 | +1 | | Final Fantasy -----------------------------------------------------------------
If you use it, like it, hate it, understand it, get confused by it, want to change it, can't get it to work, or have a good story to tell, PLEASE PLEASE send me a /msg or email. My address is in my homenode and the program itself.
Here goes...
#!/usr/bin/perl -w # e2info.pl - gathers user info from everything2.com. # Copyright (C) 2001 Will Woods <wwoods@cowofdoom.com> # Distributed under the terms of the GNU General Public License, # included here by reference. # # send comments, questions, and stories to the address above. # # TODO: # add checkboxes for saving stats to a "hall o' fame" thing # save node type into datafile (requires changing the datafile format. ECCH.) # make script usable as a CGI or from the commandline # make script safe for mod_perl. i dunno how to do that though. # write cookie-based login thingie to save user preferences #----------------------------------------------------------------------- # SET THESE VARIABLES TO MATCH YOUR SITE, FOO #----------------------------------------------------------------------- $loginpath="/e2info/"; # path to the login page on the webserver $datafiledir="/path/to/e2info/"; # save data here. must end in "/" $encrypt = 0; $compress = 1; $query_ok = 0; $maxdata = 256; # maximum number of bytes of data in a POST #----------------------------------------------------------------------- # these constants come from E2, you shouldn't have to change them unless # E2 changes or you are gathering stats for a different Everything site #----------------------------------------------------------------------- $baseurl="http://www.everything2.com/index.pl"; $secureurl="https://www.everything2.com/index.pl"; @types = ('person', 'place', 'thing', 'idea'); # level: 1 2 3 4 5 6 7 8 9 10 11 12 13 @req_xp = (0,50,200,400,800,1350,2100,2900,4000,7500,13000,23000,38000); @req_nodes = (0,25,70, 150,250,380, 515, 700, 900, 1215,1800, 2700, 4500); #----------------------------------------------------------------------- # don't change anything below here unless you are a perl guru/monk/ninja #----------------------------------------------------------------------- my $version=v1.3.8; $|=1; # unbuffered output umask(077); # only the webserver needs to read these files my $query = (exists($ENV{QUERY_STRING}) && ($ENV{QUERY_STRING} ne "")); my $form = exists($ENV{CONTENT_LENGTH}); my $is_cgi = ($query || $form); # this script may someday be usable on the command-line again, but not now if (!$is_cgi) { print "Location: http"; print "s" if exists($ENV{HTTPS}); print "://$ENV{HTTP_HOST}$loginpath\n\n"; #die("This is a CGI script and must be run through a web server."); } if ($query) { die("GET too long") if (length($ENV{QUERY_STRING}) > $maxdata); if ($ENV{QUERY_STRING} eq "source") { print "Content-Type: text/plain\n\n"; open(SOURCE, $ENV{SCRIPT_FILENAME}); while (<SOURCE>) { s,$datafiledir,/path/to/e2info/,; # obscure pathnames print; } exit(0); } if ($ENV{QUERY_STRING} eq "version") { print "Content-Type: text/plain\n\n"; print join('.', map {ord($_)} split(//,$version)); exit(0); } if (!$query_ok) { &printheader; &error("Auto-login disabled."); } } # Now that we're done with the quick stuff, load modules use Digest::MD5 qw(md5_hex); use LWP::UserAgent; # from libwww-perl, available at your local CPAN mirror if ($compress) { use Compress::Zlib; } if ($encrypt) { use Crypt::Blowfish; } $ua = LWP::UserAgent->new(); if (!$is_cgi) { $ua->env_proxy(); } &printheader(); $line='-'x65; if ($form) { my $buf; &error("no input") unless ($ENV{CONTENT_LENGTH}); die("Too much POSTed data") if ($ENV{CONTENT_LENGTH} > $maxdata); # get the data from the form read(STDIN, $buf, $ENV{CONTENT_LENGTH}); @pairs = split(/&/, $buf); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $FORM{$name} = $value; } } # get data from the query string, overriding the form if (($query) && ($query_ok)) { my @pairs = split(/&/, $ENV{QUERY_STRING}); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $FORM{$name} = $value; } } if ($FORM{debug}) { printf("CONTENT_LENGTH=%u, length(QUERY_STRING)=%u\n", $ENV{CONTENT_LENGTH}, length($ENV{QUERY_STRING})); foreach (keys(%FORM)) {print("\$FORM{$_}=\"$FORM{$_}\"\n");} } &error("no username given") unless ($FORM{user}); &error("no password given") unless ($FORM{pass}); $update = (lc($FORM{op}) eq 'update'); $datafile = $datafiledir . md5_hex(lc($FORM{user})); $tmpdatafile = $datafile . ".tmp"; # If we're doing an update, just move the temp file over the old data and # dump some stats. if ($update) { print "Updating data file..."; rename($tmpdatafile, $datafile) or die "failed to save temporary data: $!"; print "</pre>\n"; ($inforef, undef, $repref) = &readdatafile($datafile); &printinfo($inforef,0); # no old info &printrepinfo($repref,$inforef); &printfooter("update"); exit(0); } # Okay, we're not doing an update. Let's get the new info from E2. # get the User Search XML page, and array-ify it if (exists($FORM{data}) && $FORM{data} !~ /\//) { open(DATAFILE,$FORM{data}); @data = <DATAFILE>; close DATAFILE; } else { print "Getting node info from E2...\n"; @data = split(/\n/,&login_and_get_info($FORM{user},$FORM{pass})); } # check to make sure we really got node info if (scalar(@data) == 1) { if ($data[0] == -1) { &error("E2 is temporarily offline - the Word Galaxy generator is up."); } else { &error("Failed to get node info from E2."); } } # make sure the node info is complete if ($data[$#data] ne "</USERSEARCH>") { &error("User search incomplete or corrupt."); } foreach ('nodes', @types) {$info{$_} = 0;} # initialize counters # Read the info out of the User Search page. print "Parsing node info...\n"; foreach (@data) { # loop over each line in the page if (/^<writeup/g) { # if this line is about a writeup.. while (/ (\w+)=\"(.*?)\"/gc) { $n{$1}=$2; } # get node info ($name, $type) = />(.*) \(([a-z]+)\)<\/writeup>/gc; if ($FORM{debug}) { print "Found writeup: $name"; } if (!grep($type,@types)) { push(@types,$type); $info{$type} = 0; if ($FORM{debug}) { print " WARNING: unknown node type"; } } if ($FORM{debug}) { print " (node_id=$n{node_id})\n"; } $info{$type}++; $info{nodes}++; # dmd error here? if ($n{cooled}) { $info{cools} += $n{cooled} } # multiple cools, argh $rep{$n{reputation}}++; # keep track of how many of each rep $info{totalrep} += $n{reputation}; $node{$n{node_id}} = [$n{reputation},$n{cooled},$name]; $parent{$n{node_id}} = $n{parent_e2node}; } elsif (/<INFO [^>]*experience=\"(-?\d+)\"[^>]*>/i) { $info{xp} = $1; } } undef(@data); # free the memory used by @data if ($info{nodes}) { %info = %{&computeinfo(\%info,\%rep)}; } # write the info to the temporary datafile &writedatafile($tmpdatafile, \%info, \%node) or die "failed to write $tmpdatafile: $!"; # read the saved data, to compare with the new data. ignore old reps. print "Reading saved data file..."; if ($FORM{debug}) {print "\n(\$datafile = \"$datafile\")";} ($oldinforef, $oldnoderef, undef) = &readdatafile($datafile); if ($oldinforef == 0) { # No old data means we have to write this data down.. just like an update $update=1; print " missing. Will be created.\n"; } else { %oldinfo = %$oldinforef, %oldnode = %$oldnoderef; print "\n"; } print "</pre>\n"; &printinfo(\%info, \%oldinfo); &printrepinfo(\%rep, \%info); if ($update) { # no old data means no changes to show.. bail out! rename($tmpdatafile, $datafile) or die "failed to save temporary data: $!"; &printfooter("update"); exit(0); } # okay, we're ready to print all the changes.. &printnodediff(\%node, \%oldnode, \%parent); print("</pre></font></td></tr></table>"); &printfooter("check"); exit(0); #----- end of main program ------------------------------ #----- subroutines -------------------------------------- sub uniq { # takes a list argument # assumes the list is sorted (use sort() if not) # returns that list with duplicates removed # examples: @foo=uniq(@sorted); @foo=uniq(sort(@random)); my (@list, @result); @list = @_; @result = (); foreach (@list) { if ((!@result) || ($result[-1] != $_)) {push(@result,$_);} } return(@result); } sub url_encode { # takes a scalar argument and returns that argument after URL-encoding $_ = $_[0]; # change unsafe characters (except for space) to encoded value s/[^ a-zA-Z0-9._\-!~*\'()]/sprintf '%%%02X', ord($1)/eg; # change spaces to + tr/ /+/; return $_; } sub encryptbuf { # takes two arguments: $bufref, $key # encrypts the data pointed to by $bufref in memory. # example: encryptbuf(\$data,$key); my ($bufref, $key) = @_; my $size = length($$bufref); my $cipher = Crypt::Blowfish->new($key . "X"x(8-length($key))); my $pos = 0; $$bufref = pack("Nx4",$size) . $$bufref; $size += 8; while ($size % 8) { $$bufref .= "\0"; $size++; } # pad buffer with nulls while ($pos < $size) { substr($$bufref,$pos,8) = $cipher->encrypt(substr($$bufref,$pos,8)); $pos += 8; } } sub decryptbuf { # takes two arguments: $bufref, $key # decrypts the data pointed to by $bufref in memory. # example: decryptbuf(\$data,$key); my ($bufref, $key) = @_; my $cipher = Crypt::Blowfish->new($key . "X"x(8-length($key))); my $size = unpack("Nx4",$cipher->decrypt(substr($$bufref,0,8,""))); my $pos = 0; while ($pos < $size) { substr($$bufref,$pos,8) = $cipher->decrypt(substr($$bufref,$pos,8)); $pos += 8; } if ($pos > $size) { substr($$bufref,$size,$pos-$size,""); } # trim padding } sub login_and_get_info { # takes two arguments: $username, $password # assumes that $ua is a valid HTTP::UserAgent object # returns the contents of the User Search XML page in a scalar variable # example: $info = login_and_get_info($user,$pass); # node_id 762826 = User Search XML Ticker my $req = HTTP::Request->new('GET', "$secureurl?node_id=762826&op=login&user=$_[0]&passwd=$_[1]"); my $response = $ua->request($req); return(0) if ($response->is_error); if ($response->content() =~ m|\n<writeup node_id=|) { return($response->content()); } elsif ($response->content() =~ m|<title>Word Galaxy</title>|) { return(-1); } else { return(0); # this will also happen if you have no nodes. } } sub computeinfo { # takes two arguments: $inforef, $repref # returns a hash ref # calculates node-fu, coolratio, WNF, reputation max, min, mean, mode, # median, total, and sets $info{time} # example: $inforef = &computeinfo(\%info,\%rep); my @reps; my ($n, $i, $max); my ($inforef, $repref) = @_; my %info=%$inforef; my %rep =%$repref; $info{wnf} = (($info{totalrep}+(10*$info{cools}))/$info{nodes})+1; $info{nodefu} = $info{xp}/$info{nodes}; $info{coolratio} = ($info{cools}*100)/$info{nodes}; @reps = sort {$a<=>$b} (keys(%rep)); $info{maxrep} = $reps[$#reps]; $info{minrep} = $reps[0]; $info{meanrep} = $info{totalrep} / $info{nodes}; $n = int($info{nodes}/2); for ($i = 0; $n >= 0; $i++) { $n -= $rep{$reps[$i]}; } $info{medianrep} = $reps[$i-1]; $max = 0; foreach (@reps) { if ($rep{$_} > $max) { $max = $rep{$_}; $info{moderep} = "$_"; } elsif ($rep{$_} == $max) { $info{moderep} .= ",$_"; } } $n = 0; while (($info{xp} > $req_xp[$n]) && ($info{nodes} > $req_nodes[$n])) { $n++; } $info{level} = $n; $info{req_xp} = $req_xp[$n] - $info{xp}; $info{req_nodes} = $req_nodes[$n] - $info{nodes}; if ($info{req_xp} < 0) { $info{req_xp} = 0; } if ($info{req_nodes} < 0) { $info{req_nodes} = 0; } $info{time} = time; return(\%info); } sub readdatafile { # takes one argument: $filename # gets stored user info from $filename. # returns a list of three hash references. # example: ($inforef, $noderef, $repref) = readdatafile($filename); my $file = $_[0]; if (! -r $file) { return(0); } else { my (%info, %node, %rep, $buf, @data); $info{time} = (stat($file))[9]; open(DATA,$file); $buf = ""; while(read(DATA,$_,4096)) { $buf .= $_; } &decryptbuf(\$buf,$FORM{pass}) if ($encrypt); $buf = uncompress(\$buf) if ($compress); @data=split(/\n/,$buf); undef($buf); chomp(($info{xp}, $info{nodes}, $info{cools}, $info{totalrep}) = split(/:/,shift(@data))); while ($_ = shift(@data)) { chomp; if (/^(\d+):(-?\d+):(\d+):(.*)$/) {@{$node{$1}}=($2,$3,$4);} if ($FORM{debug}) { print "Found writeup: $4 (node_id=$1)\n"; } $rep{$2}++; } if ($info{nodes}) { %info = %{&computeinfo(\%info,\%rep)}; } return(\%info,\%node,\%rep); } } sub writedatafile { # takes three arguments: $filename, $inforef, $noderef # inforef and noderef are references to the info and node hashes. # returns 1 on success or 0 on failure. # example: writedatafile($file, \%info, \%node) or die "failed: $!"; my ($file, $ir, $nr) = @_; my %info = %$ir; my %node = %$nr; my ($data, $bytes); $data = "$info{xp}:$info{nodes}:$info{cools}:$info{totalrep}\n"; foreach (sort {$b<=>$a} keys(%node)) { $data .= "$_:" . join(":",@{$node{$_}}) . "\n"; # dmd error here } $data = compress(\$data) if ($compress); &encryptbuf(\$data,$FORM{pass}) if ($encrypt); open(DATA,">$file"); print DATA $data; close(DATA); } sub infodiff { # takes three arguments: $key, $inforef, $oldinforef # returns a string that shows the value of that piece of the %info hash, # and the change in the value, if any. # example: infodiff('xp',\%info,\%oldinfo) could return "132", "133 (+1)", etc. my ($arg,$ir,$or) = @_; my %info = %$ir; my %oldinfo = %$or; my $str = $info{$arg}; return($str) if ($update); # don't report changes on update if ($oldinfo{$arg} != $info{$arg}) { $str .= " (".($info{$arg}>$oldinfo{$arg}?'+':''); $str .= ($info{$arg}-$oldinfo{$arg}).")"; } return($str); } sub printinfo { # takes two arguments: $inforef, $oldinforef # $oldinforef is ignored if $update = 1 # print info summary for the given info hash # uses global variable @types # example: printinfo(\%info, \%oldinfo); my ($ir, $or) = @_; my %info = %$ir; my %oldinfo = %$or; my $line='-'x65; print "<table border=0 align=center><tr><td><font color=\"\#FFFFFF\"><pre>\n"; printf(' <a href="http://www.everything2.com/">E2</a> USER INFO: %s %s ----------------------------------------------------------------- nodes: %-10s xp: %-10s cools: %-10s level: %-10s xp req: %-10s nodes req: %-10s max rep: %-10s min rep: %-10s total rep: %-10s <a href="http://everything2.com/index.pl?node_id=768937">node-fu</a>: %-4.2f'. ' <a href="http://www.everything2.com/index.pl?node_id=841514">WNF</a>: %-4.2f'. ' coolratio: %-4.2f%%', $update ? "updated at" : "changes since", scalar(localtime($update?$info{time}:$oldinfo{time})), &infodiff('nodes',$ir,$or), &infodiff('xp',$ir,$or), &infodiff('cools',$ir,$or), $info{level}, $info{req_xp}, $info{req_nodes}, &infodiff('maxrep',$ir,$or),&infodiff('minrep',$ir,$or),&infodiff('totalrep',$ir,$or), $info{nodefu}, $info{wnf}, $info{coolratio}); if (($info{nodes}) && (!$update)) { # FIXME: save types into datafile so we have type info on update print("\n\n"); foreach (@types) { printf("%s: %-3.1f%% ",$_,(100 * $info{$_})/($info{nodes})); } } print("\n$line\n</pre></font></td></tr></table>") } sub printrepinfo { # takes two arguments: $repref, $inforef # print a graph of number of nodes per reputation, and statistical info # about reputations. # example: &printrepinfo(\%rep, \%info); my ($rr, $ir) = @_; my %info = %$ir; my %rep = %$rr; my @reps=sort {$a<=>$b} keys(%rep); my $height; my $lynx = $ENV{HTTP_USER_AGENT} =~ /Lynx/ ? 1 : 0; my $top = $rep{(sort{$rep{$a}<=>$rep{$b}} keys(%rep))[$#reps]}; # whew! printf ' <table border="0" align="%s" cellpadding="0" cellspacing="2"><tr> <td align="%s" colspan="%u"><font color="#FFFFFF"><tt> Number of nodes per reputation:<br><br></tt></font></td></tr><tr> ',$lynx?"left":"center",$lynx?"left":"center",@reps+1; if ($lynx) { print "<br><pre>\n\n"; foreach (@reps) { $height = int(($rep{$_}*66)/$top); printf("%3i: %s %i\n", $_, "#" x $height, $rep{$_}); } print "</pre>\n"; } else { foreach (@reps) { $height = int(($rep{$_}*150)/$top); printf(' <td valign="bottom" align="center"><tt><small><font color="#FFFFFF"> %-3i<br><img src="/bar.gif" width="5" height="%u" align="center"><br>%-3i </font></small></tt></td> ',$rep{$_},$height,$_); } } printf(' </tr><tr><td align="center" colspan="%u"><font color="#FFFFFF"><tt> <a href="http://everything2.com/index.pl?node_id=791367">mean</a> rep: %-10.2f <a href="http://everything2.com/index.pl?node_id=968814">median</a> rep: %-10i rep <a href="http://everything2.com/index.pl?node_id=793853">mode</a>: %-10s </tt></font></td></tr></table> ',@reps+1,$info{meanrep},$info{medianrep},$info{moderep}); } sub printnodediff { # print node status changes # takes three arguments: $noderef, $oldnoderef, $parentref # prints the differences in the nodes between %oldnode and %node. # uses %parent for links to "full" nodes # uses global var $baseurl my ($didhead, $head, %node, %oldnode, %parent); my ($nr, $onr, $p) = @_; %node = %$nr; %oldnode = %$onr; %parent = %$p; print "<table border=0 align=center><tr><td><font color=\"\#FFFFFF\"><pre>\n"; $head="\n Created/Nuked/Renamed:\nChange Title\n$line\n"; $didhead = 0; foreach (uniq(sort({$b<=>$a} keys(%node),keys(%oldnode)))) { if (!exists($node{$_})) { if (!$didhead) {print $head; $didhead = 1;} printf("Nuked | %s\n",$oldnode{$_}->[2]); next; } if (!exists($oldnode{$_})) { if (!$didhead) {print $head; $didhead = 1;} printf("Created | <a href=\"%s\">%s</a> · <a href=\"%s\">(full)</a>\n", $baseurl."?node_id=".$_, $node{$_}->[2], $baseurl."?node_id=".$parent{$_}); $oldnode{$_} = [0,0,$node{$_}->[2]]; } if ($node{$_}->[0] != $oldnode{$_}->[0]) {push @nodes, $_} if ($node{$_}->[1] != $oldnode{$_}->[1]) {push @nodes, $_} if ($node{$_}->[2] ne $oldnode{$_}->[2]) { # dmd error here if (!$didhead) {print $head; $didhead = 1;} printf("Renamed | %s-><a href=\"%s\">%s</a> · <a href=\"%s\">(full)</a>\n", $oldnode{$_}->[2], $baseurl."?node_id=".$_, $node{$_}->[2], $baseurl."?node_id=".$parent{$_}); } } if ($didhead) {print $line, "\n"; $change = 1;} # print node reputation / cool changes $head="\n Reputation Changes / Cools:\n Rep +/- C! Title\n$line\n"; $didhead = 0; foreach (sort {($node{$b}->[0]-$oldnode{$b}->[0])<=>($node{$a}->[0]-$oldnode{$a}->[0])} uniq(@nodes)) { if (!$didhead) {print $head; $didhead = 1;} my $d = $node{$_}->[0]-$oldnode{$_}->[0]; # yarg, there's probably a better way to do this my $c = $node{$_}->[1]-$oldnode{$_}->[1]; printf(" %-4i| %-4s| %4s | <a href=\"%s\">%s</a> · <a href=\"%s\">(full)</a>\n", $node{$_}->[0], $d?sprintf("%+i",$d):' -- ', $c?"+${c}C!":' -- ', $baseurl . "?node_id=" . $_, $node{$_}->[2], $baseurl . "?node_id=" . $parent{$_}); } if ($didhead) { print "$line\n"; } elsif (!$change) { print "No nodes changed.\n"; } } sub printfooter { # close the table and print the refresh/update buttons if ($_[0] eq "check") { $buttons = ' <input type=submit name="op" value="refresh"> · <input type=submit name="op" value="update"> '; } else { $buttons = ' <input type=submit name="op" value="check"> '; } print " <font color=\"\#000000\"> <form action=\"$ENV{SCRIPT_NAME}\" method=POST> "; foreach $key (keys(%FORM)) { next if ($key eq "op"); print " <input type=hidden name=\"$key\" value=\"$FORM{$key}\">\n"; } print " <center><small> $buttons </small></center> </form> </font> <hr> <p align=\"center\"><font face=\"Lucida,Verdana,Arial,Helvetica\"> [<a href=\"$loginpath\">back</a>] </font></p> </body> </html> "; } sub printheader { print 'Content-Type: text/html <html> <head> <title>E2 Node Tracker Results</title> <style type="text/css"> <!-- a { text-decoration: none; font-weight: bold; } --> </style> </head> <body bgcolor="#000000" text="#FF0000" link="#FF8800" vlink="#CC5500" alink="#CCCC00"> <img src="/images/codelong_s.jpg" align="right"> <p><b><big><font face="Lucida,Verdana,Arial,Helvetica"> E2 Node Tracker </font></big></b></p> <pre> '; } sub error { $FORM{user} = "" unless (exists($FORM{user})); $FORM{pass} = "" unless (exists($FORM{pass})); print " Error: $_[0]\n</pre> <form action=\"$ENV{SCRIPT_NAME}\" method=POST> Username: <input type=text name=\"user\" value=\"$FORM{user}\" size=30><br> Password: <input type=password name=\"pass\" value=\"$FORM{pass}\" size=30><br> <center><small> <font color=\"\#000000\"> <input type=submit name=\"op\" value=\"retry\"> </font> </small></center> </form> <hr> <p align=\"center\"><font face=\"Lucida,Verdana,Arial,Helvetica\"> [<a href=\"$loginpath\">back</a>] </font></p> </body> </html> "; exit(0); }
This can also be found at
http://home.cinci.rr.com/dancers/code/e2info.pl
/msg avjewe or email ajewell@cinci.rr.com with comments, questions, fixes and such.
#!/usr/local/bin/perl -w # e2info.pl - gathers user info from everything2.com. # Copyright (C) 2000,2001 Will Woods (a.k.a. Cow Of Doom) # Copyright (C) 2002 Andy JJewell (ajewell@cinci.rr.com) # Distributed under the terms of the GNU General Public License, # included here by reference. # # send comments, questions, and stories to the address above. # history: # v1.0.22 27 january 2003. misc initialization fixes for the first run. # v1.0.21 3 December 2002. Slight output change to show +/- in total as well as delta # v1.0.20 23 November 2002. Bug fixes to yesterdays changes. Got some signs wrong in the output. # v1.0.19 22 November 2002. Better formatting. Show new votes when rep uchanged. # v1.0.18 14 October 2002. Updated documentation, added --help # v1.0.17 14 October 2002. General tidying of output. Added "ext" option. # v1.0.16 27 September 2002. Subtract Nuke Requests and such. Add vote stats. # v1.0.15 18 September 2002. Appends summary, with date to .e2history # v1.0.14 8 September 2002. Now tracks merit, devotion and other stats. # v1.0.13 28 August 2002. Now tracks number of messages. # v1.0.12 31 July 2002. Changes in formats of a couple of different things. # v1.0.11 23 May 2002. Yet another slight change in the login format. # v1.0.10 19 March 2002. Another slight change in the login format. # v1.0.9 18 Oct 2001. Integrated dotc's fix for fractional votes. # v1.0.8 12 Sept 2001. Fixed new bug parsing saved data file. # v1.0.7: 12 Sept 2001. show (+x/-y) with reputation. # change "update" to behave like "both". # v1.0.6: 22 Aug 2001. Show number of C!s as well as change. # v1.0.5: 21 Aug 2001. Generalize type handling. # Types outside of the basic four no longer crash. # Added "use strict" and fixed as necessry. # v1.0.4: 7 Aug 2001. Taken over by avjewe. # Updated for various format changes, multiple cools # v1.0.3: The format of the Login screen changed, so no one # could log in. Fixed. # v1.0.2: I was miscalculating Writeup Node-fu (WNF). fixed. # v1.0.1: Fixed problem that would happen if file was saved with blanks # at the beginning of each line (e.g. copy-and-paste from Netscape) # Fixed bug where new nodes would not be displayed in Rep/Cool list # v1.0.0: (initial release) use strict; $0="$0"; # Perl magic to clean the commandline from the process list my $version = '1.0.21'; use LWP::UserAgent; # these are both part of libwww-perl, available use HTTP::Cookies; # at your friendly local CPAN mirror my $baseurl="http://www.everything2.com/index.pl"; my $datafile="$ENV{HOME}/.e2info"; # save data here my $historyfile="$ENV{HOME}/.e2history"; # save here my $meritHist="$ENV{HOME}/.meritHist"; # save here my $totalHist="$ENV{HOME}/.totalHist"; # save here my $badLogin="$ENV{HOME}/.badLogin"; # save here my $ext = 0; $|=1; my $ua = LWP::UserAgent->new(); $ua->env_proxy(); my $cookies = HTTP::Cookies->new(); $ua->cookie_jar($cookies); $ARGV[0] = "" if (@ARGV == 0); if ($ARGV[0] eq '--help') { HELP(); exit(0); } if ((@ARGV < 2) || (@ARGV > 3)) { USAGE(); exit(1); } sub HELP { USAGE(); print " Provides these statistics : Nodes : Number of write-ups by you XP : Your current XP total Cools : Sum of the cools of all your write-ups Max Rep : The Maximum reputaion of any of your write-ups Min Rep : The Minimum reputaion of any of your write-ups Total Rep : Sum of the reputaion of all your write-ups Node Fu : XP / Nodes WNF : Writeup Node Fu (Total Rep + Cools*10) / Nodes + 1 Cool Ratio : Cools / Nodes Messages : Number of messages in your in box Average Rep: Arithmetic mean of the reps of all your writeups Median Rep : The rep of the middle node, after sorting by rep Merit : Arithmetic mean of the reps of the middle half of your write-ups Devotion : Merit * Nodes Merit Range: The rep range involved in your Merit Up votes : Total up votes you've received Down votes : Total down votes you've received Votes : Total up or down votes you've received Max Cools : Number of cools on your most-cooled wu Max Votes : Number of votes on your most-voted writeup Popularity : Up votes / Votes a breakdown of your write-ups by type If you specify 'ext' on the command line, you get these Top 5's : Highest Rep Lowest Rep Most Votes Fewest Votes Most Cools "; } sub USAGE { print " E2 Node Tracker by Cow Of Doom and avjewe, version $version USAGE: $0 <username> <password> [update|check|both|ext] Displays various statistics about you and your writeups, and shows you what has changed since your last run By default, the new stats are written to ~/.e2info If 'check' is specified, ~/.e2info is not updated If 'ext' is specified, the report also contains the top 5 write-ups of yours based on each of a number of critera. Also appends a line to ~/.e2history with each run, with tab separated columns : date, XP, node, cools, total rep, messages, merit, devotion, mean rep, median rep, upvotes, downvotes, maxcools, maxvotes For more help, use --help "; print ' Feedback to ajewell@cinci.rr.com or avjewe at E2 '; } my $update = 0; my $postupdate = 0; if (@ARGV == 3) { if (lc($ARGV[2]) eq "update") { $postupdate = 1; } elsif (lc($ARGV[2]) eq "both") { $postupdate = 1; } elsif (lc($ARGV[2]) eq "ext") { $ext = 5; $postupdate = 1; } elsif (lc($ARGV[2]) =~ m/^ext(\d+)$/) { $ext = $1; $postupdate = 1; } elsif (lc($ARGV[2]) ne "check") { USAGE(); } } print "Logging in..."; (my $homenode = &login(@ARGV)) or die "failed"; # get the XP count from the user's homenode. print "ok.\nGetting homenode..."; my %info; my $snork = &getnode($homenode); ($info{xp}) = ($snork =~ m|HREF="/index.pl\?.*createtime%20DESC.*</a>/(-?\d+)|) or die "failed"; # get the User Search XML page, and array-ify it print "ok.\nDoing user search..."; my $ffoo = getnode(762826); my @data = split(/\n/,$ffoo) # 762826 = User Search XML Ticker or die "failed"; print "ok.\n"; foreach ('nodes') {$info{$_} = 0;} # initialize counters my %node; my %types; # Read the info out of the User Search page. my @reps; my @wudata; foreach (@data) { # loop over each line in the page if (/^<writeup/g) { # if this line is about a writeup.. my %n; while (/ (\w+)=\"(.*?)\"/gc) { $n{$1}=$2; } # get node info my ($name, $type) = />(.*) \(([a-z]+)\)<\/writeup>/gc; if (($name eq "E2 Nuke Request") or ($name eq "Edit these E2 titles") or ($name eq "Nodeshells marked for destruction") or ($name eq "Broken Nodes")) { $info{xp}--; next; } $n{name} = $name; $n{type} = $type; $n{votes} = $n{downvotes} + $n{upvotes}; push(@wudata, \%n); $types{$type} = 0 unless defined($types{$type}); $types{$type}++; $info{nodes}++; push(@reps, $n{reputation}); $info{totalrep} += $n{reputation}; $info{cools} += $n{cooled}; $info{downvotes} += $n{downvotes}; $info{upvotes} += $n{upvotes}; my $totVotes = $n{downvotes}+$n{upvotes}; if ($info{nodes} == 1) {$info{maxrep}=$info{minrep}=$n{reputation}} if ($info{nodes} == 1) {$info{maxvotes}=$totVotes} if ($info{nodes} == 1) {$info{maxcools}=$n{cooled}} if ($n{reputation} > $info{maxrep}) {$info{maxrep}=$n{reputation}} if ($n{reputation} < $info{minrep}) {$info{minrep}=$n{reputation}} if ($totVotes > $info{maxvotes}) {$info{maxvotes} = $totVotes} if ($n{cooled} > $info{maxcools}) {$info{maxcools} = $n{cooled}} $node{$n{node_id}} = [$n{reputation},$n{cooled},$name,$n{upvotes},$n{downvotes}]; } } my @rep2 = sort {$a <=> $b} @reps; my $sz = 0 + @rep2; my $stt = int(($sz)/4); my $stp = int(($sz*3)/4 + 0.5); my $tot = 0; my $tot2 = 0; my @counts; for (my $i=0; $i<500; ++$i) { push @counts, 0; } for (my $i=$stt; $i<$stp; ++$i) { my $rep = $rep2[$i]; $tot += $rep; $counts[$rep]++ if ($rep >= 0); } open(DATAFILE, ">>$meritHist") or die "Couldn't open $meritHist: $!"; print DATAFILE scalar gmtime; for (my $i=0; $i<50; ++$i) { print DATAFILE "\t$i:$counts[$i]", if ($counts[$i]); } print DATAFILE "\n"; close(DATAFILE); for (my $i=0; $i<500; ++$i) { $counts[$i] = 0; } my $minrep = $rep2[0]; for (my $i=0; $i<$sz; ++$i) { my $rep = $rep2[$i]; $tot2 += $rep; $counts[$rep - $minrep]++; } open(DATAFILE, ">>$totalHist") or die "Couldn't open $totalHist: $!"; print DATAFILE scalar gmtime; for (my $i=0; $i<500; ++$i) { my $rep = $i + $minrep; print DATAFILE "\t$rep:$counts[$i]" if ($counts[$i]); } print DATAFILE "\n"; close(DATAFILE); my $foo = $stp-$stt; my $median = $rep2[$sz/2]; my $average = $tot2/$sz; my $merit = $tot/($stp-$stt); my $devotion = int($merit * @rep2 + 0.5); $info{average} = $average; $info{median} = $median; $info{merit} = $merit; $info{devotion} = $devotion; my $minmerit = $rep2[$stt]; my $maxmerit = $rep2[$stp-1]; undef(@data); # free the memory used by @data if ($info{nodes}) { $info{wnf} = (($info{totalrep}+(10*$info{cools}))/$info{nodes})+1; $info{nodefu} = $info{xp}/$info{nodes}; $info{coolratio} = ($info{cools}*100)/$info{nodes}; } my ($oir, $onr) = &readdatafile($datafile); my %oldinfo; my %oldnode; if ($oir == 0) { $update=1; print "missing. Will be created.\n"; } else { %oldinfo = %$oir, %oldnode = %$onr; } sub Update { open(DATAFILE,">$datafile") or die "Couldn't open $datafile: $!"; print DATAFILE "$info{xp}:$info{nodes}:$info{cools}:$info{totalrep}:$info{messages}:", "$info{merit}:$info{devotion}:$info{average}:$info{median}:$info{upvotes}:$info{downvotes}:", "$info{maxcools}:$info{maxvotes}\n"; foreach (sort {$b<=>$a} keys(%node)) { print DATAFILE "$_:",join(":",@{$node{$_}}),"\n"; } close(DATAFILE); open(DATAFILE, ">>$historyfile") or die "Couldn't open $datafile: $!"; my $foo = scalar gmtime; print DATAFILE "$foo\t$info{xp}\t$info{nodes}\t$info{cools}\t$info{totalrep}\t$info{messages}\t", "$info{merit}\t$info{devotion}\t$info{average}\t$info{median}\t$info{upvotes}\t$info{downvotes}\t", "$info{maxcools}\t$info{maxvotes}\n"; close(DATAFILE); } if ($update) { Update(); exit(0); # no point in printing stats right after an update. } sub MakeEven { my ($aref) = @_; my $len = 0; foreach (@$aref) { $len = length($_) if (length($_) > $len) } foreach (@$aref) { if (m/--$/) { $_ .= "-" x ($len - length($_)); } else { $_ .= " " x ($len - length($_)); } } }; $oldinfo{votes} = $oldinfo{upvotes} + $oldinfo{downvotes}; $info{votes} = $info{upvotes} + $info{downvotes}; $info{popularity} = 0; $oldinfo{popularity} = 0; $info{popularity} = $info{upvotes} * 100 / $info{votes} if ($info{votes}); $oldinfo{popularity} = $oldinfo{upvotes} * 100 / $oldinfo{votes} if ($oldinfo{votes}); my $line='-'x65; printf(" E2 USER INFO: last update %s -----------------------------------------------------------------\n", scalar(localtime((stat($datafile))[9]))); my @c1; my @c2; my @c3; push @c1, "Nodes: " . infodiff('nodes'); push @c2, "XP: " . infodiff('xp'); push @c3, "Cools: " . infodiff('cools'); push @c1, "Max Rep: " . infodiff('maxrep'); push @c2, "Min Rep: " . infodiff('minrep'); push @c3, "Total Rep: " . infodiff('totalrep'); push @c1, "Node Fu: " . infodiff_fp('nodefu'); push @c2, "WNF: " . infodiff_fp('wnf'); push @c3, "Cool Ratio: " . infodiff_fp('coolratio', 'yes'); push @c1, "Messages: " . infodiff('messages'); push @c2, "Average Rep: " . infodiff_fp('average'); push @c3, "Median rep: " . infodiff('median'); push @c1, "Merit: " . infodiff_fp('merit'); push @c2, "Devotion: " . infodiff('devotion'); push @c3, "Merit Range: $minmerit to $maxmerit"; push @c1, "Up votes: " . infodiff('upvotes'); push @c2, "Down votes: " . infodiff('downvotes'); push @c3, "Votes : " . infodiff('votes'); push @c1, "Max Cools: " . infodiff('maxcools'); push @c2, "Max Votes : " . infodiff('maxvotes'); push @c3, "Popularity: " . infodiff_fp('popularity', 'yes'); MakeEven(\@c1); MakeEven(\@c2); for (my $i=0; $i<7; ++$i) { print "$c1[$i] $c2[$i] $c3[$i]\n"; } print "\n"; if ($info{nodes}) { foreach (keys %types) { printf("%s: %3.1f%% ",$_,(100 * $types{$_})/($info{nodes})); } } print("\n$line\n"); my $head=" Created/Nuked/Renamed: Change Title\n$line\n"; my $didhead = 0; my @nodes; foreach (uniq(sort({$b<=>$a} keys(%node),keys(%oldnode)))) { if (!exists($oldnode{$_})) { if (!$didhead) {print $head; $didhead = 1;} printf("Created | %s\n",$node{$_}->[2]); $oldnode{$_} = [0,0,$node{$_}->[2]]; push @nodes, $_; } elsif (!exists($node{$_})) { if (!$didhead) {print $head; $didhead = 1;} printf("Nuked | %s\n",$oldnode{$_}->[2]); } else { if ($node{$_}->[0] != $oldnode{$_}->[0]) {push (@nodes, $_);} if ($node{$_}->[1] != $oldnode{$_}->[1]) {push (@nodes, $_);} if ($node{$_}->[3] != $oldnode{$_}->[3]) {push (@nodes, $_);} if ($node{$_}->[4] != $oldnode{$_}->[4]) {push (@nodes, $_);} if ($node{$_}->[2] ne $oldnode{$_}->[2]) { if (!$didhead) {print $head; $didhead = 1;} printf("Renamed | %s->%s\n",$oldnode{$_}->[2],$node{$_}->[2]); } } } my $change; if ($didhead) {print $line, "\n"; $change = 1;} $head=" Reputation Changes / Cools:\n"; $didhead = 0; my (@a1, @a2, @a3, @a4, @a5); foreach (uniq(@nodes)) { if (!$didhead) { $didhead = 1; print $head; push @a1, "Rep"; push @a1, "---"; push @a2, "+/-"; push @a2, "---"; push @a3, "C!"; push @a3, "--"; push @a4, "+/-"; push @a4, "---"; push @a5, "Title"; push @a5, "-----"; } $oldnode{$_}->[3] = 0 unless defined($oldnode{$_}->[3]); $oldnode{$_}->[4] = 0 unless defined($oldnode{$_}->[4]); my $d = $node{$_}->[0]-$oldnode{$_}->[0]; my $d1 = $node{$_}->[3]-$oldnode{$_}->[3]; my $d2 = $node{$_}->[4]-$oldnode{$_}->[4]; my $dcool = $node{$_}->[1] - $oldnode{$_}->[1]; if ($node{$_}->[3] && $node{$_}->[4]) { push @a1, sprintf "%+i (%+i/%+i)", $node{$_}->[0], $node{$_}->[3], -$node{$_}->[4]; } else { push @a1, sprintf "%+i", $node{$_}->[0]; } if ($d1 and $d2) { push @a2, sprintf "%+i (%+i/%+i)", $d, $d1, -$d2; } else { push @a2, sprintf "%+i", $d; } push @a3, sprintf "%i", $node{$_}->[1]; if ($dcool) { push @a4, sprintf "%+i", $dcool; } else { push @a4, ""; } push @a5, $node{$_}->[2]; } if ($didhead) { MakeEven(\@a1); MakeEven(\@a2); MakeEven(\@a3); MakeEven(\@a4); for (my $i=0; $i < @a1; ++$i) { print "$a1[$i] $a2[$i] $a3[$i] $a4[$i] $a5[$i]\n"; } print "\n"; } elsif (!$change) { print "No nodes changed.\n"; } sub PrintOne { my $node = $_[0]; print "$node->{reputation} (+$node->{upvotes}/-$node->{downvotes})"; print " $node->{cooled} C! $node->{name}\n"; } if ($postupdate) { Update(); } if ($ext) { my @wu = sort {$a->{reputation} <=> $b->{reputation}} @wudata; print "\nTop $ext Lowest Rep : \n"; for (my $i=0; $i<$ext; ++$i) { PrintOne($wu[$i]); } print "\nTop $ext Highest Rep : \n"; for (my $i=0; $i<$ext; ++$i) { PrintOne($wu[-$i-1]); } @wu = sort {$a->{votes} <=> $b->{votes}} @wudata; print "\nTop $ext Fewest Votes : \n"; for (my $i=0; $i<$ext; ++$i) { PrintOne($wu[$i]); } print "\nTop $ext Most Votes : \n"; for (my $i=0; $i<$ext; ++$i) { PrintOne($wu[-$i-1]); } @wu = sort {$a->{cooled} <=> $b->{cooled}} @wudata; print "\nTop $ext Most Cools : \n"; for (my $i=0; $i<$ext; ++$i) { PrintOne($wu[-$i-1]); } print "\n"; @wu = sort {$a->{downvotes} <=> $b->{downvotes}} @wudata; print "\nTop $ext Most Downvotes : \n"; for (my $i=0; $i<$ext; ++$i) { PrintOne($wu[-$i-1]); } print "\n"; } #----- end of main program ------------------------------ #----- subroutines -------------------------------------- sub uniq { # takes a list argument # assumes the list is sorted (use sort() if not) # returns that list with duplicates removed # examples: @foo=uniq(@sorted); @foo=uniq(sort(@random)); my (@list, @result); @list = @_; @result = (); foreach (@list) { if ((!@result) || ($result[-1] != $_)) {push(@result,$_);} } return(@result); } sub getnode { # takes one argument: $node_id # assumes that $ua is a valid HTTP::UserAgent object # returns the contents of the page in a scalar variable # example: $page = getnode($node_id); my $req = HTTP::Request->new('GET', "$baseurl?node_id=$_[0]"); return($ua->request($req)->content()); } sub login { # takes two arguments: $username, $password # assumes that $ua is a valid HTTP::UserAgent object # returns node_id of homenode on success, 0 on failure # example: $homenode = login($username, $password); my $homenode = 0; my $req = HTTP::Request->new('POST', "$baseurl?node_id=109"); $req->content_type('application/x-www-form-urlencoded'); $req->content("op=login&node_id=109&user=$_[0]&passwd=$_[1]"); my $response = $ua->request($req); if ($response->content() =~ m|Log Out.*\n.*node_id=(\d+)|i) { $homenode = $1; } else { open(FILE, ">$badLogin"); print FILE $response->content(); close(FILE); } if ($response->content() =~ m|you have <A [^>]+>(\d+)</a> messages|i) { $info{messages} = $1; } else { $info{messages} = 0; } return($homenode); } sub readdatafile { # takes one argument: $filename # gets stored user info from $filename. # returns a list of two hash references. # example: ($inforef, $noderef) = getinfo($filename); if (! -f $_[0]) { return(0); } else { my (%info, %node); open(DATA,$_[0]); ($info{xp}, $info{nodes}, $info{cools}, $info{totalrep}, $info{messages}, $info{merit}, $info{devotion}, $info{average}, $info{median}, $info{upvotes}, $info{downvotes}, $info{maxcools},$info{maxvotes}) = split(/:/,<DATA>); $info{xp} = 0 unless defined($info{xp}) && ($info{xp}) =~ m/^\d+$/; $info{cools} = 0 unless defined($info{cools}) && ($info{cools}) =~ m/^\d+$/; $info{totalrep} = 0 unless defined($info{totalrep}) && ($info{totalrep}) =~ m/^\d+$/; $info{nodes} = 0 unless defined($info{nodes}) && ($info{nodes}) =~ m/^\d+$/; $info{messages} = 0 unless defined($info{messages}) && ($info{messages}) =~ m/^\d+$/; $info{merit} = 0 unless defined($info{merit}) && ($info{merit}) =~ m/^[\d.]+$/; $info{devotion} = 0 unless defined($info{devotion}) && ($info{devotion}) =~ m/^[\d.]+$/; $info{average} = 0 unless defined($info{average}) && ($info{average}) =~ m/^[\d.]+$/; $info{median} = 0 unless defined($info{median}) && ($info{median}) =~ m/^[\d.]+$/; $info{upvotes} = 0 unless defined($info{upvotes}) && ($info{upvotes}) =~ m/^\d+$/; $info{downvotes} = 0 unless defined($info{downvotes}) && ($info{downvotes}) =~ m/^\d+$/; $info{maxcools} = 0 unless defined($info{maxcools}) && ($info{maxcools}) =~ m/^\d+$/; $info{maxvotes} = 0 unless defined($info{maxvotes}) && ($info{maxvotes}) =~ m/^\d+$/; chomp($info{xp}, $info{nodes}, $info{cools}, $info{totalrep}, $info{messages}, $info{merit}, $info{devotion}, $info{average}, $info{median}, $info{upvotes}, $info{downvotes}, $info{maxcools},$info{maxvotes}); if ($info{nodes}) { $info{wnf} = (($info{totalrep}+(10*$info{cools}))/$info{nodes})+1; $info{nodefu} = $info{xp}/$info{nodes}; $info{coolratio} = ($info{cools}*100)/$info{nodes}; } while (<DATA>) { chomp; if (/^(\d+):(-?\d+):(\d+):(.+):(\d+):(\d+)$/) { @{$node{$1}} = ($2,$3,$4,$5,$6); } elsif (/^(\d+):(-?\d+):(\d+):(.*)$/) { @{$node{$1}} = ($2,$3,$4,0,0); } else { print STDERR "You Suck!\n"; } if ($.<=2) {$info{maxrep}=$info{minrep}=$2} if ($2 > $info{maxrep}) {$info{maxrep}=$2} if ($2 < $info{minrep}) {$info{minrep}=$2} } close(DATA); return(\%info,\%node); } } sub infodiff { # takes one argument. returns a string that shows the value of that # piece of the %info hash, and the change in the value, if any. # example: infodiff('xp') could return "132", "133 (+1)", etc. my $arg = $_[0]; my $str = $info{$arg}; $oldinfo{$arg} = 0 unless defined($oldinfo{$arg}); if ($oldinfo{$arg} != $info{$arg}) { $str .= " (".($info{$arg}>$oldinfo{$arg}?'+':''); $str .= ($info{$arg}-$oldinfo{$arg}).")"; } return($str); } sub infodiff_fp { # takes one argument. returns a string that shows the value of that # piece of the %info hash, and the change in the value, if any. # example: infodiff('xp') could return "132", "133 (+1)", etc. my $arg = $_[0]; my $perc = $_[1]; my $str = sprintf "%1.2f", $info{$arg}; if (defined($perc)) {$str .= '%';} $oldinfo{$arg} = 0 unless defined($oldinfo{$arg}); my $diff = $info{$arg} - $oldinfo{$arg}; if (($diff > 0.001) || ($diff < -0.001)) { $str .= " ("; $str .= "+" if ($diff > 0); $str .= sprintf "%1.3f%s)", $diff, defined($perc) ? "%" : ""; } return($str); }
This writeup assumes only that you've got a working Windows box, a network connection, and some sort of decompression tool (WinZip, for example) that can handle tar and gz.
my $datafile="$ENV{HOME}/.e2info"; # save data here to my $datafile="C:\e2info.txt"; # save data here
The original line is only really appropriate for a multi-user environment.
Go to http://language.perl.com/ppt/src/make/index.html, download it (it's the download described as being powerful enough to build Tk under DOS), and extract the files from the tar file to a temporary directory (double-click it, click extract). Via the command line (in the directory into which you extracted pmake) type the following:
perl Makefile.PL perl -I. pmake perl -Mblib pmake test perl -Mblib pmake install
Edit the <perl directory>\lib\Config.pm file and change the line:
make='nmake' to make='pmake'
This instructs perl to create pmake-friendly Makefiles -- omitting this step causes headaches and produces cryptic error messages.
perl makefile.pl pmake
C:\bin\>e2info.pl "username" "password" "both"
printable version chaos
