#!/usr/bin/perl -w
$| = 1;

use strict;
use Pod::Usage;
use Getopt::Long;
use HTML::Parser;
use LWP::UserAgent;

my $default_auth = [ undef, undef ];     # no hardcoding
# my $default_auth = [ 'user', undef ];  # only hardcode user
# my $default_auth = [ 'user', 'pass' ]; # hardcode user and pass

my $domain = 'http://www.perlmonks.org';

GetOptions(
    'user|u=s'    => \my $user,
    'pass|p=s'    => \my $pass,
    'file|f=s'    => \my $file,
    'code|c'      => \my $code,
    'read|r'      => \my $read,
    'append|app'  => \my $append,
    'prepend|pre' => \my $prepend,
    'public|pub'  => \my $public,
    'help|h|?'    => \my $help
);

pod2usage(-verbose => 1) if $help;
pod2usage(-verbose => 2) unless $file or $read;

defined($user) or defined($user = $default_auth->[0])
    or (print "Username: " and chomp($user = <STDIN>));
defined($pass) or defined($pass = $default_auth->[1])
    or (print "Password: " and chomp($pass = <STDIN>));
pod2usage(-verbose => 2) unless $user and $pass;

print post_scratch() and exit(0) if $read;

open(my $fh, $file) or die("open failed: $!\n");
my $file_content = do { local $/; <$fh> };
close($fh) or die("close failed: $!\n");

my $new_pad = $prepend ?
    $file_content . post_scratch() : $append ?
        post_scratch() . $file_content : $file_content;

if ($code) {
    $new_pad =~ s!<\s*/?\s*code\s*>!!g;
    $new_pad = "<code>$new_pad<\/code>";
}

post_scratch(
    scratchpad_doctext => $new_pad,
    sexisgood          => 'stumbit',
    set_public         => $public ? 'on' : ''
);

sub post_scratch {
    my $ua = LWP::UserAgent->new();

    my $res = $ua->post($domain, {
        op          => 'login',
        user        => $user,
        passwd      => $pass,
        node        => "${user}'s scratchpad",
        type        => 'scratchpad',
        displaytype => 'edit',

        @_
    } );

    die("Network error: ", $res->status_line(), "\n")
        unless $res->is_success();
    die("Invalid page grab. Perhaps wrong username/password?\n")
        unless $res->content() =~ m!<textarea!;

    return parse_scratch($res->content());
}

sub parse_scratch {
    my $html = shift;

    my $parser = HTML::Parser->new(
        start_h => [ sub { shift->{_get_it} = 1 }, 'self' ],
        end_h   => [ sub { shift->{_get_it} = 0 }, 'self' ],
        text_h  => [
            sub { $_[0]->{_scratch} = $_[1] if $_[0]->{_get_it} },
            'self, dtext'
        ]
    );
    $parser->report_tags('textarea');
    $parser->unbroken_text();
    $parser->parse($html);

    return defined($parser->{_scratch}) ? $parser->{_scratch} : '';
}

__END__



=head1 NAME

sp_poster.pl - retrieves and/or updates user's scratchpad

=head1 SYNOPSIS

sp_poster.pl -file [-user -pass -append -prepend -code]

 Options:
   -user    -u        user's name
   -pass    -p        user's password
   -file    -f        file to post (- for STDIN)
   -read    -r        returns current contents; no update performed
   -append  -app      appends file to existing scratchpad
   -prepend -pre      prepends file to existing scratchpad
   -public  -pub      makes scratchpad public
   -code    -c        wraps entire file in code tags
   -help    -h -?     brief help message

=head1 DESCRIPTION

B<This program> will read the given input file and post it to your scr
+atchpad.
Simply specify - for the filename to read from STDIN. Your user name i
+s
required, as well as the password. These values can be hard-coded into
+ the code
in the appropriate place if you know that no one else will see this sc
+ript. If
the username and/or password are not provided with switches and the va
+lues are
not hardcoded in the script, you will be prompted on STDIN for these v
+alues.
Also required is the file to be uploaded to your scratch pad, unless y
+ou
specify the read option, which will print your current scratch pad to 
+STDOUT
without uploading any new content. 

Not required is the code option, which will wrap the entire file to be
+ posted
with code tags; the append option, which will append the file to be po
+sted; and
the prepend option, which will prepend the file to be posted. If eithe
+r the
append or prepend option are true, two requests will be posted - one t
+o
retrieve the current contents of your scratch pad and one to post the 
+new
contents.  Make sure you spell append and prepend correctly, or else y
+ou will
wipe out your scratchpad with the new content.

The public option makes your scratchpad publicly viewable by everyone 
+else. If
you wish to make your scratchpad public, you must provide this switch 
+each time
you update your scratchpad with this script. Not providing the public 
+option
on any single script execution will result in your scratchpad being ma
+de
private. The exception is if you pass the read option -- no changes wi
+ll be
made to the scratchpad.

=head1 EXAMPLES

=over 4

=item backup scratchpad to an HTML file:

./sp_poster.pl -user jeffa -read > pad.html

=item post simple HTML file:

./sp_poster.pl -user jeffa -public -file=foo.html

=item append a perl script (assing code tags):

./sp_poster.pl -u jeffa -pub -f=foo.pl -c -append

=item prepend 'on the fly' STDIN content

./sp_poster.pl -u jeffa -pub -f - -pre
    [type away - hit CNTRL-D when finished]

=item append errors from perl script

./foo.pl 2>&1>/dev/null | ./sp.pl -u jeffa -p pass -pub -f - -c -app

=back

=cut
[download]