package CGI::Formalware;

# Name:
#	CGI::Formalware.
#
# Documentation:
#	POD-style documentation is at the end. Extract it with pod2html.*.
#
#
# Test environment:
#	Apache V 1.3.4, 1.3.6, 1.3.9, 1.3.12 for Windows.
#
# Note:
#	tab = 4 spaces || die.
#
# Author:
#	Ron Savage <ron@savage.net.au>
#	Home page: http://savage.net.au/index.html
#
# Licence:
#	Australian copyright (c) 1999-2002 Ron Savage.
#
#	All Programs of mine are 'OSI Certified Open Source Software';
#	you can redistribute them and/or modify them under the terms of
#	The Artistic License, a copy of which is available at:
#	http://www.opensource.org/licenses/index.html

use strict;

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;

@ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

@EXPORT = qw();

our $VERSION = '1.16';

# Preloaded methods go here.
# -----------------------------------------------------------------

use constant CURRENT_FORM_STRING	=> 'currentForm';
use constant DEBUG_FILE_NAME_STRING	=> 'CGI-Formalware.log';
use constant FILE_NAME_STRING		=> 'fileName';
use constant NEXT_FORM_STRING		=> 'Next form';
use constant PREVIOUS_FORM_STRING	=> 'Previous form';
use constant SCRIPT_HEADING_STRING	=> 'scriptHeading';
use constant SUBMIT_STRING			=> 'Submit';
use constant XML_FILE_NAME_STRING	=> 'xmlFileName';

use vars qw($attributes $text);
use vars qw(@attribute @element);
use vars qw(%fieldName);
use vars qw(%fieldNameSeen);
use vars qw($formCountPhase1);
use vars qw($formCountPhase2);
use vars qw(%formFileNameSeen);
use vars qw(%formHeadingSeen);
use vars qw($html);
use vars qw($indentLevel $indentPrefix);;
use vars qw($myself);	# An alias for use in non-object subs.
use vars qw(%numberScripts);
use vars qw(%script);
use vars qw(%scriptCount);
use vars qw(%scriptHeadingMenu);
use vars qw(%scriptHeadingSeen);
use vars qw(%scriptType);
use vars qw(@tableOfContents);
use vars qw(%tableOfContents);
use vars qw($xmlFileName);

use CGI ':standard';
use CGI::Carp qw(carpout fatalsToBrowser);
use Net::Telnet;
use XML::DOM;

# -----------------------------------------------------------------

($attributes, $text)			= ('', '');
($html)							= {};
($indentLevel, $indentPrefix)	= (0, '');
($formCountPhase1)				= 0;
($formCountPhase2)				= 0;

# -----------------------------------------------------------------

sub charHandlerPhase1
{
	my($expat, $string) = @_;

	# Trim whitespace.
	$string =~ s/^\s+//;
	$string =~ s/\s+$//;

	$text .= "$indentPrefix$string" if ($string);

}	# End of charHandlerPhase1.

# -----------------------------------------------------------------

sub charHandlerPhase2
{
	my($expat, $string) = @_;

	# Trim whitespace.
	$string =~ s/^\s+//;
	$string =~ s/\s+$//;

	$text .= "$indentPrefix$string" if ($string);

}	# End of charHandlerPhase2.

# -----------------------------------------------------------------

sub endHandlerPhase1
{
	my($expat, $element) = @_;

	&popIndent();

	# Trim whitespace.
	$text =~ s/^\s+//;
	$text =~ s/\s+$//;

	# Gain access to the attributes of the current element, and
	# via the top-of-stacks, to the parent's element and attributes.
	pop(@element);
	my($attribute) = pop(@attribute);

	$text = '';

}	# End of endHandlerPhase1.

# -----------------------------------------------------------------

