$bq zlib compression failed...~; exit } $exports = pack ("u", $exports); # uuencode $xusername =~ tr/ /+/; if($xusername=~/^([-\@\w.]+)$/){$xusername=$1} # untaint filename else{ die "Error! Can't use $xusername as part of the filename."} my$ef = $temp."reputer-$xusername.export"; unless($i{'e'} eq 'screen'){ open(DAT,"> $ef") or die "$!"; print DAT $exports; close(DAT) or die "$!"; $size2 = (-s($ef)); } if($i{'e'} eq 'screen'){ $size2 = length($exports); } my$fu = sprintf("%d",(($size2/$size1)*100)); $exports = encode_entities($exports); my$lines = $exports =~ tr/\n/\n/; $lines = ($lines/2); # testarea rows &begin_html(); print '

'; unless($previous < 1){ # previous n print qq~<< Prev $show ~; } my$Next = ($start+$show); # start and show form print qq~			~; unless($Next > $c){ # next n print qq~ Next $show >>~; } print qq~
start	show

Import
Showing files named reputer-username.export in the temp dir ($temp). Importing a file overwrites the current data file ($df), and allows viewing and sorting the imported nodes.

\n \n

Data exported~; unless($i{'e'} eq 'screen'){ print qq~ to $ef~; } print qq~
original $size1 bytes, exported $size2 bytes ($fu%)

$exports<\/textarea></form>~;
}

sub dump_hash
{ # display raw data structure
print header('text/plain');
$Data::Dumper::Varname = "xpdat"; 
print Dumper($xpdata);
$Data::Dumper::Varname = "dat"; 
print Dumper($data);
}

sub begin_html
{ # print document html headers
my($metatag,$content) = @_;
unless(($metatag) && ($metatag eq 'fu')){
	if( ($i{'show'}) || ($i{'ft'}) || ($i{'sr'}) ){
		my($sc,$ft,$sr);
		if($i{'show'}){
			$sc = CGI::Cookie->new(-name=>'show',-value=>"$i{'show'}",-expires=>'+10y');
			}
		if( ($i{'ft'}) && ($i{'ft'} eq 'yes') ){
			$fix_title = 'yes';
			$ft = CGI::Cookie->new(-name=>'ft',-value=>'yes',-expires=>'+10y');
			}
		else{$ft = CGI::Cookie->new(-name=>'ft',-value=>'no',-expires=>'now'); $fix_title = 'no'}
		
		if( ($i{'sr'}) && ($i{'sr'} eq 'yes') ){
			$strip_re = 'yes';
			$sr = CGI::Cookie->new(-name=>'sr',-value=>'yes',-expires=>'+10y');
			}
		else{$sr = CGI::Cookie->new(-name=>'sr',-value=>'no',-expires=>'now'); $strip_re = 'no'}
		
		print header(-cookie=>[$sc,$ft,$sr]);		
		}
	else{ print header }
	}
if($metatag eq 'fu'){ undef($metatag)}
print qq~<html><head><title>reputer</title> $metatag 
<style></style></head>
$bodytag $content~;
$begin_html = 1;
}

sub the_bridge
{ # print the summary/menu
print qq~<table border="0" cellpadding="2" cellspacing="0" bgcolor="#d0d0d0" width="100%">
<tr><td valign="top">~;
&summary(@_);
print '</td><td valign="middle" align="right">';
&print_form();
print '</td></tr></table>';
&program_list(); # list external programs
}

sub gif
{ # a gif for the graph
local $| = 0;
print "Content-type: image/gif\n\n", pack "H*", 
"47494638396101000100800000ffffff". 
"00000021f90401000000002c00000000". 
"010001000002024401003b";
}

