Category: PerlMonks Related Scripts
Author/Contact Info crazyinsomniac at /tell in da chatterbox
Description: If you've ever been to scratch pad viewer and you've wanted to download some code from somebody's scratchpad, you've noticed there is no "d/l code link". It turns out, if you use my script, you don't need it.
 %>perl monkname

update: Tue Apr 2 10:37:58 2002 GMT ~ changed off trigger due to Petruchio

update: Fri May 24 11:19:30 2002 GMT ~ " as added, so gots to take it out (and also added a \n remove, jeez, i'm gonna make this obsolete soon ~ and & ~ i hope the goods see pmdev wiki soon)

update: Fri Jan 17 05:31:13 2003 GMT -- more changes, more fixes.

#!/usr/bin/perl -w

=head1 AUTHOR



 %>perl monkname 


=head2 START


=head2 END

   <!-- nodelets start here -->


use strict;
use LWP::Simple qw(get);
use HTML::TokeParser;

my $PADD = ";user=";

my $user = shift or die "usage: ". __FILE__ ." user";

my $file = get($PADD.$user) or die "Cannot get the page $PADD$user\n";

my $P = HTML::TokeParser->new(\$file);

my $TRIGGER=0; # oooh
my $CRAP = "";

while (my $T = $P->get_token() )
{                     #   0     1     2       3        4
    if($$T[0] eq "S") # ["S", $tag, $attr, $attrseq, $text]
        if(not $TRIGGER and $TRIGGER !=-1 and $$T[1] eq 'hr')
            print STDERR "TRIGGER ON\n";
            $CRAP .= $$T[4] if $TRIGGER;
    elsif($$T[0] =~ /^(?:E|PI)$/ ) # end tag | process instruction
        $CRAP .= $$T[2] if $TRIGGER;
    elsif($$T[0] =~ /^(?:T|C|D)$/ ) # text | comment | declaration
        if($$T[0] eq 'C'
           and $TRIGGER
           and $TRIGGER != -1
#           and $$T[1] eq '<!-- nodelets start here -->')
           and $$T[1] =~ m{\Q<!-- Begin nodelets -->\E})
            print STDERR "TRIGGER OFF\n";

        $CRAP .= $$T[1] if $TRIGGER;
} # endof while (my $T = $P->get_token)


Because I did wanted to match only the nodelets start here comment and
+ not
these tags before the comment, I just strip the html off usign substr
(last 55 characters).

  <td width="20%" valign=top align=right>

# L to the V to the A to the L
substr($CRAP,-55) = '';

# and now to massage crap (reverse the effects of code tags
$CRAP =~ s{\n<FONT color="red">\+<\/FONT>}{}g;
# multiline code
$CRAP =~ s{<pre><TT><FONT size="-1">}{\<CODE\>}g;
$CRAP =~ s{</FONT></TT></pre>}{\<\/CODE\>}g;
# single line code
$CRAP =~ s{<TT><FONT size="-1">}{\<CODE\>}g;
$CRAP =~ s{</FONT></TT>}{\<\/CODE\>}g;
$CRAP =~ s{\&lt\;}{<}g;
$CRAP =~ s{\&gt\;}{>}g;
$CRAP =~ s{\&#91\;}{\[}g;
$CRAP =~ s{\&#93\;}{\]}g;
$CRAP =~ s{\&quot;}{"}g;
$CRAP =~ s{\&amp;}{\&}g;

print $CRAP if(@ARGV);

#print "$1\n\n\n" while($CRAP =~ m{\<code\>(.*?)<\/code\>}igs)

print "$1\n\n\n" while($CRAP =~ m{\Q<pre><tt class="code"><font size="
Replies are listed 'Best First'.
(shockme) Re: download code from scratchpad
by shockme (Chaplain) on Dec 28, 2001 at 23:44 UTC
    Excellent job, crazyinsomniac. ++. This will really cut down on my cut-and-paste woes.

    This probably goes without saying, but the script writes to STDOUT, so to save the scratchpad to a file, you need something like:

    perl monkname > monkname.scratchpad

    Very cool. Thanks!

    If things get any worse, I'll have to ask you to stop helping me.