sub endHandlerPhase2
{
	my($expat, $element) = @_;

	&popIndent();

	# Trim whitespace.
	$text =~ s/^\s+//;
	$text =~ s/\s+$//;

	# Gain access to the attributes of the current element, and
	# via the top-of-stacks, to the parent's element and attributes.
	pop(@element);
	my($attribute) = pop(@attribute);

	if ($element =~ /^form$/i)
	{
		# Due to bugs in CGI.pm (around V 2.56), the override and default
		# options must appear before the value option.
		# Also, the override and default options must be used
		# when there is only 1 radio button. If not, then the
		# one and only button is not selected.
		push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
			radio_group({name => SCRIPT_HEADING_STRING, cols => 1,
			override => 1,
			default => ${$scriptHeadingMenu{$formCountPhase2} }[0],
			value => \@{$scriptHeadingMenu{$formCountPhase2} } }),
			'</TD>', '</TR>');

		push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>', hr(), p(),
			submit({name => SUBMIT_STRING, value => SUBMIT_STRING}), reset() );

		# After the first form...
		if ($formCountPhase2 > 1)
		{
			# Add previousForm button.
			push(@{$$html{$formCountPhase2} },
				submit({name => SUBMIT_STRING, value => PREVIOUS_FORM_STRING}) );
		}

		# Before the last form...
		if ($formCountPhase2 < $formCountPhase1)
		{
			push(@{$$html{$formCountPhase2} },
				submit({name => SUBMIT_STRING, value => NEXT_FORM_STRING}) );
		}

		push(@{$$html{$formCountPhase2} }, '</TD>', '</TR>', '</TBODY>',
			'</TABLE>', '</TD>', '</TR>', '</TABLE>');
		push(@{$$html{$formCountPhase2} },
			hidden({name => XML_FILE_NAME_STRING, value => $xmlFileName, override => 1}),
			hidden({name => CURRENT_FORM_STRING, value => $formCountPhase2, override => 1}) );

		# End outputting HTML.
		push(@{$$html{$formCountPhase2} }, end_form(), end_html() );

		$myself -> writeFile($$attribute{'formFileName'}, $$html{$formCountPhase2})
			if ($myself -> {'form2file'});
	}

	# horizontalRule.
	if ($element =~ /^horizontalRule$/i)
	{
		push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
			hr(), '</TD>', '</TR>');
	}

	# paragraph.
	if ($element =~ /^paragraph$/i)
	{
		my($text) = defined($$attribute{'text'}) ? $$attribute{'text'} : '';
		push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
			p($text), '</TD>', '</TR>');
	}

	# radioGroup.
	if ($element =~ /^radioGroup$/i)
	{
		my($columns) = defined($$attribute{'columns'}) ? $$attribute{'columns'} : '1';
		my(@value) = split(/\|/, $$attribute{'value'});
		push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
			$$attribute{'prompt'},
			radio_group({name => $$attribute{'name'}, cols => $columns, value => \@value}),
			'</TD>', '</TR>');
	}

	# textField.
	if ($element =~ /^textField$/i)
	{
		if ($$attribute{'name'} =~ /^password$/i)
		{
			push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
				$$attribute{'prompt'},
				password_field({name => $$attribute{'name'},
				value => $$attribute{'value'}, size => $$attribute{'size'} }),
				'</TD>', '</TR>');
		}
		else
		{
			push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
				$$attribute{'prompt'},
				textfield({name => $$attribute{'name'},
				value => $$attribute{'value'}, size => $$attribute{'size'} }),
				'</TD>', '</TR>');
		}
	}

	# fileField.
	if ($element =~ /^fileField$/i)
	{
		push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
			$$attribute{'prompt'},
			filefield({name => $$attribute{'name'}, size => $$attribute{'size'} }),
			'</TD>', '</TR>');
	}

	# scripts.
	if ($element =~ /^scripts$/i)
	{
		push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
			h2($$attribute{'heading'}), '</TD>', '</TR>');
	}

	# script.
	if ($element =~ /^script$/i)
	{
		my($script) = [];

		for (sort keys %$attribute)
		{
			push(@$script, $$attribute{$_}) if (/^line\d{1,2}$/i);
		}

		$scriptCount{$formCountPhase2}++;
		my($number)	= '';
		$number		= sprintf("%2i: ", $scriptCount{$formCountPhase2})
			if ($numberScripts{$formCountPhase2});
		$number		= "$number$$attribute{'heading'}";
		push(@{$scriptHeadingMenu{$formCountPhase2} }, $number);
		${$script{$formCountPhase2} }{$number}		= $script;
		${$scriptType{$formCountPhase2} }{$number}	= $$attribute{'type'};
	}

	# Gather field names for substitution into scripts.
	if ( ($element =~ /^(fileField|radioGroup|textField)$/i) )
	{
		${$fieldName{$formCountPhase2} }{$$attribute{'name'} } = $1;
	}

	$text = '';

}	# End of endHandlerPhase2.

# -----------------------------------------------------------------

sub expandMacros
{
	my($self, $script, $fieldName) = @_;

	for (@$script)
	{
		s/\t/ /g;
		s/^\s+//;
		s/\s+$//;

		next if (! $_);

		my($name);

		for $name (keys(%$fieldName) )
		{
			my($value) = param($name) || '';
			s/%$name%/$value/g;
		}
	}

	# Discard null lines.
	@$script = grep(length, @$script);

	@$script;

}	# End of expandMacros.