sub print_form
{ # sort form
my$bit = shift;
my($ftc,$src) = '';
print qq~<FORM method="$form_method">
<SELECT NAME="n" size="1">
<OPTION $cd VALUE="cd">$modescs{'cd'}
<OPTION $ca VALUE="ca">$modescs{'ca'}
<OPTION $rd VALUE="rd">$modescs{'rd'}
<OPTION $ra VALUE="ra">$modescs{'ra'}
<OPTION $ta VALUE="ta">$modescs{'ta'}
<OPTION $td VALUE="td">$modescs{'td'}</SELECT>~;
if($show eq ''){$show = 0}
if($start eq ''){$start = 1}
print qq~<input type="hidden" name="show" value="$show">
<input type="hidden" name="start" value="$start">
<INPUT TYPE="submit" VALUE="Sort"><br>~;
if($fix_title eq 'yes'){$ftc = ' checked'}
if($strip_re eq 'yes'){$src = ' checked'}
print qq~<b>strip:</b> <input type="checkbox" name="ft" value="yes"$ftc> 
username <input type="checkbox" name="sr" value="yes"$src> re</FORM>~;
&print_nav($bit);
}

sub print_nav
{ # navigation buttons
my$bit = shift;
print "<FORM method='$form_method'>";
print '<INPUT TYPE="submit" name="n" VALUE=" ? "> ';
unless($public_access eq 'yes'){
	print '<INPUT TYPE="submit" name="n" VALUE="config"> '
	} 
print '<INPUT TYPE="submit" name="n" VALUE="changes"> '.
'<INPUT TYPE="submit" name="n" VALUE="graph"></FORM>';
unless($bit){ if($nodat!=1){ print qq~<b>Today:</b> $today<br>$md~}}
}

sub listitle
{
print qq~<p>
<table border="$bb" cellpadding="2" cellspacing="1" bgcolor="#d0d0d0" width="100%">
<tr><th colspan="3" align="left"><h2>Nodes sorted by $modesc</h2></th>
<td align="right" valign="top"><form method="$form_method">
<input type="hidden" name="n" value="make data">
<input type="hidden" name="mode" value="$mode">
<input type="hidden" name="re" value="1">~;
unless($public_access eq 'yes'){
	print '<input type="submit" value="Refresh">'
	}
print ' </form></td></tr>';
}

sub help
{
&begin_html(undef,'<div align="right">');
&print_form('z');
my$self = -s $0;
if($show eq ''){$show = 0}
if($start eq ''){$start = 1}
print qq~</div> $bq <h1>reputer $info{'version'}</h1> 
Because of it's size ($self bytes) reputer has two nodes on <a href="$pmurl">Perlmonks</a>.
<ul><li><a href="$pmurl?node=reputer">The source code is here</a> in the code catacombs.
<li>Please make replies to <a href="$pmurl?node=reputer+reply">this crosslinked reply node</a>.</ul>
<p><FORM method="$form_method">
<h2>Sort</h2>
<SELECT NAME="n" size="1">
<OPTION $cd VALUE="cd">$modescs{'cd'}
<OPTION $ca VALUE="ca">$modescs{'ca'}
<OPTION $rd VALUE="rd">$modescs{'rd'}
<OPTION $ra VALUE="ra">$modescs{'ra'}
<OPTION $ta VALUE="ta">$modescs{'ta'}
<OPTION $td VALUE="td">$modescs{'td'}</SELECT> 
<input type="hidden" name="show" value="$show">
<input type="hidden" name="start" value="$start">
<INPUT TYPE="submit" VALUE="Sort"><br>~;
my($ftc,$src) = '';
if($fix_title eq 'yes'){$ftc = ' checked'}
if($strip_re eq 'yes'){$src = ' checked'}
print qq~<font size="-1"><b>strip:</b> <input type="checkbox" name="ft" value="yes"$ftc> 
username <input type="checkbox" name="sr" value="yes"$src> re</font><p>
<b>The default screen. Sort nodes by date, reputation or title.</b>
<ul>
<li>Option to strip <i>($username)</i> and <i>Re:</i> from node titles.~;
if($public_access ne 'yes'){
	print qq~<li>Refresh button updates the node list with fresh data from perlmonks.~}
print qq~</ul></FORM><FORM method="$form_method">
<h2>Graph</h2>
<INPUT TYPE="submit" name="n" VALUE="graph"><p>
<b>Graph number of nodes by reputation.</b>
<ul>
<li>Avg reputation is highlighted only if there is at least one node at that rep. 
</ul>
<h2>Changes</h2>
<INPUT TYPE="submit" name="n" VALUE="changes"><p>~;
if($public_access ne 'yes'){		
	print qq~<b>Detect new, changed and deleted nodes.</b><br>
	<ul>
	<li>Display detailed statistics. Undo and backup.
	<li>Selecting 'detect change' twice wipes out 'restore previous'.
	</ul>~;
	}
if($public_access eq 'yes'){		
	print qq~Display new, changed and deleted nodes with<br>
	detailed statistics.~;
	}
print qq~<br></FORM>~;

unless($public_access eq 'yes'){
	print qq~<FORM method="$form_method"><h2>Config</h2>
	<INPUT TYPE="submit" name="n" VALUE="config"><p>
	<b>Manage cookies and files, check for updates.</b></FORM>~;
	}
print qq~<p align="right">coded by <a href="$pmurl?node=epoptai">epoptai</a>~;
}

