http://qs321.pair.com?node_id=34318
Category: PerlMonks Related Scripts
Author/Contact Info Chris 'jcwren' Wren jcwren@jcwren.com
Description: Designed to insert SETI@Home statistics into a users homenode, but easily modifiable for other tasks. See comments in code.
#!/usr/local/bin/perl -w

#
#  This script was written for [Ovid] to update his homenode with the
#  latest statistics from SETI@Home.  It is easily adapted to other 
#  tasks where a user wants to automate updating information on their
#  homenode.
#
#  To use, first BACKUP YOUR HOMENODE (mark'n'copy, then save it in a 
#  text file, in case something happens).  Insert a pair of tags where
+ 
#  you want the text to be inserted in your homenode.  The tag pair is
#  <!--StartTag--><!--EndTag-->.  When the script runs, it searchs for
#  this tag pair, and replaces anything between them with the new text
+.
#
#  If the tags don't exist, it will create them at the top of the page
+,
#  and (hopefully) not wreck any existing text.
#
#  To run the script, it's: setiupdate -u username -p password [-s] [-
+v]
#
#  -s tells the script to set the significant update check box.  (Note
#  that for some reason, either the PM HTML, or the HTML::Form module,
#  a warning is generated.  It won't go away.  If you fix it, let me
#  know).  
# 
#  -v says be a little more verbose, and tell me what each stage of th
+e
#  process is.  Not recommended for cron jobs.
#
#  To use this for non-SETI@Home stuff, just cut out the SETI related
#  code, and insert your own.  As world-class Perl programmers who spe
+nd
#  1/2 their life at www.perlmonks.org, this should be trivial.
#
#  As usual, any bugs(!) should be report to me, please.  Any complain
+ts
#  to /dev/null, or /msg merlyn, and he'll re-write this thing in 10
#  lines, point out the security holes, then write it up in the Web
#  Techniques column (just kidding, dude!)
#

use strict;
use Carp;
use LWP::UserAgent;
use LWP::Simple;
use HTTP::Cookies;
use URI::Escape;
use Getopt::Std;
use HTML::Form;

use vars qw($def_username $def_password $def_supdate $def_verbose);
use vars qw($pmsite $setisite);
use vars qw($globalCookieJar $globalUserAgent);

$def_username = '';
$def_password = '';
$def_supdate  = 0;
$def_verbose  = 0;
$pmsite       = 'http://www.perlmonks.org/index.pl';
$setisite     = 'http://setiathome.ssl.berkeley.edu/cgi-bin/cgi?cmd=te
+am_show&id=86606';

#
#
#
{
   my %args = ();

   getopts ('?hu:p:Psv', \%args);

   if ($args{'?'} || $args{h} || !scalar keys %args)
   {
      usage ();
      exit;
   }

   if ($args {P})
   {
      local $| = 1;
      print "Password: ";
      $args {p} = <STDIN>;
      chomp ($args{p});
   }

   my $username = $args {u} || $def_username;
   my $password = $args {p} || $def_password;
   my $supdate  = $args {s} || $def_supdate;
   my $verbose  = $args {v} || $def_verbose;

   $username or die "No username.  Program terminated.\n";
   $password or die "No password.  Program terminated.\n";

   #
   #  Need these globally, so instantiate one of each
   #
   $globalCookieJar = HTTP::Cookies->new;
   $globalUserAgent = LWP::UserAgent->new;

   print "\n", scalar localtime, " - Retrieving SETI statistics...\n" 
+if $verbose;

   my $setistats = do_get_seti_stats () || die "Eeek! Can't get the SE
+TI stats page\n";

   print scalar localtime, " - Logging into www.perlmonks.org...\n" if
+ $verbose;

   login ($username, $password) or die "Eeek! Can't login into perlmon
+ks?  Wrong username or password?\n";

   print scalar localtime, " - Loading update homenode page...\n" if $
+verbose;

   my $uri = common_HTTP_request ("displaytype=edit&node=$username&typ
+e=user");

   print scalar localtime, " - Updating homenode page...\n" if $verbos
+e;

   do_update_homenode ($setistats, $supdate, $uri);

   print scalar localtime, " - Update complete...\n\n" if $verbose;
}

#
#
#
sub do_get_seti_stats
{
   @_ == 0 or croak "Incorrect number of parameters";

   $LWP::Simple::FULL_LWP = 1;

   my $page = get ($setisite);

   return unless ($page);

   $page =~ s/.*?(<table )/$1/s;

   return $page;
}

#
#
#
sub do_update_homenode
{
   @_ == 3 or croak "Incorrect number of parameters";

   my ($newtext, $significantupdate, $uri) = @_;

   my $content = $uri->content;

   my @forms = HTML::Form->parse ($content, $uri->base);

   foreach my $form (@forms)
   {
      if ($form->find_input ('displaytype', 'hidden'))
      {
         my $currentPage = $form->value ('user_doctext');

         if ($currentPage !~ /(<!--StartTag-->)(?:.*?)(<!--EndTag-->)/
+si)
         {
            $currentPage = "<!--StartTag-->\n$newtext\n<!--EndTag-->\n
+$currentPage";
         }
         else
         {
            $currentPage =~ s/(<!--StartTag-->)(?:.*?)(<!--EndTag-->)/
+$1\n$newtext\n$2/si;
         }

         $form->value ('user_doctext', $currentPage);
         $form->value ('significantupdate', 'on') if $significantupdat
+e;

         my $res = $globalUserAgent->request ($form->click);
      
         die sprintf ("Eeek! Request failed (%s)\n", $res->status_line
+) unless ($res->is_success);

         return;
      }
   }

   die "Eeek! Can't find the form (is this the right page?)\n";
}

#
#  Log the user in, and extract his cookies.  
#
sub login
{
   @_ == 2 or croak "Incorrect number of parameters";

   my ($username, $password) = @_;

   my $req = HTTP::Request->new (POST => $pmsite);

   $req->content_type ('application/x-www-form-urlencoded');
   $req->content ("user=$username&passwd=$password&op=login");

   my $res = $globalUserAgent->request ($req);

   die sprintf ("Eeek! Request failed (%s)\n", $res->status_line) if !
+$res->is_success;

   $globalCookieJar->extract_cookies ($res);

   $globalUserAgent->cookie_jar ($globalCookieJar);

   return (($globalCookieJar->as_string () =~ m/userpass/i ? $res : un
+def));
}

#
#
#
sub common_HTTP_request
{
   @_ == 1 or croak "Incorrect number of parameters";

   my $contentdata = shift;

   my $req = HTTP::Request->new (POST => $pmsite);

   $req->content_type ('application/x-www-form-urlencoded');
   $req->content ($contentdata);

   $globalCookieJar->add_cookie_header ($req);

   my $res = $globalUserAgent->request ($req);

   return $res if ($res->is_success);

   die sprintf ("Eeek! Request failed (%s)\n", $res->status_line);
}

#
#
#
sub usage
{
   print <<'ENDOFHELP';

usage: setiupdate.pl [-h | -?] [-u username] [-p password] [-P] [-s] [
+-v]

Update a tagged space in a homenode with SETI@Home statistics

   -?             this help list
   -h             this help list
   -u username    user name on Perlmonks.org
   -p password    password for user
   -P             forces interactive prompt for password.
   -s             sets significant update checkbox
   -v             be verbose about what's going on

   -P overrides -p or script defaults.

   The script can be edited to set defaults for username and password.

ENDOFHELP
}