#!/usr/bin/perl -w #I didn't intend for something so long to end up on the # frontpage. I'd keep it in Craft if I could. Sorry. #PipsPerlMonksThemer - PPMT # You can play with this craft at http://BinQ.org/ppmt/ # Please do... and tell me what you thinq. =) use CGI ":standard"; use LWP::UserAgent; my $this = "http://BinQ.org/ppmt/index.cgi"; my $filp = "/home/httpd/html/ppmt/filters/"; my $favs = "/home/httpd/html/ppmt/favoritz.txt"; my $meth = $ENV{'REQUEST_METHOD'}; my $quer = $ENV{'QUERY_STRING'}; my $what = param("whattodo"); my $monk = param("wichmonk"); my $site = "http://PerlMonks.org"; my $srch = "PerlMonks"; my $wich = param("wichfilt"); my $nick = param("wichnick"); my $uage = new LWP::UserAgent; my @flis = glob("$filp*"); $uage->agent("AgentName/0.1 " . $uage->agent); my $requ = ""; my $resp = ""; print "Content-type: text/html\n\n"; if ($quer ne "") { if ($quer =~ /^filt=([^&]*)&/) { $filt = $1; $quer =~ s/^filt=[^&]*&//; } if ($quer !~ /^http\:\/\//) { $quer = "http://" . $quer; } $requ = new HTTP::Request GET => "$quer"; $resp = $uage->request($requ); if ($resp->is_success) { $cont = $resp->content; $foun = 0; open FILE, "<$filp$filt"; while () { chomp ($parm = $_); chomp ($sour = ); chomp ($dest = ); $quer =~ s/(.*\/).*/$1/; $dest =~ s/\{\$quer\}/$quer/; if ($filt eq "randomal") { $whol = $sour; if ($whol =~ /((color="?\#?|\w+="?\#|\w+=")([0-9a-fA-F]{2})([0-9a-fA-F]{2})([0-9a-fA-F]{2})"?)/i) { $redv = $3; $grnv = $4; $bluv = $5; $nred = sprintf "%lx", (rand(255)); $ngrn = sprintf "%lx", (rand(255)); $nblu = sprintf "%lx", (rand(255)); if (length($nred) == 1) { $nred = "0" . $nred; } if (length($ngrn) == 1) { $ngrn = "0" . $ngrn; } if (length($nblu) == 1) { $nblu = "0" . $nblu; } $whol =~ s/(color="?\#?|\w+="?\#)$redv$grnv$bluv"?/$1/i; $whol =~ s/="?\#?/="\#/i; #$whol =~ tr/A-Z/a-z/; $nred =~ tr/a-z/A-Z/; $ngrn =~ tr/a-z/A-Z/; $nblu =~ tr/a-z/A-Z/; $whol .= "$nred$ngrn$nblu\""; $dest = $whol; } } $dlis[$foun] = $dest; if ($foun < 1024) { if ($parm =~ /g/i) { if ($parm =~ /i/i) { $cont =~ s/$sour/SoUr${foun}dEsT/gi; } else { $cont =~ s/$sour/SoUr${foun}dEsT/g; } } else { if ($parm =~ /i/i) { $cont =~ s/$sour/SoUr${foun}dEsT/i; } else { $cont =~ s/$sour/SoUr${foun}dEsT/; } } $foun++; } } while ($foun) { $foun--; if ($parm =~ /g/i) { if ($parm =~ /i/i) { $cont =~ s/SoUr${foun}dEsT/$dlis[$foun]/gi; } else { $cont =~ s/SoUr${foun}dEsT/$dlis[$foun]/g; } } else { if ($parm =~ /i/i) { $cont =~ s/SoUr${foun}dEsT/$dlis[$foun]/i; } else { $cont =~ s/SoUr${foun}dEsT/$dlis[$foun]/; } } } $foun = 1; close FILE; print $cont; } else { print "Bad luck this time\n"; } } elsif ($what && $what ne "creafilt" && $what ne "delefilt") { if ($what eq "mangfavs" || $what eq "updtfavs" || $what eq "add2favs") { print "PPMT v1.0\n"; print "
\n"; print "

PPMT v1.0 ndx

\n"; print "

Favorites