sub config
{ # configuration menu
my%exists;
my@files = (
	"$df","$repnow","$repthen","$repnow.bak","$repthen.bak",
	"$repnow.safe", "$repthen.safe","reputer-$xusername.export");
for(@files){ if(-e $_){$exists{$_}=1} else {$exists{$_}=0}}
$info{'date'}=~s/(....)(..)(..)/$1-$2-$3/o;
print qq~<table width="100%" border="0" bgcolor="#ffffff" cellpadding="4" cellspacing="0">
<tr><th align="left"><h1>Configure</h1></th></tr></table> $bq~;
&login_form('config');
print qq~<hr><form method="$form_method"><h1>Files</h1>
<i>reputer creates up to 8 data files</i>
<h3>A file used for the sortable node list:</h3>
<b>reputer.dat</b>~;

if($exists{$df}==1){&filedata($df)} else{ print " - doesn't exist<br>"}
print qq~<li>
<input type="hidden" name="n" value="make data"> 
<input type="submit" value="refresh">
- refresh node, reputation and xp data file</FORM>~;
if($exists{$df}==1){ 
	print qq~<form method="$form_method">
	<input type="hidden" name="n" value="dumphash"> 
	<li><input type="submit" value="dump"> - dump the raw data structure to screen</form>~}
if($trade!=1){ 
	print qq~Install <a href='http://search.cpan.org/search?dist=Compress-Zlib'>
	Compress::Zlib</a> to enable import and export functions.~}
if($trade==1){
	my$size;
	$xusername =~ tr/ /+/;
	if(-e $files[7]){$size = (-s $files[7])}
	else{$size = ((-s $files[0])/3)}	
	$size = sprintf("%d", $size);
	if($exists{$df}==1){
		print qq~<form method="$form_method">
		<b>Export/import a compressed data file containing node, reputation and xp data.</b><p>
		<li><INPUT TYPE="submit" name="n" VALUE="export"> - 
		export $df as <i>$files[7]</i> ($size bytes).<br>
		<INPUT TYPE="checkbox" name="e" VALUE="screen"> <font size="-1">don't save, display only</font><p>
		<li><INPUT TYPE="submit" name="n" VALUE="import"> - 
		select a file to import, overwrites $df</FORM>~;
		}
	}
print qq~<hr>
<FORM method="$form_method"><input type="hidden" name="erase" value="current">
<h3>A pair of lists for <i>'changes':</i></h3>
<b>reputer.now</b>~;

if($exists{$repnow}==1){&filedata($repnow)} else{ print " - doesn't exist<br>"}
print '<b>reputer.then</b>';

if($exists{$repthen}==1){&filedata($repthen)} else{ print " - doesn't exist<br>"}
if(($exists{$repnow}==1) && ($exists{$repthen}==1)){ 
	print '<INPUT TYPE="submit" VALUE="delete">'
	}
print qq~</FORM><hr><FORM method="$form_method">
<input type="hidden" name="erase" value="backup">
<h3>A pair of lists for <i>'previous view':</i></h3>
<b>reputer.now.bak</b>~;

if($exists{"$repnow.bak"}==1){&filedata("$repnow.bak")} else{ print " - doesn't exist<br>"}
print '<b>reputer.then.bak</b>';

if($exists{"$repthen.bak"}==1){&filedata("$repthen.bak")} else{ print " - doesn't exist<br>"}
if(($exists{"$repnow.bak"}==1) && ($exists{"$repthen.bak"}==1)){ 
	print '<INPUT TYPE="submit" name="n" VALUE="delete">'
	}
print '</form>';

if(($exists{"$repnow.bak"}==1) && ($exists{"$repthen.bak"}==1)){ 
	print qq~<FORM method="$form_method"><INPUT TYPE="submit" name="n" VALUE="restore previous"> - 
	replace the <i>changes</i> pair with these files.<hr></FORM>~} 
else{ print '<hr>'}

print qq~<FORM method="$form_method"><input type="hidden" name="erase" value="safe">
<h3>A pair of lists for <i>'safe backup':</i></h3><b>reputer.now.safe</b>~;

if($exists{"$repnow.safe"}==1){&filedata("$repnow.safe")} else{ print " - doesn't exist<br>"}
print '<b>reputer.then.safe</b>';

if($exists{"$repthen.safe"}==1){&filedata("$repthen.safe")} else{ print " - doesn't exist<br>"}
if(($exists{"$repnow.safe"}==1) && ($exists{"$repthen.safe"}==1)){ 
	print '<INPUT TYPE="submit" name="n" VALUE="delete">'
	}
print '</form>';

if(($exists{"$repnow.safe"}==1) && ($exists{"$repthen.safe"}==1)){ 
	print qq~<FORM method="$form_method"><INPUT TYPE="submit" name="n" VALUE="safe restore"> - 
	replace the <i>changes</i> pair with these files.<hr></FORM>~} 
else{ print '<hr>'}
print qq~<form method="$form_method"><h1>Updates</h1>
This is version $info{'version'} ($info{'date'}). 
Check for an <input type="submit" name="n" value="update"></form>~;
print $eh;
}

