Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses

Scratchpad poster, new edition

by saskaqueer (Friar)
on Jun 03, 2004 at 15:45 UTC ( #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 = '';

    '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>";

    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'

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


=head1 NAME - retrieves and/or updates user's scratchpad

=head1 SYNOPSIS -file [-user -pass -append -prepend -code]

   -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


B<This program> will read the given input file and post it to your scr
Simply specify - for the filename to read from STDIN. Your user name i
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
Also required is the file to be uploaded to your scratch pad, unless y
specify the read option, which will print your current scratch pad to 
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
retrieve the current contents of your scratch pad and one to post the 
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 
on any single script execution will result in your scratchpad being ma
private. The exception is if you pass the read option -- no changes wi
+ll be
made to the scratchpad.


=over 4

=item backup scratchpad to an HTML file:

./ -user jeffa -read > pad.html

=item post simple HTML file:

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

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

./ -u jeffa -pub -c -append

=item prepend 'on the fly' STDIN content

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

=item append errors from perl script

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



Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://360216]
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (4)
As of 2017-10-22 12:26 GMT
Find Nodes?
    Voting Booth?
    My fridge is mostly full of:

    Results (273 votes). Check out past polls.