Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine

Scratchpad Poster

by jeffa (Bishop)
on Jul 04, 2002 at 05:33 UTC ( [id://179393]=sourcecode: print w/replies, xml ) Need Help??
Category: PerlMonks Related Scripts
Author/Contact Info /msg jeffa
Description: This script will upload a file and replace your scratch pad with the contents of that file. Options are included to append and prepend instead of clobbering, and to download your existing scratch pad for backup purposes. See POD for more details.

Update: Ack! Looks like ar0n beat me to this almost a whole year ago: hup - home node updater. Thanks for pointing this out ybiC, and don't blame me - blame ar0n! :D

#!/usr/bin/perl -w

use strict;

use Term::ReadKey;
use Getopt::Long;
use Pod::Usage;

use LWP;
use HTTP::Request::Common;
use HTML::TokeParser;

use constant URL => '';
use vars qw(
   %ESC $ua $cont $user $pass $file 
   $read $append $prepend $code $help

%ESC = (
   '&'  => '&',
   '&lt;'   => '<',
   '&gt;'   => '>',
   '&quot;' => '"',

   'user|u=s'    => \$user,
   'pass|p=s'    => \$pass,
   'file|f=s'    => \$file,
   'code|c'      => \$code,
   'read|r'      => \$read,
   'append|app'  => \$append,
   'prepend|pre' => \$prepend,
   'help|h|?'    => \$help,

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

$user ||= ''; # insert default user name here
pod2usage(-verbose=>2) unless $user;

$pass ||= ''; # insert default password here
$pass ||= &read_pass();
pod2usage(-verbose=>2) unless $pass;

unless ($read) {
   open FH, $file or die "can't open $file: $!";
   $cont = do {local $/; <FH>};
   close FH;

$cont = "<code>\n$cont<\/code>\n" if $code;

$ua = LWP::UserAgent->new;
$ua->agent("scratchpad_poster/1.0 (@{[$ua->agent]})");

if ($read or $append or $prepend) {
   my $pad = &parse_pad(&post());
   print $pad and exit if $read;

   $cont = $pad . $cont if $append;
   $cont = $cont . $pad if $prepend;

   user_scratchpad   => $cont,
   sexisgood         => 'stumbit',
   setscratchpublic  => 'on',

sub post {
   my %attr = @_;
   my $request = POST(URL,
      Content => [
         op          => 'login',
         user        => $user,
         passwd      => $pass,
         displaytype => 'edit',
         node        => $user,
   my $response = $ua->request($request);
   my $content  = $response->content;

   die "error posting page" if $response->is_error;
   die "Invalid user or password" if $content =~ /Permission Denied/;

   return $content;

sub parse_pad {
   my $raw = shift;
   my $pad; 
   my $parser = HTML::TokeParser->new(\$raw);
   while (my $tag = $parser->get_tag('textarea')) {
      if ($tag->[1]->{name} eq 'user_scratchpad') {
         $pad = $parser->get_text;
   $pad =~ s/(&\w+;)/$ESC{$1}/ge;
   return $pad;

sub read_pass {
   my $pass;
   print "Enter password: ";
   ReadMode 'noecho';
   chomp($pass = ReadLine 0);
   ReadMode 'normal';
   print "\n";
   return $pass;


=head1 NAME - updates user's scratch pad

=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 instead
   -append  -app      appends file to scratch pad
   -prepend -pre      prepends file to scratch pad
   -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 scratch pad. Simply specify - for the file
name to read from STDIN. Your user name is required,
as well as the password. These values can be hard-coded
into the code in the appropriate places if you know
that no one else will see this script. If the password
argument is not supplied, then you will be prompted
with an non-echoed prompt for security.  Also required
is the file to be uploaded to your scratch pad, unless
you 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 posted; and
the prepend option, which will prepend the file to be
posted. If either the append or prepend option are
true, two requests will be posted - one to retrieve
the current contens of your scratch pad and one to
post the new contents.  Make sure you spell append
and prepend correctly, or else you will wipe out
your scratchpad with the new content.  


0 - backup your scratch pad to an HTML file:

./ -user jeffa -read > pad.html

1 - post simple html file:

./ -user jeffa -file=foo.html

2 - append a perl script:

./ -u jeffa -c -append

3 - prepend 'on the fly' STDIN content

./ -u jeffa -f=- -prepend
    [type away - hit CNTRL-D when finished]

4 - append errors from perl script, notice that you
    have to give password as arg (or alternatively
    hard code it):

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

Replies are listed 'Best First'.
Re: Scratch Pad Poster
by danger (Priest) on Jul 05, 2002 at 14:47 UTC

    Those unfortunate enough to get the "Multiple nodes named XXX were drunk" when entering their user name in the search box, will want to use their homenode id for the 'node' attribute (in the post() routine) instead of $user.

Re: Scratch Pad Poster
by jdavidboyd (Friar) on Jul 05, 2002 at 14:12 UTC
    Great idea, and great functionality.
    Worked great for me, and saves a great amount of time.

    I should be able to learn a great amount from this script, thanks for the effort!


Log In?

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

How do I use this?Last hourOther CB clients
Other Users?
Others musing on the Monastery: (4)
As of 2024-07-23 14:24 GMT
Find Nodes?
    Voting Booth?

    No recent polls found

    erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.