sub check_update
{ # looks for  on code node
# and compares it with version data from the %info hash
my$check_rev;
my$check = get 'http://www.perlmonks.org/index.pl?node_id=69581';
if($check !~ /\S/){
	&begin_html(); 
	print qq~$bq Download failed, <a href="$uri?n=update">try again?</a>~; 
	&print_nav('z');
	exit
	}
unless($check =~ /<!--INFO:/){
	&begin_html(); 
	print qq~$bq Version information not detected, try again later or go 
	to the <a href="$pmurl?node=reputer">reputer homenode</a>.~; 
	&print_nav('z');
	exit
	}
my@check = split /\n/, $check;

@check = grep //, @check;
$check = $check[0];
$check =~ s///o;
@check = split /,/, $check;
my$cnt = (@check+1);

for(@check){
	my($k,$v) = split /=/, $_;
	if($k eq 'version'){$check_rev = $v}
	}
&begin_html();
print qq~<table border="1" cellpadding="6" cellspacing="1">
<tr bgcolor="#ffffff"><th colspan="$cnt"><h1>~;
if($check_rev > $info{'version'}){ print qq~Update Available~}
if($check_rev == $info{'version'}){	print qq~This is the current version~}
if($check_rev < $info{'version'}){ print qq~This version newer than update!~}
print '</h1></td></tr><tr bgcolor="#cccccc"><th> </th>';

for(@check){
	my($k,$v) = split /=/, $_;
	print qq~<th>$k</th>~
	}
if($check_rev < $info{'version'}){
	print qq~</tr><tr><th align="right"><a href="$pmurl?node=reputer">Downgrade</a> </th>~
	}
else{ 
	print qq~</tr><tr><th align="right"><a href="$pmurl?node=reputer">Update</a> </th>~
	}
for(@check){ # update
	my($k,$v) = split /=/, $_;
	if($k=~/date/){$v=~s/(....)(..)(..)/$1-$2-$3/o}
	print qq~<td align="center">$v</td>~
	}
print '</tr><tr><th align="right">This </th>';

for(@check){ # this
	my($k,$v) = split /=/, $_;
	if($k=~/date/){$info{$k}=~s/(....)(..)(..)/$1-$2-$3/o}
	print qq~<td align="center">$info{$k}</td>~
	}
print '</tr></table>';
&print_nav('z');
}

