http://www.perlmonks.org?node_id=87380
Category: PerlMonks Related Scripts
Author/Contact Info mr.nick
Description: This is just an example script

I frequently update my pmchat script and have found that updating my node for it is quite a pain in the *ss. To simplify the experience, I wrote the following script that is called from my Makefile (when my script changes) and automatically updates its node under Code Catecombs.

This script WILL NOT work for you without modification. I hestitated to post it here in its form, but decided that it was probably worth the educational experience.

Note: the script draws from the cookie file that is created by my pmchat script for authentication.

#!/usr/bin/perl -w

use strict;
use LWP::UserAgent; 
use HTTP::Request::Common; 
use HTTP::Cookies;
use Data::Dumper; 

my $pm='http://www.perlmonks.org/index.pl'; 
my $cookie="$ENV{HOME}/.pmcookie"; 
my $ua=LWP::UserAgent->new || die "Couldn't init UserAgent: $!\n";

$ua->agent("autonode-update"); 
$ua->cookie_jar(HTTP::Cookies->new());
$ua->cookie_jar->load($cookie);

my $title='pmchat';
my $category='PerlMonks.org Related Scripts';
my $author='mr.nick @ Perlmonks.org (email: mrnick@binary9.net)';
my $node='85317';
my $description;
my $code;

{
  $/=undef;
  open (IN,"<description") || die $!;
  $description=<IN>;
  open (IN,"<pmchat") || die $!; 
  ## the '<'.'/code>' wackiness it to prevent PM from
  ## seeing the / code as a real tag :)
  $code='<code>'.<IN>.'<'.'/code>';
  close IN;
}

my $r=$ua->request( 
                   POST 
                   ($pm,[  
                         displaytype => 'edit',
                         node_id => $node,
                         sourcecode_title => $title,
                         sourcecode_codecategory => $category,
                         sourcecode_codeauthor => $author,
                         sourcecode_codedescription => $description,
                         sourcecode_doctext => $code,
                         sexisgood => 'submit',
                        ])
                  ); 

if ($r->{_rc} != 200) {
  print "Sorry, node update failed: $r->{_rc}/$r->{_msg}\n";
}
else {
  print "$title has been udpated!\n";
}