#!/usr/bin/perl
# Adaptation of a perl script from Matthew Wickline:
# http://www.listsearch.com/BBEditTalk.lasso?id=10083


use strict;

use CGI qw/:standard *div/;
use CGI::Carp qw(fatalsToBrowser);

my $email_addy = param('addy');

my $stylesheet = '/css/main.css';
my $keywords = "web design css perl email encoder";

srand;
my @encode = (
     sub { '&#' . ord(shift) . ';' },
     sub { '&#x' . sprintf( "%X", ord(shift) ) . ';' },
     sub { shift },
);


print header(-charset=>'utf-8');

print start_html(
	-title=>'Email Encoder',
	-encoding=>'utf-8',
	-script=>{-language=>'JAVASCRIPT', -type=>'text/javascript', -src=>'/js/fixed.js'},
		-head=>[ meta({-http_equiv=>'Content-Type',
			-content=>'text/html; charset=utf-8'}),
			meta({-name=>'keywords', -content=> $keywords}),
			meta({-name=>'author', -content=>'Steve Axthelm'}),
			Link({-rel=>'icon',
			-href=>'/favicon.ico'}),
			Link({-rel=>'shortcut icon',
			-href=>'/favicon.ico'})
			],
	 -style=>{-src=> $stylesheet,
		  -media=>'screen',}
);

print start_div({-id=>'content'});
print h2('Enter the email address you wish to encode in the text field below');

print start_form('POST');

print p(textfield('addy','',60,512));


if ($email_addy ne '') {
	$email_addy = "mailto:$email_addy";
	$email_addy =~ s{(.)}{
		 my $char = $1;
		 if ( $char eq '@' ) {
			 # this *must* be encoded. I insist.
			 $char = $encode[int rand 1]->($char);
		 } elsif ( $char ne ':' ) {
			 # leave ':' alone (to spot mailto: later)
			 my $r = rand;
			 # roughly 10% raw, 45% hex, 45% dec
			 $char = (
				 $r > .9 ? $encode[2]->($char) :
				 $r < .45 ? $encode[1]->($char) :
							  $encode[0]->($char)
			 );
		 }
		 $char;
	}gex;
	$email_addy = qq{<a href="$email_addy">$email_addy</a>};
	$email_addy =~ s{">.+?:}{">}; # strip the mailto: from the visible part

	print textarea ({-rows=>'5', -columns=>'80', -name=>'title', -default=>$email_addy});
}

print p(submit('Encode Email Address'), defaults('Clear Form'));
print end_form();

# print comment($email_addy);


print p("HTML encodes roughly 10% raw, 45% hex, 45% decimal. Based on a perl script from <a href=\"http://www.listsearch.com/BBEditTalk.lasso?id=10083\">Matthew Wickline</a>.");

print end_div();

print end_html();