sub nowthen
{ # calculate changed nodes
if(($then_is != 1) or ($now_is != 1)){
	&getsave($repthen,'thenxp','then','thent');
	&getsave($repnow,'nowxp','now','nowt');
	print qq~<p>$bq Files created, try again later by selecting 'detect change'.<p>
	Select <a href="$uri?n=changes">changes</a> again to see a summary.~;
	exit
	}
my(%repgain,%reploss,%repthen,%repnow,%thenall,%nowall);
my(%now_content,%now_created,%now_rep,%then_content,%then_created,%then_rep);
my$many = 0; # changed nodes

# extract xp info
my($now_xp2nxt,$now_level,$now_xp);
	for my $xpnow(@{$nowxp->{'XP'}}){ # now
		$now_xp2nxt = $xpnow->{'xp2nextlevel'};
		$now_level = $xpnow->{'level'};
		$now_xp = $xpnow->{'xp'};
		}
my($then_xp2nxt,$then_level,$then_xp);
	for my $xpthen(@{$thenxp->{'XP'}}){ # then
		$then_xp2nxt = $xpthen->{'xp2nextlevel'};
		$then_level = $xpthen->{'level'};
		$then_xp = $xpthen->{'xp'};
		}

my($now_arts,$now_trep,$then_arts,$then_trep) = 0;

for my $then (@{$then->{'NODE'}}){
	$then_trep += $then->{'reputation'}; # total rep then
	$then_arts++;
	}
# unravel the data into a bunch of hashes keyed on node_id
for my $now (@{$now->{'NODE'}}){ # now
	$now_content{$now->{'id'}} = $now->{'content'};
	$now_created{$now->{'id'}} = $now->{'createtime'};
	$now_rep{$now->{'id'}} = $now->{'reputation'};
	$now_trep += $now->{'reputation'}; # total rep now
	$now_arts++;
	for my $then (@{$then->{'NODE'}}){ # then
		$then_content{$then->{'id'}} = $then->{'content'};
		$then_created{$then->{'id'}} = $then->{'createtime'};
		$then_rep{$then->{'id'}} = $then->{'reputation'};
		if($now->{'id'} == $then->{'id'}){
			if($now->{'reputation'} > $then->{'reputation'}){ # gain
				$repgain{$now->{'id'}} = ($now->{'reputation'} - $then->{'reputation'});
				$repthen{$now->{'id'}} = $then->{'reputation'};
				$repnow{$now->{'id'}}  = $now->{'reputation'};
				$many++;
				}
			if($now->{'reputation'} < $then->{'reputation'}){ # loss
				$reploss{$now->{'id'}} = ($then->{'reputation'} - $now->{'reputation'});
				$repthen{$now->{'id'}} = $then->{'reputation'};
				$repnow{$now->{'id'}}  = $now->{'reputation'};
				$many++;
				}
			}
		$thenall{$then->{'id'}} = $then->{'reputation'};
		}
	$nowall{$now->{'id'}} = $now->{'reputation'};
	}

my(@newnodes,@delnodes,@thenreps,@nowreps) = ();
for(sort {$b <=> $a} keys %nowall){ # new nodes
	push (@nowreps, $nowall{$_});
	push (@newnodes, $_) unless exists $thenall{$_};
	}
for(sort {$b <=> $a} keys %thenall){ # deleted nodes
	push (@thenreps, $thenall{$_});
	push (@delnodes, $_) unless exists $nowall{$_};
	}
# calculate the results of the rep/xp comparison till next print
@nowreps = sort {$b <=> $a} @nowreps;
@thenreps = sort {$b <=> $a} @thenreps;
$now_arts = (scalar(@nowreps)-1); # subtract homenode from total
$then_arts = (scalar(@thenreps)-1);

my$change_arts = ($now_arts-$then_arts);
my$change_reps = ($now_trep-$then_trep);
my$change_xp   = ($now_xp-$then_xp);
my$nn = 0;

if(($many == 0) && ($change_arts != 0)){$many = $change_arts; $nn = 1}

my$thenavg  = sprintf ("%3.2f", $then_trep / $then_arts);
my$nowavg  = sprintf ("%3.2f", $now_trep / $now_arts);
my$change_avg = sprintf ("%3.2f", ($nowavg-$thenavg));
my$change_max = ($nowreps[0]-$thenreps[0]);
my$change_min = ($nowreps[-1]-$thenreps[-1]);

if($change_arts > 0){$change_arts = '+'.$change_arts}
if($change_reps > 0){$change_reps = '+'.$change_reps}
if($change_xp > 0){$change_xp = '+'.$change_xp}
if($change_avg > 0){$change_avg = '+'.$change_avg}
if($change_max > 0){$change_max = '+'.$change_max}
if($change_min > 0){$change_min = '+'.$change_min}

my$sz = 1; # size of select menu
my($e1,$e2,$e3);
if( (-e $repthen) && (-e $repnow) ){ $sz++; $e1=1 } # if file exists increase select menu size & list item
if( (-e "$repthen.bak") && (-e "$repnow.bak") ){ $sz++; $e2=1 }
if( (-e "$repthen.safe") && (-e "$repnow.safe") ){ $sz++; $e3=1 }

print qq~<table border="0" cellpadding="2" cellspacing="0" bgcolor="#b0b0b0" width="100%">
<tr><form method="$form_method"><td valign="middle">~;
unless($public_access eq 'yes'){
	print qq~<select name="n" size="$sz">
	<option value="detect change"> detect change~;
	if($e2 == 1){ print '<option value="restore previous"> restore previous'}
	if($e1 == 1){ print '<option value="safe backup"> safe backup'}
	if($e3 == 1){ print '<option value="safe restore"> safe restore'}
	print '</select><input type="submit" value="Go">';
	}
print qq~ </td></form><th><h1>changes</h1></th><td align="right"><b>
Then:</b> $thentime<br><b>Now:</b> $nowtime<br></td></tr></table><p>
<table border="$bb" cellpadding="2" cellspacing="1" bgcolor="#b0b0b0" width="100%">
<tr align="right" bgcolor="#ffffff"><td> </td><td>then</td><td>now</td><td>change</td></tr>~;

&change_sum($change_arts,'Total nodes',$then_arts,$now_arts,$change_arts);
&change_sum($change_reps,'Total reputation',$then_trep,$now_trep,$change_reps);
&change_sum($change_xp,'Total experience',$then_xp,$now_xp,$change_xp);
&change_sum($change_max,'Max reputation',$thenreps[0],$nowreps[0],$change_max);
&change_sum($change_avg,'Avg reputation',$thenavg,$nowavg,$change_avg);
&change_sum($change_min,'Min reputation',$thenreps[-1],$nowreps[-1],$change_min);

print qq~</table><p>
<table border="$bb" cellpadding="2" cellspacing="1" bgcolor="#b0b0b0" width="100%">~;

my(@trc,$trc); # total rep from changed nodes
if(($many == 0) && ($nn == 0)){ # no changed nodes
my($rp,$sr) = '';
	if((-e "$repthen.bak") && (-e "$repnow.bak")){
		$rp = '<input type="submit" name="n" value="restore previous">';
		}
	if((-e "$repthen.safe") && (-e "$repnow.safe")){
		$sr = '<input type="submit" name="n" value="safe restore">';
		}
	print qq~<p>$bq No changed nodes. Try again later. 
	<p><form method="$form_method">
	$rp $sr </form>~;
	exit
	}
if(($many > 0) && ($nn == 0)){ # changed nodes
	print qq~<tr><td colspan="6"><b>Changed</b></td></tr>
	<tr><td>node</td><td>title</td><td>created</td><td>then</td><td>now</td><td>change</td></tr>~;
	}
for my $foo (sort {$b <=> $a} keys %nowall){ # sort by node id
	for my $gain (sort {$b <=> $a} keys %repgain){ # gain
		if($gain == $foo){
			print qq~<tr bgcolor="#ffffff" align="center"><td>$gain </td>
			<td align="left"> <a href="$pmurl?node_id=$gain">$now_content{$gain}</a> </td>
			<td> <small>$now_created{$gain}</small> </td>
			<td> $repthen{$gain} </td>
			<td> $repnow{$gain} </td>
			<td> +$repgain{$gain}</td></tr>~;
			push @trc, $repgain{$gain}
			}
		}
	for my $loss (sort {$b <=> $a} keys %reploss){ # loss
		if($loss == $foo){
			print qq~<tr bgcolor="#ffbbbb" align="center"><td>$loss </td>
			<td align="left"> <a href="$pmurl?node_id=$loss">$now_content{$loss}</a> </td>
			<td> <small>$now_created{$loss}</small> </td>
			<td> $repthen{$loss} </td>
			<td> $repnow{$loss} </td>
			<td> -$reploss{$loss}</td></tr>~;
			push @trc, '-'.$reploss{$loss}
			}
		}
	}

if(@newnodes){ # new nodes
	print qq~<tr><td colspan="6"><b>New</b></td></tr>
	<tr><td>node</td><td>title</td><td>created</td>
	<td>then</td><td>now</td><td>change</td></tr>~;
	for my $foo (sort {$b <=> $a} keys %nowall){
		for(@newnodes){
			my$color = '#ffffff';
			my$pref = '+';
			if($_ == $foo){
				if($now_rep{$_} == 0){ $pref = ''}
				if($now_rep{$_} > 0){ $pref = '+'}
				if($now_rep{$_} < 0){ $color = '#ffbbbb'; $pref = ''}
				print qq~<tr bgcolor="$color" align="center"><td>$_ </td>
				<td align="left"> <a href="$pmurl?node_id=$_">$now_content{$_}</a> </td>
				<td> <small>$now_created{$_}</small> </td>
				<td> 0 </td>
				<td> $now_rep{$_} </td>
				<td> $pref$now_rep{$_}</td></tr>~;
				push @trc, $now_rep{$_}
				}
			}
		}
	}
if(@delnodes){ # deleted nodes
	print qq~<tr><td colspan="6"><b>Deleted</b></td></tr>
	<tr><td>node</td><td>title</td><td>created</td>
	<td>then</td><td>now</td><td>change</td></tr>~;
	for my $foo (sort {$b <=> $a} keys %thenall){
		for(@delnodes){
			my$color = '#ffffff';
			if($_ == $foo){
				print qq~<tr bgcolor="$color" align="center"><td>$_ </td>
				<td align="left"> <a href="$pmurl?node_id=$_">$then_content{$_}</a> </td>
				<td> <small>$then_created{$_}</small> </td>
				<td> $then_rep{$_} </td>
				<td>   </td>
				<td>  </td></tr>~;
				}
			}
		}
	}
for(@trc){$trc += $_} # total rep from changed nodes
$trc[0] = '#bbbbbb';
if($trc > 0){$trc = '+'.$trc}
if($trc < 0){$trc[0] = '#ffbbbb'}
print qq~<tr align="center" valign="bottom" bgcolor="$trc[0]">
<td colspan="5" align="right"><p><br>Total experience from node changes</td>
<td>$trc</td></tr></table> $eh~;
} # end sub nowthen

