Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

xNN

by epoptai (Curate)
on May 17, 2001 at 16:03 UTC ( [id://81207]=sourcecode: print w/replies, xml ) Need Help??
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
}
Replies are listed 'Best First'.
Re: xNN
by damian1301 (Curate) on Jul 06, 2001 at 05:04 UTC
    Just a minor nitpick.

    Instead of my%i = map {$_ => param($_)} param; you could use the CGI.pm prepared function Vars

    my %i = Vars;

    Of course this would require some changing of your call to CGI.pm:

    use CGI qw/param Vars header url/;

    Credit of this reply goes to all those folks at node_id #94303 

    $_.=($=+(6<<1));print(chr(my$a=$_));$^H=$_+$_;$_=$^H;
print chr($_-39); # Easy but its ok.

    [download]
[reply]
[d/l]
[select]
Re: xNN
by rchiav (Deacon) on Aug 10, 2001 at 18:17 UTC
    just as an FYI, this will not run under mod_perl (at least for me). Getting "will not stay shared" errors and seg fault. But I don't think you designed this with mod_perl in mind anyway :). If you're interested, I'll post the error log, but I didn't want to clutter this up unless you wanted it.

    Rich

[reply]

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: sourcecode [id://81207]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others avoiding work at the Monastery: (5)
As of 2025-01-23 11:16 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Which URL do you most often use to access this site?












    Results (63 votes). Check out past polls.