Category: | PerlMonks Related Scripts |
Author/Contact Info | epoptai |
Description: | xNN is a CGI newest nodes client that sorts nodes by date,
author, category, and threads (screenshots).
Displays nodes from n days in the past, or fractions of the
current day. Saves node data to disk, uses cookies to
remember sort mode, and can undo a refresh. Requires
XML::Simple
Note: Threaded mode can get dramatically slower as the number of nodes increases, so be prepared to wait when threading more than a few days worth (1000+). Be sure the #! and 3 config variables are correct first. Also: For some reason xNN is now very very slow checking anything more than 1 day of nodes. Nothing changed in the script which suggests that some change in the XML ticker (or something) is causing it. I'm kind of busy now so the fix will have to wait (unless you figure it out and send me a patch :-) Code updated: 5.23.2002 |
#!perl -w # # xNN is a CGI newest nodes client that sorts nodes by date, author, c +ategory, and threads. # Displays nodes from n days in the past, or fractions of the current +day. # Saves node data to disk, uses cookies to remember sort mode, and can + undo a refresh. # Requires XML::Simple # # Note: Threaded mode can get dramatically slower as the number of nod +es increases, # so be prepared to wait to thread more than a few days worth (1000+). # # usage: # Make sure the first 3 variables and the #! line are correct and load + in a browser. # First run involves your first download of new nodes so be online. # # coded by epoptai - http://perlmonks.org/index.pl?node=epoptai # Updated: 5.23.2002 use strict; use CGI::Carp 'fatalsToBrowser'; use CGI::Cookie; use CGI qw(param header url); use LWP::Simple 'get'; use Data::Dumper; eval("use XML::Simple 'XMLin'"); # required xml parser $@ && install_xml_simple(); # check the values of these 3 variables my$perlmonks = 'www.perlmonks.org'; # your usual perlmonks domain my$temp = './'; # where to write data and undo files my$trgt = ' target="_self"'; # link target window my@days = qw(0.1 0.5 1 2 3 4 5 6 7); # day values for the select menu, + can customize but max = 8 days my$pmurl = "http://$perlmonks/index.pl"; my$nnxml = "$pmurl?node_id=30175"; # new nodes xml ticker my$method = 'post'; # 'get' may cause a re-refresh when using the back + button after refresh my$done = 0; use vars qw( @kids @cache @sorted %nodes %nodetype %nodetypes %whom %roots $total $lastcheck $data $data1 $b1 $b2 $numdays $nd ); my%types = ( 'bookreview' => 'Book Reviews', 'categorized answer' => 'Categorized Answers', 'categorized question' => 'Categorized Questions', 'CUFP' => 'Cool Uses for Perl', 'modulereview' => 'Reviews', 'monkdiscuss' => 'Perlmonks Discussion', 'note' => 'Reply', 'obfuscated' => 'Obfuscated Code', 'perlcraft' => 'Perl Craft', 'perlmeditation' => 'Meditations', 'perlnews' => 'Perl News', 'perltutorial' => 'Tutorials', 'perlquestion' => 'Seekers of Perl Wisdom', 'poem' => 'Poems', 'review' => 'Reviews', 'snippet' => 'Snippets Section', 'sourcecode' => 'Code Catacombs', 'tutorial' => 'Tutorials', 'user' => 'Users', ); my%stypes = ( 'bookreview' => 'Book', 'categorized answer' => 'Answers', 'categorized question' => 'Questions', 'CUFP' => 'Cool Uses', 'monkdiscuss' => 'Discussion', 'obfuscated' => 'Obfuscated', 'perlquestion' => 'Seekers', 'snippet' => 'Snippets', 'sourcecode' => 'Code', ); my$file = $temp.'xnn.dat'; my$undo = $file.'.undo'; my$uri = url(); my$handle = select(); my%i = map {$_ => param($_)} param; my%cookies = CGI::Cookie->fetch(); my$start = (times)[0]; copy($undo,$file) if (($i{'m'} && $i{'m'} eq 'undo') && -e $undo); if( (($i{'m'}) && ($i{'m'} eq 'refresh')) || (!-e $file) ){ if($i{'numdays'} && $i{'pageloadtime'}){ $numdays = $i{'numdays'}; my$sut = ( $i{'pageloadtime'} - (86400*$numdays) ); $nnxml = $nnxml."&sinceunixtime=$sut"; } my$nn = get "$nnxml"; unless($nn=~/\S/){ print header; print qq~<html>Download failed! <a href="$uri">Return</a>~; exit } $nn = fixxml($nn); $data = XMLin($nn, forcearray => 1); copy($file,$undo) if -e $file; open(DAT,"> $file") or die "$!"; $Data::Dumper::Indent = 0; $Data::Dumper::Varname = 'data'; print DAT Dumper($data); if($i{'numdays'}){ print DAT qq~\$nd = $i{'numdays'};~; } close DAT or die "$!"; } else{ if(eval "require '$file'"){ $data = $data1; $numdays = $nd; } } my($c1,$c2,$c3,$c4,$cookie,$mode) = ('') x 6; if( ($i{'n'}) || ($i{'m'}) || ($cookies{'nn_mode'}) ){ # determine mod +e, set cookies, execute subs unless($i{'n'}){ $mode = $cookies{'nn_mode'}->value if $cookies{'nn_mode'}; } if(($i{'n'} && $i{'n'} eq 'categorized') || $mode eq 'ca'){ if($i{'n'} && $i{'n'} eq 'categorized'){ $cookie = CGI::Cookie->new(-name=>'nn_mode',-value=>'ca',- +expires=>'+1y'); } $c1 = ' checked'; initdat(); stance('ca'); types(); # categorized } if(($i{'n'} && $i{'n'} eq 'chronological') || $mode eq 'ch'){ if($i{'n'} && $i{'n'} eq 'chronological'){ $cookie = CGI::Cookie->new(-name=>'nn_mode',-value=>'ch',- +expires=>'+1y'); } $c2 = ' checked'; initdat(); stance('ch'); cron(); # chronological } if(($i{'n'} && $i{'n'} eq 'threaded') || $mode eq 'th'){ if($i{'n'} && $i{'n'} eq 'threaded'){ $cookie = CGI::Cookie->new(-name=>'nn_mode',-value=>'th',- +expires=>'+1y'); } $c3 = ' checked'; initdat('th'); stance('th'); threaded(); # threaded } if(($i{'n'} && $i{'n'} eq 'byauthor') || $mode eq 'au'){ if($i{'n'} && $i{'n'} eq 'byauthor'){ $cookie = CGI::Cookie->new(-name=>'nn_mode',-value=>'au',- +expires=>'+1y'); } $c4 = ' checked'; initdat(); stance('au'); cron('au'); # by author } } else{ $c2 = ' checked'; initdat(); stance('ch'); } my$end = (times)[0]; my$sprnt = sprintf "<font size='-1'><b>That took %.2F CPU seconds.</b> +</font>", $end - $start; my$prnt = qq~<p><table width=100% border=1 cellpadding=2 cellspacing= +0 bgcolor="#aaaaaa"><tr><td>$sprnt</td> <td align=center><a href="#top">top</a></td><td align=right><font size +="-1"><i> <a href="$pmurl?node=xNN">xNN</a> by <a href="$pmurl?node=epoptai">epo +ptai</a></i></font> </td></tr></table></body></html>~; print $prnt; exit; sub initdat { my$threaded = pop; if(defined @{$data->{'INFO'}}){ for my $when(@{$data->{'INFO'}}){ $lastcheck = $when->{'lastchecked'}; if($lastcheck =~ /^(....)(..)(..)(..)(..)(..)$/){ $lastcheck = "$4:$5:$6 on $2/$3" } } } if(defined @{$data->{'AUTHOR'}}){ for my $who(@{$data->{'AUTHOR'}}){ $who->{'content'} = encode($who->{'content'}); # UTF8 to latin +1 $whom{$who->{'node_id'}} = $who->{'content'} } } if(defined @{$data->{'NODE'}}){ for my $new(@{$data->{'NODE'}}){ $new->{'content'} = encode($new->{'content'}); # UTF8 to l +atin1 $new->{'author_user'} = encode($new->{'author_user'}); # UTF8 +to latin1 $nodes{$new->{'node_id'}}->{'content'} = $new->{'content'}; $nodes{$new->{'node_id'}}->{'nodetype'} = $new->{'nodetype'}; $nodes{$new->{'node_id'}}->{'author'} = $new->{'author_user' +}; $nodes{$new->{'node_id'}}->{'created'} = $new->{'createtime'} +; if(exists($new->{'parent_node'})){ $nodes{$new->{'node_id'}}->{'parent'} = $new->{'parent_nod +e'}; } else{ $nodes{$new->{'node_id'}}->{'parent'} = 0; } if($threaded){ $nodes{$new->{'node_id'}}->{'kids'} = [@kids]; # empty for + now } $nodetype{$new->{'node_id'}} = $new->{'nodetype'}; # hash for +summary and categorized view } } for(values %nodetype){$nodetypes{$_}++; $total++} my@done = sort {$a <=> $b} keys %nodes; for my $root1 (@done){ if($threaded){ for my $root2 (@done){ if(($nodes{$root2}->{'parent'}) && ($root1 == $nodes{$root +2}->{'parent'})){ push @{$nodes{$root1}->{'kids'}}, $root2; # populate @ +kids } } if($nodes{$root1}->{'nodetype'} ne 'user'){ $roots{$root1} = $root1; } } if($nodes{$root1}->{'created'}=~/^(....)(..)(..)(..)(..)(..)$/){ $nodes{$root1}->{'created'} = "$4:$5:$6 $2/$3" } } } sub stance { # menu and summary my($bit,$prnt) = pop; unless($done > 0){ @sorted = sort {$types{$a} cmp $types{$b}} keys %nodetypes; if($cookie){ print header(-cookie=>[$cookie]) } else{ print header } $prnt .= qq~<html><head><title>xNN</title> <style><!-- td{ font-family:arial;font-size:80%; } --></style></he +ad><body><a name="top"> </a>~; } $prnt .= qq~<form method="$method"> <table border="1" cellpadding="8" cellspacing="0" width="100%" bgcolor +="#aaaaaa"> <tr><td valign="top"> ~; $prnt .= '<input type="submit" name="m" value="undo">' if -e $undo; $prnt .= qq~</td><td rowspan="3" align="right"> <table border="1" cellpadding="3" cellspacing="0"> <tr><td align="right"> <b>Total new nodes</b> </td><td> $total </td></ +tr>~; for(@sorted){ my$e = ''; if($bit && ($bit eq 'ch' || 'au')){ $e = " bgcolor='#999999'" if $_ eq 'user'; $e = " bgcolor='#ffffff'" if $_ ne 'user' && $_ ne 'note'; } $prnt .= qq~<tr$e><td>~; if($bit && $bit eq 'ca'){ $prnt .= qq~<a href="#$_">$types{$_}</a> ~; } else{ $prnt .= qq~$types{$_} ~ } $prnt .= qq~</td><td> $nodetypes{$_} </td></tr>~; } $prnt .= qq~</table></td></tr> <tr><form method="$method"><td> <INPUT TYPE="hidden" name="pageloadtime" value="$^T"> Show nodes created within the past <SELECT NAME="numdays">~; for(@days){ $prnt .= qq~<OPTION VALUE="$_"~; if($numdays && $numdays eq $_){ $prnt .= ' selected'; } $prnt .= qq~>$_~; } $prnt .= qq~</SELECT> days <input type="submit" name="m" value="refresh"></td></form></tr> <tr><form method="$method"><td> <input type="radio" name="n" value="categorized"$c1> categorized<br> <input type="radio" name="n" value="chronological"$c2> chronological<b +r> <input type="radio" name="n" value="threaded"$c3> threaded<br> <input type="radio" name="n" value="byauthor"$c4> by author<br> <input type="submit" value="sort"> </td></form></tr></table><p>~; print $prnt; $done++ } sub threaded { my$prnt = '<font size="-1">'; @cache = sort {$b <=> $a} keys %nodes; $prnt .= print_nodes(); # thread the nodes $prnt .= qq~<table border="1" cellpadding="3" cellspacing="0" width="1 +00%"> <tr><th colspan="4" align="left">Replies to older nodes</td></tr> <tr><td>parent</td><td>title</td><td>author</td><td>date</td></tr>~; for(@cache){ # replies to old nodes unless( ($nodes{$_}->{'nodetype'} eq 'user') || ($nodes{$_}->{'par +ent'} == 0) ){ unless(exists($roots{$nodes{$_}->{'parent'}})){ $prnt .= qq~<tr><td><a href="$pmurl?node_id=$nodes{$_}->{' +parent'}"$trgt>$nodes{$_}->{'parent'}</a></td> <td><a href="$pmurl?node_id=$_"$trgt>$nodes{$_}->{'content +'}</a></td> <td><a href="$pmurl?node_id=$nodes{$_}->{'author'}"$trgt>$ +whom{$nodes{$_}->{'author'}}</a></td> <td>$nodes{$_}->{'created'}</td></tr>~ } } } $prnt .= qq~</table><table border="1" cellpadding="3" cellspacing="0" +width="100%"> <tr><th colspan="2" align="left">Users</td></tr>~; for(@cache){ # users if($nodes{$_}->{'nodetype'} eq 'user'){ $prnt .= qq~<tr><td><a href="$pmurl?node_id=$_"$trgt>$nodes{$_ +}->{'content'}</a></td> <td>$nodes{$_}->{'created'}</td></tr>~; } } $prnt .= '</table>'; print $prnt } sub print_nodes { # recursive sub for threaded my@kids = @_; my$prnt; for( (@kids) ? (@kids) : (@cache) ){ ($b1,$b2) = ('') x 2; if( (@kids) ? (@kids) : ((!$nodes{$_}->{'parent'}) && ($nodes{$_}- +>{'nodetype'} ne 'user')) ){ unless(@kids){ $b1 = '<font size="3"><b>'; $b2 = '</b></font>'; } $prnt .= '<ul>'; unless(@kids){ $prnt .= qq~<font size="-1">$types{$nodes{$_}->{'nodetype' +}} ($nodes{$_}->{'created'})</font><br>~; } $prnt .= qq~<li>$b1 <a href="$pmurl?node_id=$_"$trgt>$nodes{$_ +}->{'content'}</a> $b2 by <a href="$pmurl?node_id=$nodes{$_}->{'author'}"$trgt>$whom{ +$nodes{$_}->{'author'}}</a><br>~; if(@{$nodes{$_}->{'kids'}}){ # if this node has children $prnt .= print_nodes(@{$nodes{$_}->{'kids'}}); # recurse $prnt .= '</ul>'; } else{ $prnt .= '</ul>'} } } return $prnt } sub cron { # chronological or by author my$bit = pop; # by author if set my$prnt = qq~<table border="1" cellspacing="0" cellpadding="3" width=" +100%"> <tr align="left"><th colspan="5"><h2>~; if($bit){ $prnt .= 'Sort by Author'} else { $prnt .= 'Chronological<br +><font size="-1">top node newest</font>'} $prnt .= qq~</h2></th></tr><tr align="left"> <td><b>Parent</td><td><b>Title</td><td><b>Author</td><td><b>Category</ +td><td><b>Created</td></tr>~; for($bit ? (sort { lc($whom{$nodes{$a}->{'author'}}) cmp lc($whom{$nod +es{$b}->{'author'}}) } keys %nodes) : (sort {$b <=> $a} keys %nodes)) +{ my($e,$f) = ('') x 2; if($nodes{$_}->{'nodetype'} eq 'user'){ $e = " bgcolor='#999999'"; $f = 'user' } else{ $f = '<b>root</b>' } if(($nodes{$_}->{'nodetype'} ne 'note') && ($nodes{$_}->{'nodetype +'} ne 'user')){ $e = " bgcolor='#ffffff'" } $prnt .= qq~<tr$e>~; if($nodes{$_}->{'parent'} == 0){ $prnt .= qq~<td> <font size="-2">$f</font> </td>~ } else{ $prnt .= qq~<td> <a href="$pmurl?node_id=$nodes{$_}->{'parent' +}"$trgt>$nodes{$_}->{'parent'}</a> </td>~ } $prnt .= qq~<td> <a href="$pmurl?node_id=$_"$trgt>$nodes{$_}->{'co +ntent'}</a> </td> <td> <a href="$pmurl?node_id=$nodes{$_}->{'author'}"$trgt>$whom{$n +odes{$_}->{'author'}}</a> </td> <td> ~; if(exists($stypes{$nodes{$_}->{'nodetype'}})){ # use short version + of long nodetypes $prnt .= qq~$stypes{$nodes{$_}->{'nodetype'}}~ } else{ $prnt .= qq~$types{$nodes{$_}->{'nodetype'}}~ } $prnt .= qq~</td><td> $nodes{$_}->{'created'} </td></tr>~; } $prnt .= '</table><p>'; print $prnt } sub types { # by nodetype my@done = sort {$b <=> $a} keys %nodes; my$prnt = qq~<table border="1" cellspacing="0" cellpadding="3" width=" +100%"> <tr align="left"><th colspan="4"><h2><a name="cats">Categorized</a><br +> <font size="-1">top node newest</font></h2></th></tr>~; for my $type (sort { $types{$a} cmp $types{$b} } keys %nodetypes){ unless($type=~/note|user/){ (my$t = $types{$type}) =~ tr/ /+/; $prnt .= qq~<tr><th align="left" colspan="4"><br> <h3><a name="$type" href="$pmurl?node=$t"$trgt>$types{$type}</ +a></td></tr>~ } for(@done){ if(($nodes{$_}->{'nodetype'} eq $type) && ($type!~/note|user/) +){ $prnt .= qq~<tr> <td colspan="2"> <a href="$pmurl?node_id=$_"$trgt>$nodes{$ +_}->{'content'}</a> </td> <td> <a href="$pmurl?node_id=$nodes{$_}->{'author'}"$trgt> +$whom{$nodes{$_}->{'author'}}</a> </td> <td> $nodes{$_}->{'created'} </td></tr>~; } } } for my $type (sort {$a cmp $b} keys %nodetypes){ if($type eq 'note'){ # notes $prnt .= qq~<tr><th align="left" colspan="4"><br> <h3><a name="$type">$types{$type}</a></td></tr> <tr><td align="left"><b>parent</td><td colspan="3"> </td> +</tr>~ } if($type eq 'user'){ # users $prnt .= qq~<tr><th align="left" colspan="4"><br> <h3><a name="$type">$types{$type}</a></td></tr>~ } for(@done){ # replies if(($nodes{$_}->{'nodetype'} eq $type) && ($type eq 'note')){ $prnt .= qq~<tr> <td> <a href="$pmurl?node_id=$nodes{$_}->{'parent'}"$trgt> +$nodes{$_}->{'parent'}</a> </td> <td> <a href="$pmurl?node_id=$_"$trgt>$nodes{$_}->{'conten +t'}</a> </td> <td> <a href="$pmurl?node_id=$nodes{$_}->{'author'}"$trgt> +$whom{$nodes{$_}->{'author'}}</a> </td> <td> $nodes{$_}->{'created'} </td> </tr>~; } } for(@done){ # users if(($nodes{$_}->{'nodetype'} eq $type) && ($type eq 'user')){ $prnt .= qq~<tr> <td colspan="3"> <a href="$pmurl?node_id=$_"$trgt>$nodes{$ +_}->{'content'}</a> </td> <td> $nodes{$_}->{'created'} </td> </tr>~; } } } $prnt .= '</td></tr></table><p>'; print $prnt } sub fixxml { # append headers to xml nodes so they parse correctly my$xml = shift; my$fix = q{<?xml version="1.0" encoding="ISO-8859-1"?> <!DOCTYPE CHATTER SYSTEM "dummy.dtd"[]>}; # mirod to the re +scue! $xml = $fix.$xml; $xml =~ s/[\r\n\t]//g; # jcwren, strip to eliminate problems matching +after parsing return $xml; # to the xml parser } sub encode { # UTF-8 to latin1 regex from XML::TiePYX (thanks to mirod) my($text) = @_; $text =~ s{([\xc0-\xc3])(.)}{ my $hi = ord($1); my $lo = ord($2); chr((($hi & 0x03) <<6) | ($lo & 0x3F)) }ge; return $text; } sub copy { # simple file copy if(-e $_[0]){ open(OLD,"< $_[0]") or die "$!"; } else{ print header; print "$_[0] doesn't exist!"; exit } open(NEW,"> $_[1]") or die "$!"; select(NEW); while(<OLD>){ print NEW $_ } close OLD or die "$!"; close NEW or die "$!"; select($handle); } sub install_xml_simple { # link to dist on cpan print header; print qq~Install <a href='http://search.cpan.org/search?dist=XML-Simple'>XML::Simple</a +>~; exit } |
Back to
Code Catacombs