#!/usr/bin/perl -Tw

# lteter jmuble
# -- 
# dan@erase.net
# 19 sept 2003

# CAVEATS
#  - @import() in css will fail

use strict;
use CGI ':standard';
use LWP::UserAgent;
use HTML::Parser;
use URI;

my $q = new CGI;
my $title = jumble("letter jumble");


if (defined $q->param("text") and $q->param("text") =~ /\w/)
{
	my $text = $q->param("text");
	$text = jumble($text);
	print	header,
		start_html(
			-style	=> { src => "/style.css" },
			-title	=> "erase.net - $title",
		),
		div(
			{ id => "main" },

			h1($title),
			p($text),
			p(a({ href => "?" }, ">> jmuble mroe!"))
		),
}
elsif (defined $q->param("url") and $q->param("url") =~ /\w/)
{
	my $url = $q->param("url");
	$url = "http://$url" if $url !~ m,://,;
	error("Invalid protocol") if $url !~ /^http:/;

	my $ua = new LWP::UserAgent;
	my $me = "http://" . $ENV{HTTP_HOST} . $ENV{SCRIPT_NAME};

	# NOTE: this is only needed because i have a custom index.html
	$me =~ s,[^/]+$,,;

	my $res = $ua->get($url, Referer => $me)
		or error("Couldn't call get() method");

	error("Couldn't retrieve URL") unless $res->is_success;
	my $data = $res->content;

	# don't affect text within these elements
	my @no_jumble = qw(script style);
	my $no_jumble = 0;

	my $out;
	my $p = HTML::Parser->new(
		default_h	=> [ sub { $out .= shift }, "text" ],
		text_h		=> [ sub {
			$out .= $no_jumble ?
				$_[0] :
				jumble($_[0])
		}, "text" ],

		start_h		=> [ sub {
			my ($tag, $attr) = @_;
			$no_jumble++ if grep { $_ eq $tag } @no_jumble;
			delete $attr->{"/"};

			foreach my $a (qw(src href)) {
				next if !exists $attr->{$a};
				$attr->{$a} = URI->new($attr->{$a})->abs($url)->canonical;
			}

			$out .= "<$tag" . join "", map {
				qq( $_="$attr->{$_}") } keys %$attr;
			$out .= ">";
			if ($tag eq "head")
			{
				$out .= sprintf("<base href='%s' />", $url); 
			}
		}, "tagname, attr" ],

		end_h	=> [ sub {
			my ($tag, $text) = @_;
			$no_jumble-- if grep { $_ eq $tag } @no_jumble;
			$out .= $text;
		}, "tagname, text" ],
	);

	$p->parse($data);

	print header;
	print $out;
}
else
{
	print	header,
		start_html(
			-style	=> { src => "/style.css" },
			-title	=> "erase.net - $title",
		),
		div(
			{ id => "main" },

			h1($title),
			p("enter either a url or some text to jumble up"),
			start_form(-method => "get"),
			b("url:"),
			textfield(-name => "url", -size => 34),
			br, br,
			b("text:"), br,
			textarea(
				-name	=> "text",
				-rows	=> 6,
				-cols	=> 38,
			),
			br, br,
			submit({ -class => "submit", -value => "go >>" }),
			end_form,
		);
}

sub	jumble
{
	my ($text) = @_;

	# don't warp SGML entities
	$text =~ s/(?<!&)\b(\w{4,})\b/jumble_word($1)/ge;
	return $text;
}

sub	jumble_word
{
	my ($word) = @_;

	my @letters = split(//, $word);
	my $first = splice(@letters, 0, 1);
	my $last = splice(@letters, -1);

	for my $i (0..$#letters) {
		my $j = int rand @letters;
		next if $i == $j;
		@letters[$i, $j] = @letters[$j, $i];
	}

	return join "", $first, @letters, $last;
}

sub	error
{
	my ($errstr) = @_;
	print	header,
		start_html("error!"),
		h1("error"),
		p("an error occurred:", b($errstr));

	exit;
}