#Steed's Perl scripts # Strip whitespace from xml for Flash (workaround for Flash being a git) #! /usr/bin/perl -w my $infile = '..\assets\menu.xml'; my $outfile = '..\assets\output.xml'; open(IN, '<'.$infile) or die "can't open $infile: $!"; my @file = ; my $xml = join('', @file); close(IN); $xml =~ s/>[^><]*'.$outfile) or die "can't open $outfile: $!"; print OUT $xml; close(OUT); print $xml; # XML wrapper generator for Flash portfolio (http://www.robotacid.com/cgi-bin/xml_wrap.cgi #!/usr/bin/perl -w # XML Wrapper for Flash, Aaron Steed 2007 # # Takes a request for a html document and formats it for my 3rd Flash portfolio # # General body content is fleeced of what Flash can't read (a lot) and stuffed into # a CDATA tag, thus CDATA content from the original html is ditched # img tags are separated for data to be fed to the portfolio's image carousel # object tags are replaced by a link back to the html # applet tags are replaced by a javascript applet builder use strict; use LWP::Simple '!head'; use CGI ':standard'; use HTML::Parser; # import requested html file my $path = 'http://www.robotacid.com/assets/about.html'; if(param()){ $path = param('url'); } my $html = get ($path) or die ('Could not open $path : $!'); # Globals my $folder = substr($path, 0, rindex($path, '/')).'/'; my @imgs = (); my $xml = ''; my %applet = (); my @paramName = (); my @paramValue = (); # Unacceptable tags regex $notag my @notag = ("p", "div", "table", "tr", "td", "hr", "h1", "center", "acronym", "script"); my $notag = "^"; foreach(@notag){ $notag .= $_.'$|^'; } $notag = substr($notag, 0, length($notag)-2); # node exorcism: CDATA while($html =~ //){ my $start = index($html, "", $start) + 3; my $replacement = ''; substr($html, $start, $end - $start, $replacement); } # node exorcism: Swap object tags with a link to html page while($html =~ /", $start) + 8; my $replacement = 'Object detected, click here to visit original page'; substr($html, $start, $end - $start, $replacement); } # module based Java Applet parsing package ScanApplet; use base "HTML::Parser"; sub start { my ($self, $tag, $attr, $attrseq, $origtext) = @_; if($tag =~ /^applet$/){ if(defined $attr->{'code'}){ $applet{'code'} = $attr->{'code'}; } if(defined $attr->{'archive'}){ $applet{'archive'} = ''; if($attr->{'archive'} !~ /^http:/i){ if($attr->{'archive'} =~ /,/){ # pesky library files to check for full url my @files = split(/,/, $attr->{'archive'}); foreach(@files){ if($_ !~ /http:/i){ $_ = $folder.$_; } } $applet{'archive'} = join(',', @files); } else { $applet{'archive'} = $folder.$attr->{'archive'}; } } else { $applet{'archive'} = $attr->{'archive'}; } } if(defined $attr->{'width'}){ $applet{'width'} = $attr->{'width'}; } if(defined $attr->{'height'}){ $applet{'height'} = $attr->{'height'}; } if(defined $attr->{'mayscript'}){ $applet{'mayscript'} = $attr->{'mayscript'}; } } if($tag =~ /^param$/){ if(defined $attr->{'name'}){ push(@paramName, $attr->{'name'}); } if(defined $attr->{'value'}){ push(@paramValue, $attr->{'value'}); } } } sub text { my ($self, $text) = @_; $applet{'alt'} .= $text; } # Extract Applets and replace with uber JavaScript link to mount applet on page # Unfortunately I can't get links with a lot of characters to activate from Flash -> # The workaround is to sod the params and use a function in to most stuff while($html =~ /", $start) + 8; my $appletChunk = substr($html, $start, $end - $start); # scan that shit my $a = new ScanApplet; $a->parse($appletChunk); $a->eof; # build that shit my $replacement = " 0){ # for(my $i = 0; $i < @paramName; $i++){ # $replacement .= "ao.addParam('".$paramName[$i]."','".$paramValue[$i]."');"; # } #} #$replacement .= "ao.write('appletcontent');\">Java Applet detected, click here to mount on this page"; $replacement = "Java Applet detected, click here to mount on this page"; substr($html, $start, $end - $start, $replacement); } # Module based parsing - takes care of the more tricky entities package ChangeEntities; use base "HTML::Parser"; sub start { my ($self, $tag, $attr, $attrseq, $origtext) = @_; # kill img tags if($tag =~ /^img$|^myimg$/){ if(defined $attr->{'src'}){ my $ext = substr($attr->{'src'}, rindex($attr->{'src'}, '.')); if($ext =~ /\.jpg/i){ if($attr->{'src'} !~ /^http:/){ push(@imgs, $folder.$attr->{'src'}); } else { push(@imgs, $attr->{'src'}); } } } return; } # fix anchors if($tag =~ /^a$/){ my $ext = '.html'; if(defined $attr->{'href'}){ $ext = substr($attr->{'href'}, rindex($attr->{'href'}, '.')); if($attr->{'href'} !~ /^http:\/\/|^mailto:|^javascript:/){ $attr->{'href'} = $folder.$attr->{'href'}; } } my $target = ' target="_blank"'; if($ext =~ /\.zip|\.doc/i || $attr->{'href'} =~ /^mailto:/ || $attr->{'href'} =~ /^javascript:/){ $target = ''; } $xml .= ''; return; } # remove attributes from body tag if($tag =~ /^body$/){ $xml .= ""; return; } # replace unwanted tags if($tag =~ /$notag/){ $xml .= '
'; return; } $xml .= $origtext; } sub declaration{ } sub text { my ($self, $text) = @_; $xml .= $text; } sub comment { } sub end { my ($self, $tag, $origtext) = @_; # replace unwanted tags if($tag =~ /$notag/){ $xml .= '
'; return; } $xml .= $origtext; } my $p = new ChangeEntities; $p->parse($html); $p->eof; $html = $xml; # change all whitespace to " " $html =~ s/\s+/ /g; # change   to whitespace $html =~ s/ / /g; # separate consecutive anchors with commas (Flash htmlText bug) $html =~ s/\/a>\s*, Visit HTML version of this url'; $html =~ s/<\/body>/$link/i; # make anchor tags visible in Flash $html =~ s//\/a><\/font><\/u>/gi; # remove more than 2 consecutive
while($html =~ /
\s*
\s*
/gi){ $html =~ s/
\s*
\s*
/

/gi; } # chomp whitespace on rightside of
tags while($html =~ /
\s/gi){ $html =~ s/
\s/
/gi } # isolate node my $start = index(uc($html), ""); my $end = index(uc($html), "") + 7; my $body = substr($html, $start, $end - $start); # Make the first line bold $body =~ s/>(\s*([^><\s]+\s*)+)$1<\/b> after $body =~ s//
/i; # disolve multiple
after $body =~ s/(\s*
\s*)+/
/i; # convert tags to CDATA tags and add font description $body =~ s///i; $body =~ s/<\/body>/<\/font>]]>/i; # concat data, print result $xml = ''.$body.''; foreach(@imgs){ $xml .= ''; } $xml .= ''; print "Content-type: text/xml\n\n", $xml; # Old notepad / guestbook experiments from my site's first incarnation #!/usr/bin/perl -w #online notepad form with CSS #upload text file use CGI qw/:standard :html3/; open (CLIP, "; $lastState = join ("", @clip); my $query = new CGI(); if ($query->param("addclip")){ #save text file open (CLIP, ">clip.txt") || bail ("cannot read text file: $!"); flock(CLIP, 2) or bail ("cannot lock file: $!"); my $addclip = param("addclip"); #won't write $addclip $temp[0] = $addclip; print CLIP @temp; #print CLIP "something\n"; #put this line in to test file writing close (CLIP) || bail ("cannot close file: $!"); } #print form to browser print $query->header; print $query->start_html(-title=>'Clip Board', -author=>'st3ed@hotmail.com', #-base=>'true', -meta=>{'keywords'=>'work, you, stupid, program', 'copyright'=>'open source bud'}, -style=>{'src'=>'../steed1.css'}, #-BGCOLOR=>'blue' ); print $query->h1( #{-class=>'steed1'}, 'Steed\'s Online Clip Board'),p(); print "
"; print "
"; print $query->start_form, "Input: ", $query->br, $query->textarea(-name=>'addclip', -default=>$lastState, -rows=>25, -columns=>75), $query->p, $query->submit("update"), $query->p, $query->end_form; print "
"; print $query-> end_html; #cock-up handling sub bail { my $error = "@_"; print h1("Error Reported"), p($error), end_html; die $error; } #!/usr/bin/perl -w #Guest book for st33d.net #adapted from Learning Perl to incorporate my CSS use CGI qw/:standard :html3/; my( $chatname, #name of guestbook file $maxsave, #how many to keep $title, #page title and header $cur, #new guestbook entry @entries, #all cur entries $entry, #one particular entry ); $title = "Steed\'s Guest Book"; $chatname = "guest.txt"; $maxsave = 10; print header, start_html(-title=>$title,-style=>{'src'=>'../steed1.css'}), h1($title); $cur = CGI->new(); #current request if ($cur->param('message')){ #message received $cur->param('date', scalar localtime); #set to local time @entries = ($cur); #save message to array } open(CHANDLE, "+< $chatname") || bail ("cannot open $chatname: $!"); flock(CHANDLE, 2) || bail ("cannot flock $chatname: $!"); while (!eof(CHANDLE) && @entries < $maxsave){ $entry = CGI->new(\*CHANDLE); push @entries, $entry; } seek (CHANDLE, 0, 0) || bail("cannot rewind $chatname: $!"); foreach $entry (@entries){ $entry->save(\*CHANDLE); } truncate(CHANDLE, tell(CHANDLE)) || bail ("cannot truncate $chatname: $!"); close(CHANDLE) || bail ("cannot close $chatname: $!"); print steedTop(); print start_form; print p('Name:', $cur->textfield( -name=> 'name')); print p('Message:', $cur->textfield( -name=> 'message', -override=> 1, -size=> 50)); print p(submit('send'), reset('clear')); print end_form; print steedEnd(); print p(); print steedTop(); print h2 ('Prior Messages'); foreach $entry (@entries){ printf("%s [%s]: %s", $entry->param("date"), $entry->param("name"), $entry->param("message")); print br(); } print steedEnd(); print p(); print "
"; print "

"; print "Back"; print "

"; print end_html; #cock up handling sub bail { my $error = "@_"; print h1("Error Reported"), p($error), end_html; die $error; } #CSS Shorthand sub steedTop{ return "
"; } sub steedEnd{ return "
"; }