sub summary
{ # totals and averages section of the main menu
my$total_rep = shift; # had to shift to get them all
my$xp = shift;
my$rephi = shift;
my$replo = shift;
my$usersince = shift;

my@level = qw(anonymous initiate novice acolyte scribe monk friar abbot bishop pontiff saint);
my@lastnode = sort {$b cmp $a} values %node_cre;

print qq~<table border="0" width="100%" cellpadding="0" cellspacing="0">
<tr bgcolor="#ffffff"><td><b>User:</b> $xusername (<a href="$pmurl?node_id=$homenode">$homenode</a>)<br>
<b>Level:</b> $level - $level[$level] <br></td>
<td align='right'><b>User since:</b> $usersince <br>
<b>Last here:</b> $lastnode[0] <br></td></tr>
<tr><td colspan="2" height="5"><font size="-7"> </font></td></tr>
<tr bgcolor="#f0f0f0"><td>
<table border="0" width="100%" cellpadding="2" cellspacing="0">
<tr align="right"><td>~;

my$avg  = sprintf ("%3.2f", ($total_rep/$total_nodes)); 
$avgrep = sprintf ("%d", $avg);  
$replo  = sprintf ("%d", $replo);

print qq~Total nodes: $total_nodes </td></tr><tr align=right><td>
Total reputation: $total_rep </td></tr><tr align=right><td>
Total experience: $xp </td></tr></table></td>
<td><table border="0" width="100%" cellpadding="2" cellspacing="0"><tr align="right"><td>
Max reputation: $rephi </td></tr><tr align=right><td>
($avg) Avg reputation: $avgrep </td></tr><tr align=right><td>
Min reputation: $replo </td></tr></table></td></tr></table>~;
}

