#!/usr/bin/perl -w
use strict;
use Term::ReadPassword;
use HTTP::Request::Common 'POST';
use HTTP::Cookies;
use LWP::UserAgent;
use HTML::TokeParser;
use Getopt::Long;
use constant TINYNODE => 16046;
use constant PM => 'http://www.perlmonks.org/index.pl';
$| = 1;
{
my ($ua, $req);
my ($homenode, $username, $password, $file);
my ($realname, $email, $image, $location);
my ($verbose, $significant);
my ($setpublic, $scratchfile, $scratchpad);
GetOptions(
"username=s" => \$username,
"password=s" => \$password,
"name=s" => \$realname,
"email=s" => \$email,
"image=s" => \$image,
"location=s" => \$location,
"homenode=s" => \$file,
"contentofpad=s"=> \$scratchfile,
"makepublic" => \$setpublic,
"significant" => \$significant,
"verbose" => \$verbose
);
unless ( defined $username ) {
$username = "";
until ( $username =~ /\S/ ) {
print "Username: ";
chomp($username = <STDIN>);
}
}
unless ( defined $password ) {
$password = "";
until ( $password =~ /\S/ ) {
$password = read_password("Password: ")
}
}
die usage()
unless $username && $password;;
die "Can't find $file\n"
if defined $file and not -f $file;
$homenode = join "", do { local @ARGV = $file; <> } if defined $fi
+le;
die "Can't find $scratchfile\n"
if defined $scratchfile and not -f $scratchfile;
$scratchpad = join "", do { local @ARGV = $scratchfile; <> } if de
+fined $scratchfile;
die "Can't find image $image\n"
if defined $image and not -f $image;
$ua = new LWP::UserAgent( agent => "Homenode Updater" );
$ua->cookie_jar( HTTP::Cookies->new() );
print "Logging in... "
if $verbose;
die "Couldn't log in. Is your username/password right?\n"
unless $ua->request(
POST PM, [
node_id => TINYNODE,
op => 'login',
user => $username,
passwd => $password
]
)->as_string() =~ /userpass/;
print "done.\n"
if $verbose;
print "Fetching... "
if $verbose;
my $html = $ua->request(
POST PM, [
displaytype => "edit",
node => $username
]
)->content();
print "done.\n"
if $verbose;
print "Parsing... "
if $verbose;
my %default = parse($html);
print "done.\n"
if $verbose;
print "Updating... "
if $verbose;
my $content = [
displaytype => "edit",
node => $username,
user_realname => $realname || $default{user_realname} |
+| "",
user_passwd1 => $password,
user_passwd2 => $password,
user_email => $email || $default{user_email} || "",
user_doctext => (defined $homenode ? $homenode : $defa
+ult{user_doctext}) || "",
user_scratchpad => (defined $scratchpad ? $scratchpad : $
+default{user_scratchpad}) || "",
setscratchpublic => ($setpublic ? "on" : $default{setscrat
+chpublic}) || "",
setsetting_location => $location || $default{setsetting_locat
+ion} || "",
significantupdate => $significant ? "on" : "",
sexisgood => "stumbit"
];
push @$content, imgsrc_file => [$image]
if defined $image;
$ua->request(
POST PM,
Content_Type => 'form-data',
Content => $content
);
print "done.\n"
if $verbose;
}
sub usage
{
return <<"EOT";
Usage: $0 -u username -p password [ options ]
Options:
-i <file> Home node picture
-h <file> File containing home node contents
-c <file> File containing scratchpad contents
-m Make scratchpad public
-n <string> Your real name
-e <string> Your email address
-l <string> Your location
-s Significant update
-v Be a little verbose
EOT
}
sub parse
{
my $html = shift;
my %default;
my @params = qw( user_realname user_email user_passwd1 user_passwd2
+setsetting_location );
my $p = new HTML::TokeParser ( \$html );
while ( my $token = $p->get_tag("textarea") ) {
$default{user_doctext} = $p->get_text if $token->[1]{name} eq "use
+r_doctext";
$default{user_scratchpad} = $p->get_text if $token->[1]{name} eq "
+user_scratchpad";
}
while ( my $token = $p->get_tag("input") ) {
next unless exists $token->[1]{name};
$default{ $token->[1]{name} } = $token->[1]{value} || "" if grep {
+ $_ eq $token->[1]{name} } @params;
$default{setscratchpublic} = "on" if $token->[1]{name} eq 'setscra
+tchpublic' && $token->[1]{checked};
}
return %default;
}
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.