\n"; if ($what eq "add2favs") { open FILE, "<$favs"; @fvls = ; close FILE; @chos = split /\s/, $fvls[0]; @cvlz = split /\s/, $fvls[1]; if ($nick !~ /\#?[0-9A-Fa-f]{6}/) { $wich = "Black"; $nick = "#000000"; } if ($nick !~ /^\#/) { $nick = "\#" . $nick; } if ($wich !~ /\w+/) { $wich = "Black"; } $wich =~ s/\n//g; $nick =~ s/\n//g; $chos[$#chos] = "$wich"; $chos[@chos] = "end\n"; $cvlz[$#cvlz] = "$nick"; $cvlz[@cvlz] = "end\n"; $fvls[0] = " " . join ' ', @chos; $fvls[1] = " " . join ' ', @cvlz; $fvls[@fvls] = "$wich\n"; $fvls[@fvls] = "$nick\n"; print "

Adding $wich with value $nick to Favorites!

\n"; open FILE, ">$favs"; foreach (@fvls) { print FILE $_; } close FILE; } elsif ($what eq "updtfavs") { print "

Updating Favorites!

\n"; open FILE, "<$favs"; @fvls = ; close FILE; $fvls[0] = " "; $fvls[1] = " "; $coun = 2; while ($fvls[$coun]) { chomp ($kaka = $fvls[$coun++]); if (param("ChooseColor$kaka") eq "YES") { $fvls[0] .= "$kaka "; chomp ($kaka = $fvls[$coun++]); $fvls[1] .= "$kaka "; } } $fvls[0] .= "end\n"; $fvls[1] .= "end\n"; open FILE, ">$favs"; foreach (@fvls) { print FILE $_; } close FILE; } print "\n"; print "\n"; print "\n"; open FILE, "<$favs"; $fnmz = ; $fvlz = ; while () { chomp; print "
ChooseNameValueExample\n"; print "\ \;\ \;\ \;\ \;\ \;\ \;\ \;\ \;ChooseNameValueExample
\n$_"; chomp ($_ = ); print "$_\ \;\ \;\ \;\ \;\ \;\ \;\ \;\ \;\ \;\ \;\n"; if ($_ = ) { # chomp ($_ = ); chomp; print "\n$_"; chomp ($_ = ); print "$_\ \;\ \;\n"; } } close FILE; print "
\n"; print "
\n"; print "\n"; print "Name:
\n"; print "Value:
\n"; print "
\n"; print "

PPMT v1.0 ndx

\n"; print "\n"; } else { print "PPMT v1.0\n"; print "
\n"; print "

PPMT v1.0 ndx

\n"; if ($what eq "updtseti") { $filt = $wich; $filt =~ s/^.*\///; print "

Updating Filter: $filt!

\n"; open FILE, ">$wich"; $wich =~ s/.*\/([^\/]+)/$1/; $clim = param("filtcoun"); $coun = 1; $blok = ""; while ($coun <= $clim) { $parm = param("pArM${coun}PaRm") . param("pAr2${coun}PaR2"); $sour = param("sOuR${coun}SoUr"); $dest = param("dEsT${coun}DeSt"); if (param("pIcK${coun}PiCk") ne "") { $turd = param("pIcK${coun}PiCk"); if ($turd =~ /"\#[0-9A-Fa-f]{6}"/) { $dest =~ s/"\#[0-9A-Fa-f]{6}"/$turd/; } } if ($sour ne "") { if ($sour =~ /^"\#?[0-9A-Fa-f]{6}"$/) { if ($dest !~ /^"\#?[0-9A-Fa-f]{6}"$/) { if ($dest =~ /([0-9A-Fa-f]+)/) { $turd = $1; $turd = "0" x (6-length($turd)) . $turd; $dest = "\"\#$turd\""; } } } $sour =~ s/&/&/g; $sour =~ s/"/"/g; $sour =~ s/<//g; $sour =~ s/¦/\|/g; $dest =~ s/&/&/g; $dest =~ s/"/"/g; $dest =~ s/<//g; $dest =~ s/¦/\|/g; if ($parm =~ /i/i) { if ($blok !~ /\s$coun\s/) { if ($parm =~ /g/i) { print FILE "g"; } print FILE "i\n$sour\n$dest\n"; } $pcou = $coun; while (++$pcou < $clim) { if ($sour eq param("sOuR${pcou}SoUr")) { $blok .= " $pcou "; } } } else { if ($parm =~ /g/i) { print FILE "g"; } if ($blok !~ /\s$coun\s/) { print FILE "\n$sour\n$dest\n"; } } } $coun++; } close FILE; $wich = $filp . $wich; } open FILE, "<$favs"; chomp ($kaka = ); chomp ($poop = ); close FILE; @chos = split /\s/, $kaka; $#chos--; @cvlz = split /\s/, $poop; $#cvlz--; $coun = 0; while ($coun < @chos) { $optn .= "