sub change_sum
{ # display the xp/rep change summary
my($v1,$v2,$v3,$v4,$v5) = @_;
my$color = '';
if($v1 < 0){$color = ' bgcolor="#ffbbbb"'}
if($v1 > 0){$color = ' bgcolor="#d0d0d0"'}
print qq~<tr align="right"><td bgcolor="#ffffff">
$v2</td><td bgcolor="#d0d0d0">
$v3</td><td bgcolor="#d0d0d0">
$v4</td><td$color>
$v5</td></tr>~;
}

sub graph
{ # calculate and display the graphs
my($hm1,$hm2,$hm3,$bdr);
if($i{'histmode'}=~/02/){ $bdr = 1 } else { $bdr = 0 }
print qq~<p><table border="$bdr" cellpadding="0" cellspacing="0" width="100%">
<tr><th align="left" colspan="3" valign="top">
<table border="0" cellpadding="0" cellspacing="0" width="100%" bgcolor="#cfcfcf">
<tr><th align="left">  
<h2>Number of nodes by reputation
<font size="-1"><br>average rep and maximum num highlighted</font></h2></th>
<td><table align="right" border="0" cellpadding="3" cellspacing="0"><tr><td>~;

if( ($i{'histmode'}=~/01/) or (!$i{'histmode'}) ){ 
	$hm1 = ' checked';
	print qq~<b>mode one</b><br><small>
	bar height = fixed<br>
	bar width = number of nodes at that rep<br></small></td></tr>~
	}
if($i{'histmode'}=~/02/){ 
	$hm2 = ' checked';
	print qq~<b>mode two</b><br><small>
	bar height = rep<br>
	bar width = number of nodes at that rep<br></small></td></tr>~
	}
if($i{'histmode'}=~/03/){
	$hm3 = ' checked';
	print qq~<b>mode three</b><br><small>
	bar height = number of nodes at that rep<br>
	bar width = rep<br></small></td></tr>~
	}

print qq~<tr><form method="$form_method"><td align="right" valign="bottom">
1<input type="radio" name="histmode" value="01"$hm1> 
2<input type="radio" name="histmode" value="02"$hm2> 
3<input type="radio" name="histmode" value="03"$hm3> 
<input type="hidden" name="n" value="graph">
<input type="submit" value="mode"></td></form></tr></table>
</td></tr></table></td></tr>~;

my@high = sort {$b <=> $a} values %rep_freq;
my@hig  = sort {$b <=> $a} keys %rep_freq;
my$mult = sprintf "%d", (600/$high[0]); # normalize bar width to scale (highest num = 600 pixels)
my$mul  = sprintf "%d", (600/$hig[0]); # normalize bar width to scale (highest num = 600 pixels)
print qq~<tr bgcolor="#b0b0b0"><td><b>$nb rep $nb</td><td><b>$nb num $nb</td><td> </td></tr>~;

my($ar,$fc,$arf,$fcf) = '';

for(sort {$b <=> $a} keys %rep_freq){ 
	my$w = ($rep_freq{$_}*$mult);
	my$h = 5;
	if($i{'histmode'}){
		if($i{'histmode'}=~/01/){}
		if($i{'histmode'}=~/02/){ $h = ($_); if($h == 0){$h = 1} }
		if($i{'histmode'}=~/03/){ $w = ($_*$mul); $h = $rep_freq{$_} }
		}
	if($_ == $avgrep){ # highlight avg rep
		$ar = 'bgcolor="#880066"'; 
		$fc = '<font color="white">'
		} 
	else{$ar=''; $fc='';}
	
	if($rep_freq{$_} == $high[0]){ # highlight frequency high
		$arf = 'bgcolor="#880066"'; 
		$fcf = '<font color="white">'
		}
	else{$arf=''; $fcf=''}

print qq~<tr><td $ar align="right">$fc $_ $nb</td><td $arf align="right">$fcf $rep_freq{$_} $nb</td><td>~;
	print qq~<table border="0" cellpadding="0" cellspacing="0">
	<tr><td bgcolor="#880066"><img src="$uri?n=gif" width="$w" height="$h" border="0"></td></tr></table>
	</td></tr>~
	}
print qq~<tr bgcolor="#b0b0b0">
<td><b>$nb rep $nb</td><td><b>$nb num $nb</td><td> </td></tr></table><p>~;
}

Cookie$s set

Login

Import