#!/usr/bin/perl -wT

##########################################################################
##########################################################################
##
## bivnn.cgi - an enhanced view of PerlMonks Newest Nodes
## Author:  Blake Mills (blakem on perlmonks)
## Version: 0.01
## Date:    09/30/2001
## 
##
## released for redistribution and/or modification under the same terms as 
## Perl itself
##
## Requires the Perlmonks.pm modules which can be found at
##   http://www.cerias.purdue.edu/homes/zamboni/perlmonks.html
##   http://perlmonks.org/index.pl?node_id=31092
##
##########################################################################
##########################################################################

BEGIN {
  # This dir needs to be writable by your webserver.
  # You cookie and cache of node information will be stored here
  #
  $ENV{HOME} = $ENV{PERLMONKS_RCDIR} = '/tmp';
}

use strict;
use lib '/custom/dir/for/perllibs';
use CGI;
use POSIX;
use PerlMonks::NewestNodes;
# uncomment for development 
# use CGI::Carp qw(fatalsToBrowser);


############# User Configurable Settings #############
###                                                ###

# You'll need to set four things before this will run:
#   1.) set the dir in the BEGIN{} block above
#   2.) change the '!#perl' line and 'usr lib' line to match your setup 
#   3.) $USER
#   4.) $PASSWD
# The remaining settings are non-critical display preferences

# perlmonks users name
my $USER                = 'blakem';

# perlmonks password
my $PASSWD              = 'mypassword';

# show nodes whose parents are already shown?
my $SHOWCHILDREN        = 1;

# temporarily set to 1 and reload a few times if you are having cookie problems
my $RESETCOOKIE         = 1;

# show nodes counts for each category
my $SHOWCATEGORYCOUNTS  = 1;

# show counts of children for each node
my $SHOWCHILDCOUNTS     = 1;

# show oldest nodes first (reverse of the order on the real 'Newest Nodes' page
my $OLDESTFIRST         = 0;

# method to submit forms as (I like to develop with 'GET' but 'POST' in prod)
my $FORMMETHOD          = 'POST';

# settings for 'Set Flag to $N Hours Ago' select box
my $DEFAULTHOURLYOFFSET = 3;
my $MAXHOURLYOFFSET     = 48;

# URL for perlmonks
my $PMURL               = 'http://www.perlmonks.org';
my $PMURLINDEX   =      "$PMURL/index.pl";

# "I've checked all of these" button really means
# "Set my nn flag to the time I loaded the page - $FUDGETIMEDELTA seconds"
# Its a (probably unnecessary) window to make sure no nodes slip through.
my $FUDGETIMEDELTA      = 10;

# ugh... The data sent for 'Showing nodes created since X' is I believe
# set to vrooms localtime... To convert it into your localtime I 
# add $VROOMGMT hours to get GMT, then localtime() to display it for you
# tinker with this var if the data shown is out of whack for you
my $VROOMGMT            = -5;

# url this script is located... only use if $q->url isn't working
my $SELFURL             = undef;

# These are category specific settings... The keys are the category names
# as used in the XML feed.  The data in the array is:
# [ $displayorder, $haschildren, $categoryname ]
#
# The categories are ordered based on $displayorder.  A negative
# value will prevent that catetory from displaying at all.
#
# $haschildren works with $SHOWCHILDCOUNTS to selectively show child counts
# for each node
#
# $category name is simply the header text shown for that category