# -----------------------------------------------------------------

sub getXMLFileName
{
	my($self) = @_;

	my($heading) = 'Generate CGI Forms';

	# Use "SUBMIT_STRING ", not just SUBMIT_STRING, so the if test in the main line,
	# if ($submission eq SUBMIT_STRING), returns false.

	print header(), start_html(title => $heading),
		start_form(), h1($heading), hr(),
		'Please enter the name of the XML file which will be used to generate the CGI forms. ',
		p(),
		'This can be any DOS file path, eg D:\Temp\menu.xml. Also, .\menu.xml uses cgi-bin\: ',
		hidden({name => CURRENT_FORM_STRING, value => 1, override => 1}),
		p(), textfield({name => XML_FILE_NAME_STRING, value => '', size => 50, override => 1}),
		hr(), submit({name => SUBMIT_STRING, value => (SUBMIT_STRING . ' ')}),
		end_form(), end_html();

#		<FORM ENCTYPE="multipart/form-data" ACTION="/cgi-bin/upload.cgi" METHOD="POST">
#		<INPUT TYPE="FILE" NAME="file-to-upload-01" SIZE="35">

}	# End of getXMLFileName.

#-------------------------------------------------------------------

sub new
{
	my($class, $optionRef)		= @_;
	$class						= ref($class) || $class;
	my($self)					= (ref($optionRef) eq 'HASH') ? $optionRef : {};
	$self -> {'debug'}			= '' if (! defined($self -> {'debug'}) );
	$self -> {'form2file'}		= '' if (! defined($self -> {'form2file'}) );
	$self -> {'timeScripts'}	= '' if (! defined($self -> {'timeScripts'}) );
	$myself						= $self;	# An alias for use in non-object subs.

	return bless $self, $class;

}	# End of new.

# -----------------------------------------------------------------

sub phase1
{
	my($self, $xmlFileName) = @_;

	# Declare the parser.
	my($parser)	= new XML::DOM::Parser;

	$parser -> setHandlers
	(
		Start	=> \&startHandlerPhase1,
		End		=> \&endHandlerPhase1,
		Char	=> \&charHandlerPhase1,
	);

	# Parse the document and call the handlers.
	my($doc) = $parser -> parsefile($xmlFileName);

}	# End of phase1.

# -----------------------------------------------------------------

sub phase2
{
	my($self, $xmlFileName) = @_;

	# Declare the parser.
	my($parser)	= new XML::DOM::Parser;

	$parser -> setHandlers
	(
		Start	=> \&startHandlerPhase2,
		End		=> \&endHandlerPhase2,
		Char	=> \&charHandlerPhase2,
	);

	# Parse the document and call the handlers.
	my($doc) = $parser -> parsefile($xmlFileName);

}	# End of phase2.

# -----------------------------------------------------------------

sub popIndent
{
	$indentLevel--;
	$indentPrefix = "\t" x $indentLevel;

}	# End of popIndent.

# -----------------------------------------------------------------

