#!/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;
}