#!/usr/bin/perl -w

=head1 AUTHOR

 crazyinsomniac

=head1 SYNOPSIS

 %>perl scratchcode.pl monkname 

=head1 TRIGGERS

=head2 START

 <hr>

=head2 END

   <!-- nodelets start here -->

=cut

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

my $PADD = "http://perlmonks.org/index.pl?node_id=108949;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')
        {
            $TRIGGER=1;
            print STDERR "TRIGGER ON\n";
        }
        else
        {
            $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})
        {
            $TRIGGER=-1;
            print STDERR "TRIGGER OFF\n";
        }

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

=head2 STRIP HTML

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>
  <td width="20%" valign=top align=right>
   
=cut

# 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="-1">\E(.*?)\Q</font></tt></pre>\E}igs)
__END__