my %category = (
      'perlmeditation'         => [ 0, 1, 'New Meditations'],
      'monkdiscuss'            => [ 1, 1, 'New Discussion'],
      'perltutorial'           => [ 2, 1, 'New Tutorials'],
      'perlquestion'           => [ 3, 1, 'New Questions'],
      'categorized question'   => [ 4, 1, 'New Categorized Questions'],
      'categorized answer'     => [ 5, 1, 'New Categorized Answers'],
      'snippet'                => [ 6, 1, 'New Snippets'],
      'sourcecode'             => [ 7, 1, 'New Code'],
      'perlcraft'              => [ 8, 1, 'New Craft'],
      'CUFP'                   => [ 9, 1, 'New Cool Uses for Perl'],
      'obfuscated'             => [10, 1, 'New Obfuscation'],
      'review'                 => [11, 1, 'New Reviews'],
      'bookreview'             => [12, 1, 'New Book Reviews'],
      'modulereview'           => [13, 1, 'New Module Reviews'],
      'poem'                   => [14, 1, 'New Poetry'],
      'perlnews'               => [15, 0, 'New Perl News'],
      'note'                   => [16, 1, 'New Notes'],
      'tutorial'               => [17, 1, 'New Misc. Tutorials'],
      'user'                   => [-1, 0, 'New Users'],
      );
###                                                ###
########### End User Configurable Settings ###########

# order the categories in the manner described above
my @categoryorder =  grep {$category{$_}[0]>=0}
                          (sort {$category{$a}[0] <=> $category{$b}[0]} 
                                (keys %category));

# create a CGI object and a PerlMonks::NewestNodes object
my $q = CGI->new;
my $n = PerlMonks::NewestNodes->new;

# what URL are we installed as
my $selfurl = $SELFURL || $q->url;

# login to perlmonks
login();

# deal with the lastchecked buttons if needed
process_lastchecked();

# generate %{$nodesbytype} which is our main data structure
# see generate_nodesbytype() for details
my $nodesbytype = generate_nodesbytype(); 

# print out the page
print $q->header();
print $q->start_html(-title=>'bivnn.cgi -- PerlMonks Newest Nodes',
		     -BGCOLOR=>'white');
print html_body();
print $q->end_html;

########### SUBS ###########

sub login {
  # if you already have a cookie set, use it to log in otherwise
  # attempt a username/password login.
  my $resetcookie = $RESETCOOKIE || shift;
  if ($resetcookie || !-f $n->COOKIE_FILE) {
    $n->add_pm_cookies();
    $n->{cookie_jar}->clear;
    $n->login($USER,$PASSWD);
  } else {
    $n->add_pm_cookies();
  }
  return 1;
}

sub process_lastchecked {
  # Slightly modified routines taken from PerlMonks::NewestNodes
  # Removed the part dealing with local "threads"
  if ($q->param('pageloadtime')) {
    my $pageloadtime = $q->param('pageloadtime') - $FUDGETIMEDELTA;
    if ($q->param('clearNNflag')) {
      my $resp=$n->post_form($n->NN_CLEAR_URL,
			     node_id        => "3628",
			     pageloadtime   => "$pageloadtime",
			     displaytype    => "display",
			     viewedNewNodes => "I've checked all of these"
                           );
      if ($resp->is_success) {
	return 1;
      } else {
	$@=$resp->status_line;
	return;
      }
    } elsif ($q->param('resetNNflag')) {
      my $resp=$n->post_form($n->NN_CLEAR_URL,
			     node_id           => "3628",
			     pageloadtime      => "$pageloadtime",
			     displaytype       => "display",
			     clearNewNodesFlag => "Clear my last checked flag"
			    );
      if ($resp->is_success) {
	return 1;
      } else {
	$@=$resp->status_line;
	return;
      }
    } elsif ($q->param('setNNflag')) {
      $pageloadtime = time() - $q->param('hourlyoffset')*60*60;
      my $resp=$n->post_form($n->NN_CLEAR_URL,
			     node_id        => "3628",
			     pageloadtime   => "$pageloadtime",
			     displaytype    => "display",
			     viewedNewNodes => "I've checked all of these"
                           );
      if ($resp->is_success) {
	return 1;
      } else {
	$@=$resp->status_line;
	return;
      }
    }
  }
  return 1;
}

