#!/usr/bin/perl -w
#
# r1 :: regular expression lab
#
# The purpose of this script is to provide a regular expression lab -- a tool for
# experimenting with regular expressions.
#
# It uses a form with a textarea (for the input text) and a text field (for the regular expression).
# The result of applying the regular expression to the input text is shown as text at the bottom of
# the page.
#
# Future enhancements:
# 1- Provide pushbuttons to load sample data sets into the textarea (phone numbers, postal codes, ...) (DONE!)
# 2- Provide support for the s/// operator
#

use CGI::Pretty ":standard";
use CGI::Carp "fatalsToBrowser";

# Program version number
$version=0.04;

# Cross-reference between the @text array and the labels 
# on the buttons
%text_type=(
	"Quick fox"=>0,
	"Phone numbers"=>1,
	"E-mail addresses"=>2,
	"Postal codes"=>3);

# Create the xhtml for a row of submit buttons based on the
# %text_type hash keys.
$text_submit="";
foreach (sort keys %text_type) {
	$text_submit .= submit({-name=>"submit", -value=>$_});
}

# Array of sample texts to search
@text=(

"The quick brown fox jumped over the lazy dog.
THE QUICK BROWN FOX JUMPED OVER THE LAZY DOG.
The QUCK DIDDLY QUACK QUACK.",

"(416) 491-5050
416-491-5050
1-416-491-5050
416 491-5050 ext 3700
416-491-5050 x3700
Area code: 416 Phone number: 491-5050 Extension: 3700
4166-4991-50050
4164915050",

'john.doe@senecac.on.ca
john@doe.com
john_doe@senecac.on.ca
John Doe <jdoe@senecac.on.ca>
jdoe@senecac.on.ca (John Doe)
John Doe, the Best Guy Around! <jdoe@senecac.on.ca>
jdoe@senecac
John Doe
jdoe@senecacollege.ca
JDOE@SENECAC.ON.CA',

"M3C 1L2
m3c 1l2
m3c1l2
M3C1L2
M3C L1X
MEC 1L2
My postal code is M3C 1L2
MM3C1LL2
M3C   1L2
MM3C       1L22",

);

# If the user pressed a text type button,
# switch to that type of text.
if (param("submit")) {
	param("text",$text[$text_type{param("submit")}]);
}

# If the textarea is empty or the script
# hasn't been previously run, fill the textarea
# with the default text.
if (param("text") eq "") {
	param("text",$text[0]);
}

# If the regular expression is empty or
# the script hasn't been previously run,
# set the regular expression field to "[a-z]"
# (which gives an interesting result for
# each of the sample data sets).
if (param("regexp") eq "") {
	param("regexp",'[a-z]');
}

# Get the regular expression from the form
$regexp=param("regexp");

# Strip off the carriage returns from the text
($text=param("text")) =~ s/\r//g;

# Get the options field from the form
$options=param("options");

# Start with no error messages
$error="";

# Process each line. Quote the html entities
# as necessary (i.e., change < to &lt;)
foreach (split(/\n/, $text)) {
	$line=$_;
	$line=~s/\&/\&amp;/g;
	$line=~s/</\&lt;/g;
	$line=~s/>/\&gt;/g;
	
	# Get the line enclosed in an appropriate font tag 
	# (reg/green/orange) with br at the end.
	$out.=font({-color=>(eval("m/$regexp/$options"))?"#00cc00":($@)?"#ff9900":"#ff0000"},$line).br;

	# Accumulate the error messages if any
	$error.=$@.br if $@;
}

# Output the xhtml
print
	header,
	start_html({-bgcolor=>"#ffffff",
		-title=>"Regular Expression Tester $version"}),
	start_form,
	
	h1({-align=>"center"},"Regular Expression Tester"),
	
	p(b("Regular expression:"),
		br,
		"m/", textfield({-name=>"regexp", -size=>60}), 
		"/ ", textfield({-name=>"options",-size=>5}),
		submit({-value=>"Try it!"}),
		a({-href=>"#help"},"Help")
		),
	
	p(b("Text to be searched:"),
		$text_submit,
		"(feel free to add text)",
		br,
		textarea({-name=>"text",
			-columns=>80, -rows=>10})),
		
	p("Test results for ",
		b("m/$regexp/$options"),
		" (Legend: ",
		font({-color=>"#00cc00"},"match"), "/",
		font({-color=>"#ff0000"},"no match"), "/",
		font({-color=>"#ff9900"},"error"), 
		")"
	),

	table({-border=>2},Tr(td($out))),

	($error)?p(b("Error messages:"),br,$error):"",
	
	end_form,
	hr,
	a({-name=>"help"}),
	p(b(u("Instructions"))),
	p("There are three fields above: a text area, containing text to be 
	searched; a regular expression, which will be used to search the
	text; and the options for the m// operator (such as 'i' for 'ignore
	case')."),	
	p("You may change the text to be searched to any of a number of
	common data sets using the buttons at the top of the page. You may
	also edit the text or add additional lines."),
	p("When you click on the button marked \"Try It!\", the regular
	expression you have entered will be tested against each of the 
	lines in the text to be searched. Lines which match the regular 
	expression are shown in green, lines which do not match are 
	shown in red, and lines which cause an error are shown in orange."),
	p("This script uses Perl for regular expression evaluation. The ",
	a({-href=>"http://perldoc.com/perl5.6.1/pod/perlre.html"},
		"Perl regular expression syntax"),
	"may be slightly different from other languages and 
	utilities that use regular expressions (such as the ",
	a({-href=>"http://www.gnu.org/software/grep/doc/grep.html"},
		"grep"),
	" command)."),
	hr,
	p("Version $version by Chris Tyler. Your ",
		a({-href=>"mailto:chris.tyler\@senecac.on.ca?Subject=Regular+Expression+Tester+version+$version"},
		"feedback"),
		"is appreciated. (The ",
		a({-href=>"index.txt"},"Perl source code"),
		" for this script is available)."),
	end_html;