http://www.perlmonks.org?node_id=81207
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">&nbsp;</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">&nbsp;</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
}