sub generate_nodesbytype {
  # $nodesbytype is our main data structure... 
  # it is a ref to a HoA keyed by category, containing info on new nodes.
  # well, really by "$category" and "$category-child"
  #
  # example usage:
  #
  # $category    = 'monkdiscuss';
  # $node        = $nodesbytype->{$category}->[0];
  # $nodeid      = $node->{node_id};
  # $title       = $node->{content};
  # $authid      = $node->{author_user};
  # $authname    = $node->{authname};
  # $children    = $node->{children};
  # $createtime  = $node->{createtime};
  # $parentid    = $node->{parent_node};
  # $nodetype    = $node->{nodetype};

  
  my $nodesbytype;

  # get info on new nodes
  my @newnodes = $n->get_and_cache_nodes($n->NN_XML_URL, 1);
  my $nodeinfo = $n->query_nodes(@newnodes);
  my %nodeids = map {$_ => 1} @newnodes;

  # calculate a childcount for each node
  my %childcount;
  if ($SHOWCHILDCOUNTS) {
    $childcount{$_->{parent_node}}++ for (grep {$_->{parent_node}}
		 			       (values %$nodeinfo));
  }

  # lookup info on the authors of the nodes
  my %seenuserid;
  my @userids = grep {!$seenuserid{$_}++}
                     map {$nodeinfo->{$_}{author_user}}
                         @newnodes;
  my $userinfo = $n->query_nodes(@userids);

  # generate our category keyed hash while adding child-count and author's
  # name to each $node
  for my $node (values %$nodeinfo) {
    my $key = $node->{nodetype};
    $key .= '-child' if $node->{parent_node} && $nodeids{$node->{parent_node}};
    $node->{authname} = $userinfo->{$node->{author_user}}->{content};
    $node->{children} = $childcount{$node->{node_id}} || 0;
    push (@{$nodesbytype->{$key}},$node);
  }
  return $nodesbytype;
}

sub html_body {
  # generate our the body of our html
  # calls generate_category_html twice, once to process the parentless
  # nodes (the ones we primarily care about) and once for nodes that
  # already have a parent showing
  my $html;
  my $nodesdisplayed = 0;
  $html .= generate_category_html($_,0,$nodesdisplayed) for (@categoryorder);
  if ($SHOWCHILDREN) {
    $html .= $q->hr;
    $html .= generate_category_html($_,1,$nodesdisplayed) for (@categoryorder);
  }
  $html .= generate_checkedflag_buttons($nodesdisplayed);
  return $html;
}

sub generate_category_html {
  # create the html for an individual category or "category-child" 
  # if second param is true

  my ($category,$alreadysawparent) = @_;

  # determine which $key in $nodesbytype we are interested in
  my $key = $category;
  $key .= '-child' if $alreadysawparent;

  # don't display anything if we have no new nodes in this category
  return '' unless $nodesbytype->{$key};

  # get a count of the number of nodes in this section
  my $nodecount = @{$nodesbytype->{$key}};

  # update the passed-by-reference third param to reflect total nodecount 
  $_[2] += $nodecount;                            # slightly evil.... ;-)

  # text displayed for this section
  my $categoryname = $category{$category}[2] || $category;
  $categoryname .= ' -- children' if $alreadysawparent;
  $categoryname .= " ($nodecount)" if $SHOWCATEGORYCOUNTS;
  
  # order the nodes based on creation time
  my @sortednodes = sort {$b->{createtime} <=> $a->{createtime}}
                         @{$nodesbytype->{$key}};
  @sortednodes = reverse @sortednodes if $OLDESTFIRST;

  # is this category configured to show child counts
  my $childcountsincat = $category{$category}[1];

  # make the HTML
  my $html;
  $html .= $q->h3($categoryname);
  $html .= "<TABLE>\n";
  for my $node (@sortednodes) {
    my $nodeid      = $node->{node_id};
    my $title       = $node->{content};
    my $authid      = $node->{author_user};
    my $authname    = $node->{authname};
    my $children    = $node->{children};

    $html .= qq{ <TR NOWRAP><TD NOWRAP>};
    $html .= qq{<A HREF="$PMURLINDEX?node_id=$nodeid">$title</A>};
    $html .= qq{ <FONT SIZE=-1><I>($children)</I></FONT>}
      if $SHOWCHILDCOUNTS && $childcountsincat;
    $html .= qq{</TD><TD NOWRAP>};
    $html .= qq{by <A HREF="$PMURLINDEX?node_id=$authid">$authname</A>};
    $html .= qq{</TD></TR>\n};
  }
  $html .= "</TABLE>\n<P>\n";
  return $html;
}
  
