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:
- XP, Nodes, Cools
- Highest, Lowest, Median, Mean, and Total reputation
- Amount of change in any of the above stats
- Node-fu, WNF, Cool/Nodes ratio
- New, Nuked, and Title-edited nodes
- Changes in rep, newly Cooled nodes
- Node type breakdown (percent person/place/thing/idea)
Stuff it doesn't do, but should, and probably will soon:
- List top/bottom 5 nodes (by reputation)
- Let you check saved stats without contacting E2 ("duh, what was my node-fu again?")
- Have a nice GUI with nate's head popping up at random intervals and giving you status updates
It requires the following perl modules, which you can get very easily from CPAN:
and, optionally,
- Compress::Zlib
(for compressing the datafiles. A Good Idea.)
- Crypt::Blowfish
(for encrypting the datafiles. Not really necessary, and buggy. Skip it for now.)
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);
}