Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation
 
PerlMonks  

Scratchpad poster, new edition

by saskaqueer (Friar)
on Jun 03, 2004 at 15:45 UTC ( [id://360216]=sourcecode: print w/replies, xml ) Need Help??
Category: PerlMonks Related Scripts
Author/Contact Info /msg saskaqueer
Description: An update to the wonderful script posted by jeffa. This script brings the older one up to date with the new scratchpad system. I also fixed the "login error" detection to hopefully make it less error prone. I added a 'public' option to enable a simple switch to make any content posted to the scratchpad public or private.
#!/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

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://360216]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others studying the Monastery: (3)
As of 2025-06-17 01:52 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?
    erzuuliAnonymous Monks are no longer allowed to use Super Search, due to an excessive use of this resource by robots.