sub generate_checkedflag_buttons {
  # create the HTML for the lastchecked buttons
  my $nodesdisplayed = shift;

  # get timestamp for 'pageloadvar' i.e. all nodes shown are "older" than this
  # when "I've Checked all of these" is clicked, this will be the new
  # cutoff for nodes shown
  my $time = time();


  # parse the pageload time to determine what the cutoff point is for
  # the current batch of nodes.  Unfortunately this is not given 
  # as a simple timestamp, so we must jump through a few hoops...
  # it starst off looking like '20010930101046' ...
  my $lastchecked = $n->{cache_nn}{INFO}{lastchecked};

  # we then parse out the fields, decrement the month 
  # and subtract 1900 from the year
  my @datefields = 
    reverse ($lastchecked =~ m|^(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})(\d{2})|);
  $datefields[4]--;
  $datefields[5]-=1900;

  # we then convert to a unixtimestamp while offsetting by
  # $VROOMGMT hours.  This seems to work for me, but you
  # might have to fiddle around with it
  my $lastcheckedts = POSIX::mktime(@datefields) + $VROOMGMT*60*60;
  my $datestring = localtime($lastcheckedts);

  # create a pretty string telling us how long ago our flag was set
  my ($dago,$hago,$mago) = (gmtime($time - $lastcheckedts))[7,2,1];
  my $hoursago;
  $hoursago .= "$dago " . ($dago == 1 ? 'day ' : 'days ') if $dago;
  $hoursago .= "$hago " . ($hago == 1 ? 'hour ' : 'hours ') if $hago;
  $hoursago .= "$mago " . ($mago == 1 ? 'minute ' : 'minutes ') if $mago;
  $hoursago .= " ago";


  # check for plural: '1 node' vs '2 nodes'
  my $ndtext = $nodesdisplayed . ($nodesdisplayed==1 ? ' node' : ' nodes'); 

  # make the HTML
  my $html;
  $html .= qq{Showing <B>$ndtext</B> created since $datestring ($hoursago)<BR>\n};
  $html .= qq{<FORM METHOD="$FORMMETHOD"  ACTION="$selfurl">\n};
  $html .= qq{ <INPUT TYPE="hidden" name="pageloadtime" value="$time">\n};
  $html .= qq{ <INPUT TYPE="submit" NAME="resetNNflag" VALUE="Clear my last checked flag">\n};
  $html .= qq{ <INPUT TYPE="submit" NAME="clearNNflag" VALUE="I've checked all of these"><P>\n};
  $html .= qq{ <INPUT TYPE="submit" NAME="setNNflag" VALUE="Set Flag to \$N Hours Ago">\n};
  $html .= qq{ <SELECT NAME="hourlyoffset">\n};
  for (1..$MAXHOURLYOFFSET) {
     my $selected = $_ == ($q->param('hourlyoffset') || 
                           $DEFAULTHOURLYOFFSET) ? ' SELECTED' : ''; 
     $html .= qq{  <OPTION VALUE="$_"$selected>$_</OPTION>\n};
  }
  $html .= qq{ </SELECT>\n};
  $html .= qq{</FORM>\n};
  $html .= qq{<HR>by <A HREF="$PMURLINDEX?node_id=83485">blakem</A>\n};
  
  return $html;
}