sub process
{
	my($self) = @_;

	if ($self -> {'debug'})
	{
		open(DEBUG, '>> ' . DEBUG_FILE_NAME_STRING) || croak("Can't open(> " . DEBUG_FILE_NAME_STRING . "): $!\n");
		carpout(\*DEBUG);
	}

	if (param() )
	{
		$xmlFileName = param(XML_FILE_NAME_STRING);

		croak("Can't find XML file: $xmlFileName\n") if (! -e $xmlFileName);

		# Parse once to count things.
		$self -> phase1($xmlFileName);

		# Parse again to do things.
		$self -> phase2($xmlFileName);

		my($submission) = param(SUBMIT_STRING) || '';

		# Run a script and send the output to the browser, or...
		if ($submission eq SUBMIT_STRING)
		{
			my($scriptHeading)	= param(SCRIPT_HEADING_STRING);
			my($formCount)		= param(CURRENT_FORM_STRING);
			my($scriptType)		= ${$scriptType{$formCount} }{$scriptHeading};
			$self -> runLocalScript($scriptHeading, $formCount)		if ($scriptType =~ /^local$/i);
			$self -> runRemoteScript($scriptHeading, $formCount)	if ($scriptType =~ /^remote$/i);
		}
		else
		{
			# Send a stored form to the browser.
			# This is the non-TOC code.
			my($next)	= param(CURRENT_FORM_STRING);
			$next		-= 1	if ($submission eq PREVIOUS_FORM_STRING);
			$next		+= 1	if ($submission eq NEXT_FORM_STRING);

			# This is the TOC code.
			my($page);

			for ($page = 1; $page <= ($#tableOfContents + 1); $page++)
			{
				$next = $page if (param($page) );
			}

			for (@{$$html{$next} })
			{
				print "$_\n";
			}
		}
	}
	else
	{
		$self -> getXMLFileName();
	}

	close(DEBUG) if ($self -> {'debug'});

}	# End of process.

# -----------------------------------------------------------------

sub pushIndent
{
	$indentLevel++;
	$indentPrefix = "\t" x $indentLevel;

}	# End of pushIndent;

# -----------------------------------------------------------------
# Read a file. Pass in $chomp == 0 to stop chomping.

sub readFile
{
	my($self, $fileName, $chomp) = @_;
	$chomp = 1 if ($#_ == 0);

	open(INX, $fileName) || croak("Can't open($fileName): $!\n");
	my(@line) = <INX>;
	close(INX);
	chomp(@line) if ($chomp != 0);

	\@line;

}	# End of readFile.

# -----------------------------------------------------------------

sub runLocalScript
{
	my($self, $heading, $formCount) = @_;

	my($script)			= ${$script{$formCount} }{$heading};
	my($fieldName)		= $fieldName{$formCount};
	@$script			= $self -> expandMacros($script, $fieldName);
	my($scriptFileName)	= 'script.bat';

	$self -> writeFile($scriptFileName, $script);

	# Handle FTP here.
	if ($$script[$#{$script}] =~ /^ftp\s+(-n\s+-v|-v\s+-n)$/i)
	{
		# Create a text file to input to FTP.
		open(OUT, "> $scriptFileName.txt") || croak("Can't open(> $scriptFileName.txt): $!\n");
		print OUT 'open ', param('host'), "\n";
		print OUT 'user ', param('username'), ' ', param('password'), "\n";
		print OUT "bin\n";
		print OUT 'get ', param(FILE_NAME_STRING), "\n";
		print OUT "quit\n";
		close(OUT);

		# Patch batch file to run FTP.
		my($cmd)		= $self -> readFile($scriptFileName, 1);
		$$cmd[$#{$cmd}]	= "type $scriptFileName.txt | $$script[$#{$script}]\n";
		$self -> writeFile($scriptFileName, $cmd);
	}

	my($startTime)	= time();
	my(@log)		= `$scriptFileName`;
	unlink($scriptFileName);
	unlink("$scriptFileName.txt");
	my($time)		= time() - $startTime;

	print header(), start_html($heading), start_form(), h1($heading), hr(), '<PRE>';

	for (@log)
	{
		# Convert anything which looks like an HTML tag to something else.
		# In particular, XML, & DOS dir listings containing 'cgi-bin <DIR>'.
		s/<(.+?)>/&lt;$1&gt;/g;
		print $_;
	}

	1 while ($time =~ s/(\d)(\d\d\d)(?!\d)/$1,$2/);

	if ($self -> {'timeScripts'})
	{
		print '</PRE>', hr(), "That took $time second",
			($time == 1) ? '' : 's', '. ', end_form(), end_html();
	}
	else
	{
		print '</PRE>', hr(), end_form(), end_html();
	}

}	 # End of runLocalScript.

# -----------------------------------------------------------------

sub runRemoteScript
{
	my($self, $heading, $formCount) = @_;

	my($script)			= ${$script{$formCount} }{$heading};
	my($fieldName)		= $fieldName{$formCount};
	@$script			= $self -> expandMacros($script, $fieldName);
	my($scriptLogName)	= "script.log";
	my($prompt)			= '/\[\d+\] /';
	my($actualCommand)	= '';
	my($startTime)		= time();

	unlink($scriptLogName);

	# When we leave this block we kill off $session.
	# Then, unlink($scriptLogName) works.
	{
		my($session) = new Net::Telnet
		(
			Timeout	=> 3600,
			Prompt	=> $prompt,
		);

		$session -> input_log($scriptLogName);
		$session -> open(param('host') );
		$session -> login(param('username'), param('password') );

		# Warning: Use spaces and not tabs to separated fields within these strings.
		#	Net::Telnet V 3.01 strips the tabs and does not replace them with a space.

		for (@$script)
		{
			$actualCommand = $_ if (! $actualCommand);
			$session -> cmd($_);
		}

		$session -> close();
	}

	my($time)	= time() - $startTime;
	my($log)	= $self -> readFile($scriptLogName, 1);

	unlink($scriptLogName);

	print header(), start_html($heading), start_form(), h1($heading), hr(),
		hidden({name => SUBMIT_STRING, value => SUBMIT_STRING, override => 1}),
		'<PRE>';

	# Print nothing until we find the command we sent.
	my($foundCommand)	= 0;
	$actualCommand		= quotemeta($actualCommand);

	for (@$log)
	{
		# Convert anything which looks like an HTML tag to something else.
		# In particular, XML, & DOS dir listings containing 'cgi-bin <DIR>'.
		s/<(.+?)>/&lt;$1&gt;/g;

		$foundCommand = 1 if (/$actualCommand\s*$/);
		print "$_\n" if ($actualCommand);
	}

	1 while ($time =~ s/(\d)(\d\d\d)(?!\d)/$1,$2/);

	if ($self -> {'timeScripts'})
	{
		print '</PRE>', hr(), "That took $time second",
			($time == 1) ? '' : 's', '. ', end_form(), end_html();
	}
	else
	{
		print '</PRE>', hr(), end_form(), end_html();
	}

}	 # End of runRemoteScript.

# -----------------------------------------------------------------

sub startHandlerPhase1
{
	my($expat, $element, %attribute) = @_;

	# Gain access to the attributes of the current element, and
	# via the top-of-stacks, to the parent's element and attributes.
	push(@element, $element);
	push(@attribute, \%attribute);

	if ($element =~ /^form$/i)
	{
		croak("Each form entity must have 'heading' and 'tocEntry' attributes\n")
			if (! defined($attribute{'heading'}) ||
				! defined($attribute{'tocEntry'}) );

		croak("Each form entity must have a unique 'formFileName' attribute\n")
			if (defined($formFileNameSeen{$attribute{'formFileName'} }) );

		croak("Each form entity must have a unique 'heading' attribute\n")
			if (defined($formHeadingSeen{$attribute{'heading'} }) );

		$formCountPhase1++;

		$formFileNameSeen{$attribute{'formFileName'} }	= $formCountPhase1;
		$formHeadingSeen{$attribute{'heading'} }		= $formCountPhase1;

		push(@tableOfContents, $attribute{'tocEntry'});
	}

	if ($element =~ /^radioGroup$/i)
	{
		croak("Each radioGroup entity must have 'name', 'prompt', and 'value' attributes\n")
			if (! defined($attribute{'name'}) ||
				! defined($attribute{'prompt'}) ||
				! defined($attribute{'value'}) );
	}

	if ($element =~ /^textField$/i)
	{
		croak("Each textField entity must have 'name', 'prompt', 'value' and 'size' attributes\n")
			if (! defined($attribute{'name'}) ||
				! defined($attribute{'prompt'}) ||
				! defined($attribute{'value'}) ||
				! defined($attribute{'size'}) );
	}

	if ($element =~ /^fileField$/i)
	{
		croak("Each fileField entity must have 'name', 'prompt' and 'size' attributes\n")
			if (! defined($attribute{'name'}) ||
				! defined($attribute{'prompt'}) ||
				! defined($attribute{'size'}) );
	}

	if ($element =~ /^(fileField|radioGroup|textField)$/i)
	{
		croak("Each fieldField, radioGroup & textField entity must have a unique 'name' attribute (per form)\n")
			if (defined($fieldNameSeen{$formCountPhase1}{$attribute{'name'} }) );

		$fieldNameSeen{$formCountPhase1}{$attribute{'name'} } = $formCountPhase1;
	}

	if ($element =~ /^scripts$/i)
	{
		croak("Each scripts entity must have a 'heading' attribute\n")
			if (! defined($attribute{'heading'}) );
	}

	if ($element =~ /^script$/i)
	{
		croak("Each script entity must have 'heading', 'type' and 'line' attributes\n")
			if (! defined($attribute{'heading'}) ||
				! defined($attribute{'type'}) ||
				! defined($attribute{'line1'}) );

		croak("Each script entity must have a unique 'heading' attribute (per form)\n")
			if (defined($scriptHeadingSeen{$formCountPhase1}{$attribute{'heading'} }) );

		croak("Each script entity's 'type' attribute must be 'local' or 'remote'\n")
			if ($attribute{'type'} !~ /^(local|remote)$/i);

		$scriptHeadingSeen{$formCountPhase1}{$attribute{'heading'} } = $formCountPhase1;
	}

	&pushIndent();

}	# End of startHandlerPhase1.

# -----------------------------------------------------------------

sub startHandlerPhase2
{
	my($expat, $element, %attribute) = @_;

	# Gain access to the attributes of the current element, and
	# via the top-of-stacks, to the parent's element and attributes.
	push(@element, $element);
	push(@attribute, \%attribute);

	if ($element =~ /^forms$/i)
	{
		$tableOfContents{'tocEntry'}	= (defined($attribute{'tocEntry'}) ?	$attribute{'tocEntry'} :	'Contents');
		$tableOfContents{'tocVisible'}	= (defined($attribute{'tocVisible'}) ?	$attribute{'tocVisible'} :	'True');
	}

	if ($element =~ /^form$/i)
	{
		$formCountPhase2++;

		my($author)								= (defined($attribute{'author'}) ? $attribute{'author'} : 'ron@savage.net.au');
		my($heading)							= $attribute{'heading'};

		$fieldName{$formCountPhase2}			= {};
		$$html{$formCountPhase2}				= [];
		$numberScripts{$formCountPhase2}		= 0;
		$script{$formCountPhase2}				= {};
		$scriptCount{$formCountPhase2}			= 0;
		$scriptHeadingMenu{$formCountPhase2}	= [];
		$scriptType{$formCountPhase2}			= {};

		my($startHtml)							=
			start_html({title => $heading, author => $author} );
		$startHtml								=
			start_html({title => $heading, author => $author,
			style => {src => $attribute{'css'} } } ) if (defined($attribute{'css'}) );

		# Output the Table of Contents.
		push(@{$$html{$formCountPhase2} }, header(), $startHtml, start_multipart_form(),
			'<TABLE WIDTH = "100%">');

		if ($tableOfContents{'tocVisible'} =~ /True/i)
		{
			push(@{$$html{$formCountPhase2} }, '<TR>', '<TD VALIGN = "Top">',
				'<TABLE>', '<THEAD>', '<TR>', '<TD>');

			if (defined($attribute{'css'}) )
			{
				push(@{$$html{$formCountPhase2} },
					p({class => 'TOC'}, $tableOfContents{'tocEntry'}) );
			}
			else
			{
				push(@{$$html{$formCountPhase2} }, $tableOfContents{'tocEntry'});
			}

			push(@{$$html{$formCountPhase2} }, '</TD>', '</TR>', '</THEAD>', '<TBODY>');

			my($page) = 0;

			for (@tableOfContents)
			{
				$page++;

				if (defined($attribute{'css'}) )
				{
					push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
#						p({class => 'TOC'}, $_),
						submit({class => 'TOC', name => $page, value => $_}),
						'</TD>', '</TR>');
				}
				else
				{
					push(@{$$html{$formCountPhase2} }, '<TR>', '<TD>',
#						$_,
						submit({name => $page, value => $_}),
						'</TD>', '</TR>');
				}
			}

			push(@{$$html{$formCountPhase2} }, '</TBODY>', '</TABLE>',
				'</TD>', '<TD>');
		}

		push(@{$$html{$formCountPhase2} }, '<TABLE>', '<THEAD>', '<TR>', '<TD>',
			h1($heading), '</TD>', '</TR>', '</THEAD>', '<TBODY>');
	}

	if ($element =~ /^scripts$/i)
	{
		$numberScripts{$formCountPhase2} = 1 if (defined($attribute{'numberScripts'}) &&
												($attribute{'numberScripts'} =~ /Yes/i) );
	}

	&pushIndent();

}	# End of startHandlerPhase2.

# -----------------------------------------------------------------

sub writeFile
{
	my($self, $fileName, $data) = @_;

	open(OUT, "> $fileName") || croak("Can't open($fileName): $!\n");
	print OUT join("\n", @{$data}), "\n";
	close(OUT);

}	# End of writeFile.

# -----------------------------------------------------------------

# Autoload methods go after =cut, and are processed by the autosplit program.

1;

__END__

=head1 NAME

C<CGI::Formalware> - Convert an XML file into a suite of CGI forms.

=head1 SYNOPSIS

In your browser, type: localhost/cgi-bin/x.pl

where x.pl contains nothing more than:

	#!perl -w
	use strict;
	use lib 'C:/Perl';
	use lib 'C:/Perl/Scripts/General';	# Ie $PERL5LIB.
	use CGI::Formalware;
	my($form) = CGI::Formalware -> new({form2file => 1, debug => 1});
	$form -> process();
	exit(0);

Upon starting, C<CGI::Formalware> asks for the name of your XML file, which
is assumed to be in cgi-bin/.

=head1 DESCRIPTION

To provide a type of repository for frequently used scripts, which can then be executed
locally or remotely (via Net::Telnet), by just entering a password (for remote scripts),
and clicking.

=head1 INSTALLATION

You install C<CGI::Formalware>, as you would install any perl module library,
by running these commands:

	perl Makefile.PL
	make
	make test
	make install

If you want to install a private copy of C<CGI::Formalware> in your home
directory, then you should try to produce the initial Makefile with
something like this command:

	perl Makefile.PL LIB=~/perl
		or
	perl Makefile.PL LIB=C:/Perl/Site/Lib

If, like me, you don't have permission to write man pages into unix system
directories, use:

	make pure_install

instead of make install. This option is secreted in the middle of p 414 of the
second edition of the dromedary book.

=head1 AUDIENCE

Webmasters.

=head1 SECURITY

None. Even worse, C<CGI::Formalware> is designed to circumvent a web server's
concept of what Apache calls DocumentRoot.

=head1 CONSTRUCTOR new

new takes either no parameters, or an anonymous hash. See the example above.
Keys and values recognized are:

=over 4

=item *

debug => 1 means turn on debugging. At the moment this opens and closes the
file CGI-Formalware.log, but does not write anything to it

=item *

form2file => 1 means output each form to a file, using the name given
by the form's formFileName attribute. The forms are written to cgi-bin/.
If the form has no such attribute, this option is ignored. See example below

=item *

timeScripts => 1 means report elapsed time at the end of each script's output

=back

=head1 HIGHLIGHTS

=over 4

=item *

Read an XML file, whose format is fixed, and generate a suite of CGI forms

=item *

A cascading style sheet can be specified for each form individually

=item *

A Table of Contents may appear on each form

=item *

Each form is more-or-less assumed to contain a list of scripts

=item *

Tokens in the XML correspond to a few functions available in Lincoln Stein's
CGI.pm. Available tokens are:

=over 4

=item *

fileField

	<fileField
		name		= 'fileName'
		prompt		= 'Filename: '
		size		= '60'
		override	= '0'
	/>

=item *

horizontalRule

	<horizontalRule />

=item *

paragraph

	<paragraph />

	<paragraph text = 'Output a comment' />

=item *

radioGroup

	<radioGroup
		name		= 'serverName'
		prompt		= 'Server name: '
		value		= 'Example|Simple|Test'
		columns		= '1'	# Optional. Defaults to '1'. Use a string, not a digit
	/>

=item *

textField

	<textField
		name		= 'username'
		prompt		= 'Username: '
		value		= ''
		size		= '15'
		override	= '0'
	/>

=back

Over time, more functions will be added.

=item *

A textField with the name 'password' is treated as a password field. Also,
the entity 'script' defines a Unix- or DOS-type batch file

=item *

These entities produce on-screen fields, or, in the case of the scripts, a
vertical array of radio buttons

=item *

So, to run a script you fill in whatever fields the script uses and then select
that script

=item *

Macros in the scripts, eg %fileName% are expanded with the current value of the
field whose name appears between the % signs

=item *

A script whose last line is 'ftp B<-n> B<-v>' is recognized and handled specially.
Your form must contain textFields called 'host', 'username' and 'password' and
'fileName'. A binary 'get' is performed. This will be made more flexible one day

=item *

Scripts have an attribute 'type', which can be 'local' or 'remote'.

Remote scripts are passed to Net::Telnet, on the assumption that you know what
you are doing. Your form must contain textFields called 'host', 'username' and
'password'

=back

=head1 NAVIGATION

Forms are linked with 'Previous form', 'Next form' buttons.

Any previously-entered textFields, except those whose name is 'password', are
remembered when you return to a form. This is very convenient.

The password values are zapped by CGI.pm, not by me. This is a security feature.
It means you can walk away from your system and not have someone gain automatic
access to a remote system.

=head1 CASCADING STYLE SHEETS

Each form entity may have a 'css' attribute, giving the name of the CSS file for
that form. These attribute values are like '/CGI-Formalware.css', which, under
Apache, means this value is prefixed with DocumentRoot. That is, the path to the
CSS is a URI, and will not be seen if in cgi-bin/.

The compulsory elements are: H1, H2 and P.TOC.

Herewith a sample:

	H1
	{
		font-size:			20pt;
		alignment:			center;
		color:				teal;
	}

	H2
	{
		font-size:			16pt;
		font-style:			italic;
		color:				maroon;
	}

	P.TOC
	{
		font-size:			12pt;
		color:				white;
		background-color:	blue;
	}

=head1 ENVIRONMENT VARIABLES

None.

=head1 INPUT DATA VALIDATION

These checks are performed:

=over 4

=item *

Each forms entity may have a 'tocEntry' attribute. If present, and if
the tocVisible attribute is 'true', then a Table of Contents is put on
each form, headed by this text. The default is 'Contents'

=item *

Each forms entity may have a 'tocVisible' attribute. If its value is 'True',
then a Table of Contents is put on each form, headed by the value of
'tocEntry'. The default is 'True'

=item *

Each form entity must have 'heading' and 'tocEntry' attributes

=item *

Each form entity must have a unique 'heading' attribute

=item *

Each form entity may have a unique 'formFileName' attribute. If present, then
this file name is used to output the form to a file if the constructor option
new({form2file => 1}) is used

=item *

Each fileField entity must have 'name', 'prompt', 'value' and 'size' attributes

=item *

Each textField entity must have 'name', 'prompt', 'value' and 'size' attributes

=item *

Each scripts entity must have a 'heading' attribute

=item *

Each script entity must have 'heading', 'type' and 'line' attributes

=item *

Each script entity must have a unique 'heading' attribute

=item *

Each script entity's 'type' attribute must be 'local' or 'remote'

=back

=head1 XML DTD

TBA.

=head1 XML FILE FORMAT

Herewith a sample:

	<forms
		tocEntry	= 'Forms'
		tocVisible	= 'True'
	>
	<form
		heading			= 'Unix Command Menu'
		tocEntry		= 'Unix menu'
		css				= '/CGI-Formalware.css'
		formFileName	= '1.html'
	>
		<horizontalRule />

		<radioGroup
			name	= 'host'
			prompt	= 'Host: '
			value	= 'bigBox|littleBox'
		/>

		<paragraph />

		<textField
			name		= 'username'
			prompt		= 'Username: '
			value		= ''
			size		= '15'
			override	= '0'
		/>

		<textField
			name		= 'password'
			prompt		= '  Password: '
			value		= ''
			size		= '15'
			override	= '0'
		/>

		<horizontalRule />

		<scripts
			heading			= 'Unix Scripts'
			numberScripts	= 'Yes'
		>
			<script
				heading		= 'Files in home directory'
				type		= 'remote'
				line1		= 'dir'
			/>
			<script
				heading		= 'Tags in repository'
				type		= 'remote'
				line1		= 'cd $M'
				line2		= 'getTags'
			/>
		</scripts>
	</form>

	<form
		heading		= 'DOS Command Menu'
		tocEntry	= 'DOS menu'
	>

		<horizontalRule />

		<radioGroup
			name	= 'host'
			prompt	= 'Host: '
			value	= 'bigBox|littleBox'
		/>

		<paragraph text = 'Enter a username and a password.' />

		<textField
			name		= 'username'
			prompt		= 'Username: '
			value		= ''
			size		= '15'
			override	= '0'
		/>

		<textField
			name		= 'password'
			prompt		= '  Password: '
			value		= ''
			size		= '15'
			override	= '0'
		/>

		<horizontalRule />

		<fileField
			name		= 'fileName'
			prompt		= 'Filename: '
			size		= '60'
			override	= '0'
		/>

		<horizontalRule />

		<scripts
			heading	= 'PC Scripts'
		>

			<script
				heading		= 'Files in root directory'
				type		= 'local'
				line1		= 'cd \'
				line2		= 'dir'
			/>
			<script
				heading		= 'FTP something somewhere'
				type		= 'local'
				line1		= 'ftp -n -v'
			/>
			<script
				heading		= 'Untar a file'
				type		= 'local'
				line1		= 'cd \'
				line2		= 'tar mxvzf %fileName%'
			/>
		</scripts>
	</form>
	</forms>

=head1 NESTED FORMS

Nope, I don't recognize them. Maybe one day...

=head1 AUTHOR

C<CGI::Formalware> was written by Ron Savage I<E<lt>ron@savage.net.auE<gt>>
in 1999.

Available from http://savage.net.au/Perl.html.

=head1 LICENCE

Australian copyright (c) 1999 Ron Savage.

	All Programs of mine are 'OSI Certified Open Source Software';
	you can redistribute them and/or modify them under the terms of
	The Artistic License, a copy of which is available at:
	http://www.opensource.org/licenses/index.html

=cut