package PerlDynamic;
use strict;
#use warnings;
use Carp;
use FileHandle;
use lib ".";
use Querier qw($col_delim);

#-----------------------------------------------#
# INITIAL SETUP											#
#-----------------------------------------------#
BEGIN 
{
	use Exporter();
	our($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
	
	$VERSION = sprintf "%d.%03d", q$Revision: 1.14 $ =~ /(\d+)/g;
	
	@ISA = qw(Exporter);
	@EXPORT = qw($session $ppages $linkpages $outlinePasteboard);
	%EXPORT_TAGS = ();
	
	# your exported package globals go here,
	# as well as any optionally exported functions
	@EXPORT_OK = qw(
		$row $value $pdq_status $datatype $rownum @fieldnames $queryname
		$nopdq $outlinePasteboard
	);	
}
our @EXPORT_OK;
our $session;
our $ppages;
our $linkpages;
our $outlinePasteboard;
our ($row, $value, $pdq_status, $datatype, $rownum, @fieldnames, $queryname, $nopdq);

#---------------------------------------------------------------------------#
# Source html documents are parsed by this script.  Where the special tag	#
# "perldynamic" is encountered, attribute values beginning with certain		#
# characters will be translated according to the following rules:			#
# $<name>	- refers to a scalar in the current namespace					#
# @<name>	- refers to an array in the current namespace					#
# %<name> 	- refers to a hash in the current namespace						#
# &<name>	- refers to a subroutine in the current namespace				#
# #<name>	- refers to a session (form) parameter set via CGI.pm to the	#
# $session object, and maintained via a caching mechanism like that offered	#
# by Cacher.pl																#
#---------------------------------------------------------------------------#

our $empty_field_text = '';
our $empty_text1 = 'None Supplied.';
our $empty_text2 = 'All Items.';
our $field_not_available = 'Not Yet Available.';
our $userflag;
$userflag = pack("C",183); 	# flags user added choices to select lists, a small dot
our $tok = '';
our %datehash = (
	'Y' => {
		label => 'Year',
		size  => 4,
	},
	'M' => {
		label => 'Mon',
		size => 2,
	},
	'D' => {
		label => 'Day',
		size  => 2,
	}
);

#---------------------------------------------------#
# file scope variables needed to make outlines work	#
#---------------------------------------------------#
our $outlinedivcounter = 0;
our $_openicon = '/images/ofolder.gif';	# default value
our $_closeicon = '/images/folder.gif'; 	# default value
our @_outlineExpand = ();
our $_cboxid;
our @_outlineIDary;
our $_expandParent;

#=======================================================

sub SetEmptyText1
{
	$empty_field_text = $empty_text1;
}

#=======================================================

sub SetEmptyText2
{
	$empty_field_text = $empty_text2;
}

#===================================================#

sub ClearEmptyText
{
	$empty_field_text = '';
}

#==================================================#
# 		Print the content of the html page,				#
# processing lines with 'perldynamic' to convert	#
# variables into their current values					#
# 1st parameter contains name of html input template#
# 2nd (optional) parameter contains where to print	#
# the HTML output.  STDOUT if omitted.					#
# Both input and output can be strings					#
#--------------------------------------------------#
sub printBody
{
	my ($htmlSource, $outputref) = @_;
	my @nestfiles 	= ();
	$session->param('htmlSource', $htmlSource);
	my $inputref;
	my $outputstring = '';
	
	$outputref = \*STDOUT unless $outputref;
	
	if ($htmlSource =~ /</)   # if a string containing tags...
	{
		$inputref = \$htmlSource;
	}
	else
	{
		$inputref = new FileHandle $htmlSource, "r";
		unless ($inputref)
		{
			&output($outputref,"Can't open $htmlSource: $!\n");
			return;
		}
	}
	if ($inputref)
	{
		my $recsep = $/;
		$/ = "<";	# beginning of tag

		while (1)
		{
			while ($tok = &getNextToken($inputref))
			{
				#---------------------------------------------------#
				# 			print if not a tag or a comment tag		#
				#---------------------------------------------------#
				if ( ($tok !~ /^</) || ($tok =~ /^<!/) )
				{	
					&output($outputref,$tok);
				}
				else
				{
					#---------------------------------------------------#
					# 	Close the header portion if get <BODY> tag		#
					#---------------------------------------------------#
#					&output($outputref,"</HEAD>\n") 
#						if $tok =~ /^<BODY|^<FRAME/i;
	
					#----------------------------------------------------------#
					# process nested INCLUDE/REWRITE files/strings to any depth#	#
					#----------------------------------------------------------#
					if ($tok =~ /(<INCLUDE|REWRITE) ([^\s">]+)/i)
					{
						my $target = $2;
						my $newname;
						
						#-----------------------------------------------#
						# save the current state of things on the stack	#
						#-----------------------------------------------#
						my %stack = ();
						$stack{recsep} 		= $/;
						$stack{inputref}	= $inputref;
						$stack{tagtype} 	= $1;
						$stack{outputref} 	= $outputref;
						
						#-----------------------------------------------#
						# targets can be perl variables...				#
						#-----------------------------------------------#
						if ($target =~ /^\$/)
						{
							my $tstr = evalInMain($target);
							$inputref = \$tstr;
						}
						#-----------------------------------------------#
						# ... or files (sometimes in session vars)		#
						#-----------------------------------------------#
						else
						{
							if ($target =~ /^\#/)
							{
								substqueryref(\$target);
								$target = evalInMain($target);
								$target .= ".html";
							}
							#-----------------------------------------------#
							# Check for file first in $ppages directory		#
							#-----------------------------------------------#
     						$newname = "$ppages/$target";
     						$inputref = new FileHandle "$newname", "r";
							#-----------------------------------------------#
							# If not found, check $linkpages directory		#
							#-----------------------------------------------#
							if (!$inputref)
							{
     							$newname = "$linkpages/$target";
	     						$inputref = new FileHandle "$newname", "r";
	     					}
     						unless ($inputref)
     						{
     							&output($outputref,qq/Can't find include file "$newname" in
     							either \$ppages: ($ppages) or \$linkpages ($linkpages): $!\n/);
     							return;
     						}
						}
						$/ = "<";	# beginning of tag
						
						if ($stack{tagtype} =~ /REWRITE/i) {
							#-----------------------------------------------#
							# redirect print output to a string, which		#
							# is then stored to the Cacher as a checkpoint	#
							# called $target under the current sessionnum.	#
							# The tagline is replaced with a program which  #
							# will retrieve the string from the Cacher.		#
							#-----------------------------------------------#
							my $ssn = $session->param('SessionNumber');
							$newname = 
								qq!./CachedHTML.cgi?SessionNumber=$ssn&HTMLString=$target!;
							$stack{target} = $target;
							$tok =~ s/$target/$newname/;
							$tok =~ s/REWRITE\s+//i;
							&output($outputref,$tok);
							$outputref = \$outputstring;
						}
						push(@nestfiles,\%stack);		
						if($target eq 'prevnextbuttons.sgml') {
							my $stuff = 0;
						}
					}
					#---------------------------------------------------#
					# dynamically substitute for tokens containing the	#
					# special 'perldynamic' identifier					#
					#---------------------------------------------------#
					elsif ($tok =~ /(\<pd|perldynamic)/i)
					{
						&processDynamicToken($tok, $inputref, $outputref);
					}
					else {
						&output($outputref,$tok);
					}
				}
			}
			undef $inputref;		# automatically closes the file if a reference to a file
			undef $outputref;
			#-----------------------------------------------------------#
			# process nested INCLUDE/REWRITE files to any depth, cont.	#
			#-----------------------------------------------------------#
			last if (!@nestfiles);

			#-----------------------------------------------#
			# 	restore current state from the stack		#
			#-----------------------------------------------#
			my $stackref = pop(@nestfiles);
			$inputref = $$stackref{inputref};
			$/ = $$stackref{recsep};
			my $tagtype = $$stackref{tagtype};
			$outputref = $$stackref{outputref};
			
			if ($tagtype =~ /REWRITE/i) {
				my $target = $$stackref{target};
				&Client::store_client_data_cp($target,$outputstring);	
			}
		}
		$/ = $recsep;
	}
}

#====================================================================

sub getNextToken
{
	my ($inputref) = @_;
	my $_tok = '';
	
	while (!length($_tok)) 
	{
		if (ref($inputref) eq 'SCALAR') 
		{
			if (!length($$inputref)) 
			{
				return undef;
			}
			if ($/ eq "<") 
			{
				($_tok,$$inputref) = split("<",$$inputref,2);
				$/ = ">";
			}
			else 
			{
				($_tok,$$inputref) = split(">",$$inputref,2);
				$_tok = "<" . $_tok . ">";
				$/ = "<";
			}
		}
		else  # ref($inputref) eq 'FileHandle'
		{
			if ($inputref->eof()) 
			{
				return undef;
			}
			$_tok = <$inputref>;

			if ($/ eq "<") 
			{
				chop $_tok;
				$/ = ">";
			}
			else 
			{
				$_tok = "<" . $_tok;
				$/ = "<";
			}
		}
	}	

	$_tok;
}

#====================================================================

sub processDynamicToken
{
	my ($tagline, $inputref, $outputref) = @_;
	my ($text, $val);
	#--------------------------------------------------#
	# 				remove "perldynamic" or "pd"				#
	#--------------------------------------------------#
	$tagline =~ s/perldynamic\s*//i;
	$tagline =~ s/\<pd\s*/\</i;

	# Replace "&amp;" with "&"
	$tagline =~ s/&amp;/&/g;
	# convert html entities &gt; and &lt;
	$tagline =~ s/&lt;/</g;
	$tagline =~ s/&gt;/>/g;

	my $attrs = parseTagline(\$tagline);	# returns ptr to hash
	#--------------------------------------------------#
	# 				ONCLICK processing							#
	#--------------------------------------------------#
	if ($tagline =~ /onclick='([^']+)'/i)
	{
		my $onclick = &processOnClick($1);
		$tagline =~ s/onclick='([^']+)'/onclick='$onclick'/;
	}
	elsif ($tagline =~ /onclick="([^"]+)"/i)
	{
		my $onclick = &processOnClick($1);
		$tagline =~ s/onclick="([^"]+)"/onclick="$onclick"/;
	}
	#--------------------------------------------------#
	# <IF=#$&> ... <ELSE>...<ENDIF> blocks					#
	# The <ELSE> is optional									#
	#--------------------------------------------------#
	if (exists($attrs->{if}))
	{
		my $pat = $attrs->{if};
		unless (processPattern($pat)) 
		{
			# skip til matching <ELSE or <ENDIF
			my @ifary = ('if');
			while (@ifary)
			{
				$tok = &getNextToken($inputref);
				SWITCH: 
				{
					$tok =~ /^(<ENDIF)|(<ELSE)/i && 
						do { pop(@ifary); last SWITCH; };
					$tok =~ /^<IF/i &&
						do { push(@ifary,'if'); last SWITCH; };
				}
			}
		}
	}
	if ($tagline =~ /^<ELSE/io)		# must be if, not elsif!! 
	{
		# can only get here if the prev. <IF tag was TRUE, so we skip
		# until the matching <ENDIF
		do 
		{
			$tok = &getNextToken($inputref);
		} while ($tok !~ /^<ENDIF/i);
	}
	elsif ($tagline =~ /^<ENDIF/io) 
	{
		# do nothing
	}

	#---------------------------------------------------#
	# <IFNOT=#$&> .... <ENDIF> blocks					#
	#---------------------------------------------------#
	if (my $pat=matchparam(\$tagline,'IFNOT','&#$')) {
		#-----------------------------------------------#
		# # references become query->reference			#
		#-----------------------------------------------#
		if ($pat =~ /^#/) {
			substqueryref(\$pat);
		}
		if (evalInMain($pat)) {
			do {
				$tok = &getNextToken($inputref);
			} while ($tok !~ /^<ENDIF/);
		}
	}

	#---------------------------------------------------#
	# 				OUTLINE tags						#
	# <OUTLINE perldynamic 								#
	#	source=(source hash or array)					#
	#	closeicon=(gif, jpg, etc)						#
	#	openicon=(gif, jpg, etc)						#
	#	checkboxname=name if checkboxes desired			#
	#	expandlevels=(0,2..4,6)	preexpand as indicated	#
	#	<terminal node html, which can include pd tags>	#
	#   (if checkboxes are present, and some are pre-	#
	#   selected, then the outline will expand as needed#
	#   to show the preselections)						#
	# </OUTLINE>										#
	#---------------------------------------------------#
	elsif ($tagline =~ /^<OUTLINE/i)
	{
		my $source = evalInMain($attrs->{source});
		my $cboxname;
		my $cboxid = '';
		
		if (ref($source) !~ /HASH|ARRAY/)
		{
			&output($outputref,
				"Error($tagline): expecting source=(source hash or array)");
			return;
		}
		
		if (exists($attrs->{checkboxname}))
		{
			$cboxname= $attrs->{checkboxname};
		}
		
		if (exists($attrs->{closeicon}))
		{
			$_closeicon = processPattern($attrs->{closeicon});
		}
		
		if (exists($attrs->{openicon}))
		{
			$_openicon = processPattern($attrs->{openicon});
		}
		
		if (exists($attrs->{expandlevels}))
		{
			@_outlineExpand = evalInMain($attrs->{expandlevels});
		}
		else
		{
			@_outlineExpand = ();
		}
		
		# get terminal html (the content template of the OUTLINE tag)
		my $terminalhtml;
		while (defined($tok))
		{
			$tok = &getNextToken($inputref);
			last if $tok =~ /<\/OUTLINE/i;
			$terminalhtml .= $tok;
		};
		&output($outputref,qq!
<DIV ID="Out${outlinedivcounter}">!);
		$outlinedivcounter = ($outlinedivcounter+1) & 0x7FF;
	
		#-------------------------------#
		# set global array containing 	#
		# selected checkbox values		#
		#-------------------------------#
		@_outlineIDary = $session->param($cboxname);
	
		my ($childex,$childhtml) = 
			&BuildOutlineHTML($source,$terminalhtml,0,$cboxname,$cboxid);
		&output($outputref,qq!
	$childhtml
</DIV>!);
	}
		
	#---------------------------------------------------#
	# 					DATE tags						#
	# <DATE perldynamic name=<nm> format=<fmt> 			#
	#	[readonly[ [value=$&#<val>]>					#
	# Formats: e.g. M/Y   M/D/Y  D-M-Y					#
	# if readonly is set, display is static, otherwise	#
	# <input type=text ...>								#
	# if value is set, takes value as specified, other- #
	# wise takes value as #<nm>							#
	#---------------------------------------------------#
	elsif ($tagline =~ /^<DATE/i)
	{
		my $name = $attrs->{name};
		my $format = 'M/Y';
		my $readonly = 0;
		my @overridevals = ();
		if (exists($attrs->{value}))
		{
			my $override = evalInMain($attrs->{value});
			@overridevals = split(/\D/,$override);
		}
		if (exists($attrs->{readonly}))
		{
			$readonly = 1;
		}
		if (exists($attrs->{format}))
		{
			$format = $attrs->{format};
			if ($format !~ /[MDYmdy](\W[MDYmdy]){0,2}/)
			{
				&output($outputref,"Error($tagline): expecting format=(e.g)M/D/Y");
				return;
			}
		}
		my @fary = split(/(\W)/,$format);
		my @vals = ();
		my @labels = ();
		my @sizes = ();
		my @svars = ();
		for (@fary)
		{
			if (/[MDYmdy]/)
			{
				my $uc = "\U$_";
				my $var = $datehash{$uc}->{label};
				my $svar = $name . '_' . $var;
				push(@vals,@overridevals ? shift(@overridevals) :
					($session->param($svar) ? $session->param($svar) : ''));
				push(@labels,$var);
				push(@sizes,$datehash{$uc}->{size});
				push(@svars,$svar);
			}
			else
			{
				push(@vals,$_);
			}
		}
		my $html = <<HTML;
		<table style='width:70px'>
			<tr>
HTML
		for (@labels)
		{
			$html .= <<HTML;
				<td align='center'><font size='1'>$_</font></td>
HTML
		}
		$html .= <<HTML;
			</tr>
			<tr>
HTML
		for (my $i=0; $i<@vals; )
		{
			my $size = shift(@sizes);
			my $svar = shift(@svars);
			my $str = $readonly ? 
				qq!
					$vals[$i]
				! :
				qq!
					<input size='$size' maxlength='$size' name='$svar' 
					value='$vals[$i]'/>$vals[$i+1]
				!;
			$html .= <<HTML;
				<td align='center'>
					$str
				</td>
HTML
			$i += 2;
		}
		$html .= <<HTML;
			</tr>
		</table>
HTML
		&output($outputref,$html);
	}						
	#---------------------------------------------------#
	# <STYLE=#$& VALUE=#$&>	blocks					    #
	#---------------------------------------------------#
	elsif ($tagline =~ /^<STYLE/)
	{
		my $styleparam = &matchparam(\$tagline, 'style', '');
		$styleparam = '$style_' . substr($styleparam, 1);
		my $style = evalInMain($styleparam);
		if ($@)
		{
			&output($outputref, "ERROR PROCESSING STYLE");
		}
		my $eval_value = &matchparam(\$tagline, 'value', '');
		if ($eval_value)
		{
			if ($eval_value =~ /^\#/)
			{
				substqueryref(\$eval_value);
			}
			if ($eval_value =~ /^\$/)
			{
				$value = evalInMain($eval_value);	# $value must be global
			}
			else
			{
				$value = $eval_value;	# $value must be global
			}
			if ($@)
			{
				&output($outputref,"ERROR PROCESSING STYLE VALUE PARAM");
			}
		}
		my $recsep = $/;
		&printBody($style,$outputref);
		$/ = $recsep;
	}
	#---------------------------------------------------#
	# <QUERY=#$&> .... </QUERY> blocks				    #
	#---------------------------------------------------#
	elsif ($pat=matchparam(\$tagline,'QUERY','&#$')) 
	{
		my $evalstring;
		#-----------------------------------------------#
		# # references become query->reference			#
		#-----------------------------------------------#
		local ($nopdq);
		if (matchparam(\$tagline, 'nopdq', '')) {
			$nopdq = 1;
		}
		my $block = '';
		do {
			$tok = &getNextToken($inputref);
			if ($tok !~ /^\<\/QUERY/i) {
				$block .= $tok;
			}
		} while ($tok !~ /^\<\/QUERY/i);
		$block =~ s/\<\/QUERY\>//i;
		my $datasource = matchparam(\$tagline, 'query', '');
		local $row = matchparam(\$tagline, 'row', '');
		if ($row =~ /^#/) {
			substqueryref(\$row);
			$row = evalInMain($row);
		}
		if ($session->param('specialAction') eq 'preserve')
		{
	  		my $recsep = $/;
 			&printBody($block,$outputref);
			$/ = $recsep;
			$session->delete('specialAction');
			return;
		}
		if ($datasource =~ /^##/) {
			$datasource = $session->param(substr($datasource, 2));
		}
		local $queryname = substr($datasource, 1);
		if ($datasource =~ /^#/) {
			substqueryref(\$datasource);
		}
		my @data = evalInMain($datasource);
		local $datatype = shift(@data);
		local (@fieldnames) = split($col_delim, shift(@data));
		local $rownum = 1;
		while (@data)
		{
			$pdq_status = '';
			my (@values) = split($col_delim, shift(@data));
			$evalstring = '';
			foreach my $field (@fieldnames)
			{
				$value = shift(@values);
				$value =~ s/\'/\\\'/g;
				$evalstring .= "\$$datatype" . "_$field = '$value'; ";
				$pdq_status = $value if $field eq "pdq_status";
			}
			evalInMain($evalstring);
			if ($@)
			{
				output($outputref,$@);
			}
			if ($pdq_status ne "delete" && $pdq_status ne "newdelete")
			{
				if (!$row || $row == $rownum) # Either show all rows or specific rownum
				{
			  		my $recsep = $/;
 		 			&printBody($block,$outputref);
  					$/ = $recsep;
  				}
  			}
  			$rownum++;
		}
		if ($row eq 'new')
		{
			foreach my $field (@fieldnames)
			{
				$evalstring .= "\$$datatype" . "_$field = ''; ";
			}
			evalInMain($evalstring);
			if ($@)
			{
				&output($outputref,$@);
			}
	  		my $recsep = $/;
 			&printBody($block,$outputref);
			$/ = $recsep;
		}
	}
	elsif ($tagline =~ /^<\/QUERY/) 
	{
		# do nothing
	}
	#---------------------------------------------------#
	# 			JAVASCRIPT Array initialization			#
	# <JSARRAY perldynamic name="name" values=&func		#
	# 													#
	#	if func returns array (v0, v1, v2 ...)			#											#
	# creates lines like the following:					#
	# name[0] = v0;										#
	# name[1] = v1;										#
	# name[2] = v2; ...									#
	#---------------------------------------------------#
	elsif ($tagline =~ /<JSARRAY/i)
	{
		my $name = 'foo';
		if ($pat=matchparam(\$tagline,'name','&$#'))
		{
			$name = processPattern($pat);
		}
		elsif ($pat=matchparam(\$tagline,'name',''))
		{
			$name = $pat;
		}
		
		my @values = ();
		if ($pat=matchparam(\$tagline,'value','&@#'))
		{
			@values = processPattern($pat);
		}
		
		for (my $i=0; $i<@values; $i++)
		{
			my $val = $values[$i];
			&output($outputref,"\n\t$name" . qq/[$i] = "$val";/);
		}
	}
	#---------------------------------------------------#
	# 			JAVASCRIPT JUMP TO ANCHOR				#
	# e.g. perldynamic window.location=&anchor;			#
	# 													#
	# &anchor will be replaced with e.g. "#Model"		#
	#---------------------------------------------------#
	elsif ($pat=matchparam(\$tagline,'window.location','&#')) 
	{
		$val = "window.location=" . '"#' . processPattern($pat) . '";';
		substparam(\$tagline,"window.location",'&#',$val);
		&output($outputref,$tagline);
	}
	#-----------------------------------------------------------#
	# 				TAGS OF TYPE SUBROUTINE									#
	# e.g.:																		#
	# <SUBROUTINE perldynamic value=&subname>							#
	#-----------------------------------------------------------#
	elsif ($tagline =~ /^<SUBROUTINE/i) 
	{
		if ($pat=matchparam(\$tagline,'value','&')) {
			evalInMain($pat) if $pat =~ /^&/;
		}
	}
	#-----------------------------------------------------------#
	#               TAGS OF TYPE TEXTOUT                        #
	# eg.:                                                      #
	# <TEXTOUT perldynamic value=#CompanyName                   #
	#-----------------------------------------------------------#
	elsif ($tagline =~ /^<TEXTOUT/i)
	{
		$text = processValueAttribute($attrs);
		
		if (display_text($text))
		{
			&output($outputref,$text);
		}
	}
	#-----------------------------------------------------------#
	#               TAGS OF TYPE BOXEDTEXT                      #
	# eg.:                                                      #
	# <BOXEDTEXT perldynamic value=#CompanyName position=right border=1
	#			default="None Supplied" label="Company Name:">  #
	#-----------------------------------------------------------#
	elsif ($tagline =~ /^<BOXEDTEXT/i)
	{
		$text = processValueAttribute($attrs);

		my ($label,$default) = "";
		my $position = "right";
		my $border = "1";
		my $fontsize = '';
		
		if ($pat = matchparam(\$tagline,'fontsize',''))
		{
			$fontsize = $pat;
		}
		if ($pat = matchparam(\$tagline,'position',''))
		{
			$position = $pat;
		}
		if ($pat = matchparam(\$tagline,'border',''))
		{
			$border = $pat;
		}
		if ($pat = matchparam(\$tagline,'default',''))
		{
			$default = $pat;
		}
		if ($pat = matchparam(\$tagline,'label',''))
		{
			$label = $pat;
		}

		if (display_text($text))
		{
			my $html = "";
			if ($text eq $empty_field_text)
			{
				# Do nothing.  I know, this is lame.
			}

			elsif ($position eq "bottom")
			{
				$html = "<br/><table border='$border'><tr><td>";
				$html .= $text;
				$html .= "</td></tr></table>";
			}
			elsif ($position eq "right")
			{
				$html .= "<table border='$border'><tr><td valign='top' align='left'>";
				$html .= $text;
				$html .= "</td></tr></table>";
			}
			&output($outputref,$html);
		}
	}
	#-----------------------------------------------------------#
	#               TAGS OF TYPE TITLEDTEXT                     #
	# eg.:                                                      #
	# <TITLEDTEXT perldynamic value=#CompanyName title=sometext>#															#
	#-----------------------------------------------------------#
	elsif ($tagline =~ /^<TITLEDTEXT/i)
	{
		$text = processValueAttribute($attrs);
		
		my $title = '';
		my $bold = 'TRUE';
		
		if ($pat = matchparam(\$tagline,'title',''))
		{
			$title = $pat;
		}
		if ($pat = matchparam(\$tagline,'bold',''))
		{
			$bold = $pat;
		}
		
		if (display_text($text))
		{
			my ($html) = "<table width='100%'>
						  <tr>
							<td valign='top' align='left' width='60%'>";
			if ($bold eq 'TRUE')
			{
				$html .= "<b>$title</b>";
			}
			else
			{
				$html .= $title;
			}
			$html .= "
						</td>
						<td valign='top' align='left' width='40%'>
							$text
						</td>
						</tr>
						</table>";
			&output($outputref,$html);
		}
	}
	#-----------------------------------------------------------#
	#               TAGS OF TYPE TITLEDPAR	                    #
	# eg.:                                                      #
	# <TITLEDPAR perldynamic value=#CompanyName title=sometext	#
	#	bold location=[side|bottom] fixedfont>					#
	#															#
	#   These tags are like TITLEDTEXT, but have bold off by 	#
	#   default, and can be specified to appear beneath the 	#
	#   title as well as at the side (location parameter)		#
	#-----------------------------------------------------------#
	elsif ($tagline =~ /^<TITLEDPAR/i)
	{
		$text = processValueAttribute($attrs);

		my $title = '';
		my $bold = 0;
		my $location = 'side';
		my $ffopentag = '';
		my $ffclosetag = '';
		
		$title = $attrs->{title} if exists($attrs->{title});
		$bold = 1 if exists($attrs->{bold});
		if (exists($attrs->{fixedfont}))
		{
			$ffopentag="<tt>";
			$ffclosetag="</tt>";
		}
			
		$location = $attrs->{location} if exists($attrs->{location});
		if (exists($attrs->{hyperlink}) and $text ne $empty_field_text)
		{
			my $hlink = $text;
			$hlink = 'http://' . $hlink if $hlink !~ /^http/;
			$text = "<a href='$hlink'>${text}</a>";
		}

		if (exists($attrs->{money}))
		{
			$text = formatAsMoney($text);
		}

		if (($text eq $empty_field_text) || ($text eq $field_not_available))
		{
			$location = 'side';
		}
		
		if (display_text($text))
		{
			my $html = <<HTML;
				<table width='100%'>
					<tr>
						<td valign='top' align='left' colspan='2'>
HTML
			if ($bold)
			{
				$html .= "<b>$title</b>";
			}
			else
			{
				$html .= $title;
			}
			if ($location eq 'side') 
			{
				$html .= <<HTML;
						</td>
						<td valign='top' align='right'>
 							$ffopentag$text$ffclosetag
						</td>
					</tr>
				</table>
HTML
			}
			else # ($location eq 'bottom')
			{
				$html .= <<HTML;
						</td>
					</tr>
					<tr>
						<td width="3%">&nbsp;</td>
						<td valign="top" align="left" width='100%'>
							<P align="left">
								$ffopentag$text$ffclosetag
							</P>
						</td>
					</tr>
				</table>
HTML
			}
			&output($outputref,$html);
		}
	}
	#-----------------------------------------------------------#
	#               TAGS OF TYPE TITLEDHASH	                    #
	# eg.:                                                      #
	# <TITLEDHASH perldynamic title="title" value=[%#]somehash>	#
	#															#
	#   These tags are like TITLEDPAR, but have bold off by 	#
	#   default, and indent the values under the keys of hash	#
	#-----------------------------------------------------------#
	elsif ($tagline =~ /^<TITLEDHASH/i)
	{
		$pat=matchparam(\$tagline,'value','%#');
		unless ($pat =~ /^[%#]/)
		{
			&output($outputref,"Error($tagline): expecting value=[%#]name");
			return;
		}
		
		my @ary = &processPattern($pat);
		my $title = '';
		my $bold = 0;
		my $location = 'bottom';
		
		if ($pat = matchparam(\$tagline,'title',''))
		{
			$title = $pat;
		}
		if ($pat = matchparam(\$tagline,'bold',''))
		{
			$bold = $pat;
		}
		if ($pat = matchparam(\$tagline,'location',''))
		{
			$location = $pat;
		}

		my $hsh = shift(@ary);
		if (keys (%$hsh))
		{
			my ($html) = <<HTML;

			<table width='100%'>
				<tr>
					<td valign='top' align='left' width='60%'>
HTML
			if ($bold eq 'TRUE')
			{
				$html .= "<b>$title</b>";
			}
			else
			{
				$html .= $title;
			}

			$html .= <<HTML;
					</td>
				</tr>
HTML
	
			foreach my $key (sort keys %$hsh)
			{
				$html .= <<HTML;
				<tr>
					<td valign='top' align='left' width='100%'>
						<u>$key</u>:
					</td>
				</tr>
HTML

				my $aref = $$hsh{$key};
				if (ref($aref) eq "ARRAY")
				{
					foreach my $val (sort @$aref)
					{
						$html .= <<HTML;
				<tr>
					<td valign='top' align='left' width='100%'>
						&nbsp;&nbsp;$val
					</td>
				</tr>
HTML
					}
				}
				elsif ($aref !~ /^\s*$/)
				{
					$html .= <<HTML;
				<tr>
					<td valign='top' align='right' width='100%'>
						$aref
					</td>
				</tr>
HTML
				}
			}
			$html .= <<HTML;
			</table>
HTML
			&output($outputref,$html);
		}
	}
	#---------------------------------------------------------------#
	# 				TAGS OF TYPE TEXTLIST							#
	# e.g.:															#
	# <input type=TEXTLIST perldynamic fontsize='1' columns='5'		#
	#	value=$getdata (or whatever) >								#
	#---------------------------------------------------------------#
	elsif (matchliteral(\$tagline,'type','TEXTLIST'))
	{
		my $columns = 1;
		my $fontsize = '';
		my $row_count = 1;
		
		#-----------------------------------------------#
		# 	set parameters
		#-----------------------------------------------#

		if ($pat=matchparam(\$tagline,'columns',''))
		{
			$columns = $pat ? $pat : 1; # protect division by 0 later
		}
		if ($pat = matchparam(\$tagline,'fontsize',''))
		{
			$fontsize = $pat;
		}
		if ($pat=matchparam(\$tagline,'value','@&#'))
		{
			my @ary = processPattern($pat);
			$row_count = int @ary/$columns;
			if (@ary % $columns > 0)
			{
				++$row_count;
			}

			my ($x, $y) = 0;
			my ($html) = "";
			for ($y = 0; $y < $row_count; $y++)
			{
				$html .= "<tr>";
				for ($x = 0; $x < $columns; $x++)
				{
					$html .= "<td valign='top' align='left'><font size='$fontsize'>$ary[$x*$row_count+$y]</font></td>";
				}
				$html .= "</tr>";
			}
			&output($outputref,$html);
		}
	}
	#-----------------------------------------------------------#
	# 				TAGS OF TYPE FRAME							#
	# e.g.														#
	#	<FRAME perldynamic src="$basedir/submitmain.cgi"		#
	#	name="submitmain" frameborder=1 scrolling=AUTO>			#
	# 															#
	# This becomes:												#
	#	<FRAME perldynamic src="/cgi-bin/submitmain.cgi"		#
	#	name="submitmain" frameborder=1 scrolling=AUTO>			#
	# 															#
	#-----------------------------------------------------------#
	elsif ($tagline =~ /<FRAME/i) 
	{
		if ($pat=matchparam(\$tagline,'src','')) {
			&processHRef(\$tagline,'src',$pat);
		}
		&output($outputref,$tagline);
	}
	#-----------------------------------------------------------#
	# 				TAGS OF TYPE BODY							#
	#-----------------------------------------------------------#
	elsif ($tagline =~ /<BODY/i) 
	{
		if ($pat=matchparam(\$tagline,'location.href','')) {
			&processHRef(\$tagline,'location.href',$pat);
		}
		&output($outputref,$tagline);
	}
	#-----------------------------------------------------------#
	# 				TAGS OF TYPE Type=Submit					#
	#-----------------------------------------------------------#
	elsif ($tagline =~ /type\s*=\s*(submit|button)/i)
	{
		if ($pat=matchparam(\$tagline,'document.location','')) {
			&processHRef(\$tagline,'document.location',$pat);
		}
	    if ($pat=matchparam(\$tagline,'value','#')) {
			my $val = processPattern($pat);
			substparam(\$tagline,"value",'#',qq/value="$val"/);
		}
		&output($outputref,$tagline);
	}
	#-----------------------------------------------------------#
	# 				TAGS OF TYPE FORM							#
	# e.g.:														#
	# <form name=fname method=post perldynamic \				#
	#	action=$baseprog#Anchor									#
	#															#
	# This becomes:												#
	# <form name=fname method=post \							#
	#	action="/cgi-bin/submitmain.cgi#Anchor"					#
	#-----------------------------------------------------------#
	elsif ($tagline =~ /^<form/i) 
	{
		if ($pat=matchparam(\$tagline,'action','')) {
			&processHRef(\$tagline,'action',$pat);
		}
		&output($outputref,$tagline);
	}
	#-----------------------------------------------------------#
	# 					HREF substitutions						#
	# e.g.:														#
	# <a perldynamic href="$baseprog#Submit Form Top">			# 											#
	#															#
	# This becomes:												#
	# <a href="/cgi-bin/submitmain.cgi#Submit Form Top">		#
	#-----------------------------------------------------------#
	elsif ($pat=matchparam(\$tagline,'href','')) 
	{
		&processHRef(\$tagline,'href',$pat);
		&output($outputref,$tagline);
	}
	#---------------------------------------------------#
	# 		TAGS OF TYPE TEXT, HIDDEN					#
	# e.g.: <input perldynamic type=text value=$company>#
	#---------------------------------------------------#
	elsif (matchliteral(\$tagline,'type','text') ||
	 	matchliteral(\$tagline,'type','hidden') ||
	 	matchliteral(\$tagline,'type','password'))
	{
		unless ($pat=matchparam(\$tagline,'value','$@%&#')) {
			&output($outputref,"Error($pat): expecting value=[$@%&#]name");
			return;
		}
		my @vals = ();
#		if (my $fieldname=matchparam(\$tagline,'name','')) {
#			if ($queryname) {
#				substparam(\$tagline,'name','', "name=pdq_$queryname" . "_" . $fieldname);
#			}
#		}
		#-----------------------------------------------#
		# 	hash references: -> key1=val1, key2=val2...	#
		#-----------------------------------------------#
		if ($pat =~ /^\%/) 
		{
			my %hsh = evalInMain($pat);
			my @lst = ();
			foreach my $key (sort keys %hsh) {
				push(@lst,"$key=" . $hsh{$key});
			}
			$val = "value=" . '"'  . join(", ", @lst) . '"' ;
		}
		else
		{
			@vals = processPattern($pat);
			#-----------------------------------------------------------#
			# if no vals yet defined, display blank, unless hidden		#
			#-----------------------------------------------------------#
			unless (@vals or matchliteral(\$tagline,'type','hidden')) {
				push(@vals,'');
			}
		}
		my $val = "value=" . '"' . join(", ", @vals) . '"' ;
		substparam(\$tagline,"value",'$@%&#',$val);
		&output($outputref,$tagline);
	}
	#---------------------------------------------------#
	# 				TAGS OF TYPE TEXTAREA				#
	# e.g.: <textarea perldynamic value=#comments 	\	#
	#	name=foo rows=nr cols=nc>						#
	#  </textarea>										#
	#---------------------------------------------------#
	elsif ($tagline =~ /<textarea/i)
	{
		$text = processValueAttribute($attrs);
		$text =~ s/<br>/\n/g;
		
		substparam(\$tagline,"value",'$@%&#','');
		&output($outputref,$tagline . $text);
	}
	#-----------------------------------------------------------#
	# 				TAGS OF TYPE CHECKBOX (STANDALONE)			#
	# e.g.:														#
	# <input type=checkbox perldynamic name=sessionvar			#
	# 	value="a choice" checked=#sessionvar>					#
	#-----------------------------------------------------------#
	elsif ($attrs->{type} eq 'checkbox') 
	{
		my $value;
		if (exists($attrs->{value}))
		{
			$value = processPattern($attrs->{value});
			my $val = "value=" . '"' . $value . '"';
			substparam(\$tagline,"value",'$&',$val);
		}
		if (exists($attrs->{checked}))
		{
			my $val = (grep(/$value/,processPattern($attrs->{checked}))) ?
				"checked" : "";
			substparam(\$tagline,"checked",'$&#',$val);
		}
		&output($outputref,$tagline);
	}
	#-----------------------------------------------------------#
	# 				TAGS OF TYPE RADIO (STANDALONE)				#
	# e.g.:														#
	# <input type=radio perldynamic name=sessionvar				#
	# 	value="a literal choice" checked=#sessionvar>			#
	#-----------------------------------------------------------#
	elsif (matchliteral(\$tagline,'type','radio')) 
	{
		my $value = matchparam(\$tagline,'value','');
		if ($pat=matchparam(\$tagline,'checked','$&#')) 
		{
			$val = (processPattern($pat) eq $value) ? "checked" : "";
			substparam(\$tagline,"checked",'$&#',$val);
		}
		&output($outputref,$tagline);
	}
	#---------------------------------------------------------------#
	# 				TAGS OF TYPE NEWCHECKBOX_GROUP					#
	# e.g.:															#
	# <input type=newcheckbox_group perldynamic 					#
	# name="$sessionvariable value=&queryroutine multiple 			#
	# columns=3 checked=#$sessionvariable							#
	#---------------------------------------------------------------#
	elsif (matchliteral(\$tagline,'type','newcheckbox_group')) 
	{
		my @selecteditems = ();
		my $onclick = '';
		my $linebreak = 'false';
		my $multiple = 'false';
		my $columns = 1;
		my $fontsize = '';
		my $nodatastr = '';
		my $groupname;
		#-----------------------------------------------#
		# 	interpolate 'selected' attribute, if any	#
		#-----------------------------------------------#
		if ($pat=matchparam(\$tagline,'checked','$&#')) {
			@selecteditems = processPattern($pat);
		}
		#-----------------------------------------------#
		# 	pass thru onclick JavaScript, if any		#
		#-----------------------------------------------#
		if ($tagline =~ /onclick="(.*)"/i) {
			$onclick = $1;
		}
		#-----------------------------------------------#
		# 	interpolate group name attribute, if any	#
		#-----------------------------------------------#
		if ($pat=matchparam(\$tagline,'name','')) {
			$groupname = $pat;
		}
		#-----------------------------------------------#
		# 	set other parameters
		#-----------------------------------------------#
		if ($tagline =~ /linebreak/i) {
			$linebreak = 'true';
		}
		if ($tagline =~ /multiple/i) {
			$multiple = 'true';
		}
		if ($pat=matchparam(\$tagline,'columns','')) {
			$columns = $pat;
			$columns = 1 if $columns < 1;
		}
		if ($pat=matchparam(\$tagline,'nodatastr','')) {
			$nodatastr = $pat;
		}
		#-----------------------------------------------#
		# 	fontsize parameter							#
		#-----------------------------------------------#
		if ($pat = matchparam(\$tagline,'fontsize','')) {
			$fontsize = $pat;
		}
		if ($pat=matchparam(\$tagline,'value','@&#')) {
			my @fullresults = processPattern($pat);
			#---------------------------------------------------#
			# winnow out blanks (not including the count)		#
			#---------------------------------------------------# 
			my @ary = grep { $_ !~ /^\s+\(\d+\)$/ } @fullresults;

			#---------------------------------------------------#
			# build table of specified columns.  Each column	#
			# consists of two cells:  a checkbox with name in	#
			# the first, and the count in the second			#
			#---------------------------------------------------#
			my $width = $columns * 250;
			$width = 600 if $width > 600;
			$width = 50  if $width < 50;
			my $str = <<HTML;
	<table width="$width" border="0" align='left'>
HTML
			my $col = 0;
			if (!@ary)
			{
				$str .= <<HTML;
		<td>
			$nodatastr
		</td>
HTML
			}
			else
			{
				while (@ary)
				{
					if ($col == 0)		# start new row
					{
						$str .= <<HTML;
	<tr>
HTML
					}
					my $item = shift(@ary);
					my ($name,$count) = split(/(\(\d+\)$)/,$item);
					$name =~ s/\s+$//;
					#---------------------------------------#
					# pretty up the name we show the user:	#
					# 1. suppress |Not Used					#
					# 2. add a space after each vert. bar.	#
					#---------------------------------------#
					my $dispname = $name;
					$dispname =~ s/\|Not Used//g;
					$dispname =~ s/\|/\| /g;
					my @checkary = grep /^\Q$name\E$/, @selecteditems;
					my $checked = @checkary ? 'checked="1"' : ''; 
					$str .= <<HTML;
		<td><input type='checkbox' name='$groupname' value="$name" $checked onclick="$onclick"></td>
		<td nowrap>
			<font face="Arial, Helvetica" size=1 text-decoration:none">
			<b>$dispname</b>
		</td>
		<td width=15>
			<font face="Arial, Helvetica" size=1 text-decoration:none">
			$count
		</td>
		<td width=15>&nbsp;</td>
HTML
					$col = ($col+1) % $columns;
				}
			}
			
			$str .= <<HTML;
	</tr>
	</table>
HTML

			&output($outputref,$str);
		}
	}
	#---------------------------------------------------------------#
	# 				TAGS OF TYPE CHECKBOX (GROUP)					#
	# e.g.:															#
	# <input type=checkbox_group perldynamic checked=$checked[0] \	#
	# name="ModelType" value=@check_array>Dynamic Checkbox Group	#
	#---------------------------------------------------------------#
	elsif (matchliteral(\$tagline,'type','checkbox_group')) 
	{
		my @selecteditems = ();
		my $onclick = '';
		my $linebreak = 0;
		my $columns = 1;
		my $width = '';
		my $fontsize = '';
		my ($labels,$groupname);
		#-----------------------------------------------#
		# 	interpolate 'selected' attribute, if any	#
		#-----------------------------------------------#
		if ($pat=matchparam(\$tagline,'checked','$&#')) {
			@selecteditems = processPattern($pat);
		}
		#-----------------------------------------------#
		# 	pass thru onclick JavaScript, if any		#
		#-----------------------------------------------#
		if ($tagline =~ /onclick="(.*)"/i) {
			$onclick = $1;
		}
		#-----------------------------------------------#
		# 	interpolate group name attribute, if any	#
		#-----------------------------------------------#
		if ($pat=matchparam(\$tagline,'name','')) {
			$groupname = $pat;
		}
		#-----------------------------------------------#
		# 	set other parameters
		#-----------------------------------------------#
		if ($tagline =~ /linebreak/i) {
			$linebreak = 'true';
		}
		if ($pat=matchparam(\$tagline,'columns','')) {
			$columns = $pat;
		}
		if ($pat=matchparam(\$tagline,'width','')) {
			$width = $pat;
		}
		if (exists($attrs->{labels}))
		{
			$pat = $attrs->{labels};
			if (ref($pat) eq 'HASH')
			{
				$labels = $pat;
			}
			else
			{
				$labels = evalInMain($pat);
			}
		}
		#-----------------------------------------------#
		# 	fontsize parameter							#
		#-----------------------------------------------#
		if ($pat = matchparam(\$tagline,'fontsize','')) {
			$fontsize = $pat;
		}
		if (exists($attrs->{value}))
		{
			$pat = $attrs->{value};
			my $aryptr;
			
			if (ref($pat) eq 'ARRAY')
			{
				$aryptr = $pat;
			}
			else
			{
				my @values = processPattern($pat);
				$aryptr = \@values;
			}
			#---------------------------------------------------#
			# reduce array result by removing trailing (count)	#
			#---------------------------------------------------# 
			grep { s/ \(\d+\)$// } @$aryptr;
			#---------------------------------------------------#
			# replace blank string with "Not Supplied"			#
			#---------------------------------------------------# 
			grep { s/^\s*$/Not Supplied/ } @$aryptr;
			
			my $str = $session->checkbox_group(-name=>$groupname,
				-values		=>	$aryptr,
				-default	=>	\@selecteditems,
				-linebreak	=>	$linebreak,
				-columns	=>	$columns,
				-fontsize	=>	$fontsize,
				-width		=>	$width,
				-onclick	=>	$onclick,
				-labels		=>	$labels,
			) if @$aryptr;

			# make sure there are quotes around parameters - note:
			# this regexp will only work for tags with one parameter
			# and well-formatted
			$str =~ s/(<[^>]*?=)([^\'\"]?[^\'\"\>]*[^\'\"]?)>/$1\"$2\">/gs;
			while($str =~ s/(<\S+( (\w+=[\'\"][^\'\"]*[\'\"])|(\w+(?=[\>\s])))* (\w+)(?=[\/\>\s]))/$1=\"\"/gs) {
				;
			}

			&output($outputref,$str);
		}
	}
	#-----------------------------------------------------------#
	# 				TAGS OF TYPE RADIO (GROUP)					#
	# e.g.:														#
	# <input type=radio_group perldynamic checked=#sessionvar	#
	# name=name value=@radio_array linebreak columns=$cols		#
	# width=$width fontsize=$fs onclick='jsfunc()'>				#
	#-----------------------------------------------------------#
	elsif (matchliteral(\$tagline,'type','radio_group')) 
	{
		my $selecteditem = '';
		my $onclick = '""';
		my $linebreak = 0;
		my $columns =1;
		my $fontsize = '';
		my %labels = ();
		my $width = '100%';
		my $style;
		my $groupname;
		#-----------------------------------------------#
		# 	interpolate 'selected' attribute, if any	#
		# If the selected attribute is in the form		#
		# id|value, where | is $col_delim, then we only	#
		# match on the id.								#
		#-----------------------------------------------#
		if ($pat=matchparam(\$tagline,'checked','$&#')) {
			$selecteditem = processPattern($pat);
			$selecteditem =~ s/$col_delim.*$//;
		}
		#-----------------------------------------------#
		# 	pass thru onclick JavaScript, if any		#
		#-----------------------------------------------#
		if ($tagline =~ /onclick="(.*)"/i) {
			$onclick = $1;
		}
		#-----------------------------------------------#
		# 	interpolate group name attribute, if any	#
		#-----------------------------------------------#
		if ($pat=matchparam(\$tagline,'name','')) {
			$groupname = $pat;
		}
		#-----------------------------------------------#
		# 	set other parameters
		#-----------------------------------------------#
		if ($tagline =~ /linebreak/i) {
			$linebreak = 1;
		}
		if ($pat=matchparam(\$tagline,'columns','')) {
			$columns = $pat;
		}
		if ($pat=matchparam(\$tagline,'width','')) {
			$width = $pat;
		}
		if ($pat=matchparam(\$tagline,'style','')) {
			$style = $pat;
		}
		my @values;
		if ($pat=matchparam(\$tagline,'value','@&#')) 
		{
			#-----------------------------------------------#
			# 	array of scalars:							#
			#-----------------------------------------------#
			@values = processPattern($pat);
		}
		#-----------------------------------------------#
		# 	labels: either explicitly passed in, or, if	#
		# the value array values have col_delim separat-#
		# ors, the left value will be considered the 	#
		# 'value' and the right value is the label		#										#
		#-----------------------------------------------#
		if ($pat = matchparam(\$tagline,'labels','&%')) 
		{
			%labels = processPattern($pat);
		}
		if (@values && $values[0] =~ /$col_delim/)
		{
			for (my $i=0; $i<@values; $i++)
			{
				my ($id,$label) = split($col_delim,$values[$i]);
				$values[$i] = $id;
				$labels{$id} = $label;
			}
		}
		#-----------------------------------------------#
		# 	fontsize parameter							#
		#-----------------------------------------------#
		if ($pat = matchparam(\$tagline,'fontsize','')) 
		{
			$fontsize = $pat;
		}
		if (@values)
		{
			my $str = $session->radio_group
			(
				-name=>$groupname,
				-values=>\@values,
				-default=>$selecteditem,
				-linebreak=>$linebreak,
				-columns=>$columns,
				-fontsize=>$fontsize,
				-onclick=>$onclick,
				-labels=>\%labels,
				-width=>$width
			);
			#-----------------------------------------------#
			# 	add in style, if present					#
			#-----------------------------------------------#
			$str =~ s/<TABLE/<TABLE style=$style/ if $style;
			&output($outputref,$str);
		}
	}
	#-----------------------------------------------------------#
	# 				TAGS OF TYPE RADIO_SELECT					#
	#															#
	# Dynamically built two-column table, with radio buttons in #
	# left column, and picklists in the right column			#
	#															#
	# e.g.:														#
	# <table border align='center'>								#
	# <tr><th>Platform<th>Model									#
	# <td><input type=radio_select perldynamic value=%Platforms #
	#  checked=#platform name=PlatformModel>Platforms<td>Models	#
	#-----------------------------------------------------------#
	elsif (matchliteral(\$tagline,'type','radio_select')) 
	{
		my $selecteditem = '';
		my $onclick = '';
		my $groupname = '';
		my $leafname = '';
		#-----------------------------------------------#
		# 	interpolate 'checked' attribute, if any	#
		#-----------------------------------------------#
		if ($pat=matchparam(\$tagline,'checked','$&#')) {
			$selecteditem = processPattern($pat);
		}
		#-----------------------------------------------#
		# 	pass thru onclick JavaScript, if any		#
		#-----------------------------------------------#
		if ($tagline =~ /onclick="(.*)"/i) {
			$onclick = $1;
		}
		#-----------------------------------------------#
		# 	pass thru group name attribute, if any		#
		#-----------------------------------------------#
		if ($pat=matchparam(\$tagline,'name','')) {
			($groupname,$leafname) = split('\|',$pat);
		}
		if ($pat=matchparam(\$tagline,'value','%')) 
		{
			#-----------------------------------------------#
			# 	hash of arrays								#
			#-----------------------------------------------#
			my %hsh = evalInMain($pat) if $pat =~ /^%/;
			foreach my $key (sort keys %hsh) 
			{
				my $keyvalue;
				my $sel = $key eq $selecteditem ? 'checked="1"' : '';
				&output($outputref,qq!
		<tr>
			<td>
				<input type='radio' name="$groupname" value="$key" 
					$sel/>$key
			</td>
!);
				$keyvalue = $key . '|' . $leafname;
				&output($outputref,qq!
			<td>
				<SELECT name="$keyvalue">
			</td>
!);
				foreach $val ( @{ $hsh{$key} } ) 
				{
					&output($outputref,qq!
					<OPTION value="$val">$val</OPTION>
!);
				}
				&output($outputref,qq!
				</SELECT>
!);
			}
		}
	}
 	#-----------------------------------------------------------#
 	# 				TAGS OF TYPE USER_VALUE_SELECTS				#
 	# e.g.:<USER_VALUE_SELECTS perldynamic                  \   #
 	#        GROUP=a:b:c LOADFUNCTION=z (repeat for each group) #
 	#-----------------------------------------------------------#
 	elsif ($tagline =~ /<USER_VALUE_SELECTS/i) 
 	{
 		# setup session info for this select
 		my $htmlSource = $session->param('htmlSource');
 		my $js = &::processUserValueSelects($htmlSource, $tagline);
 		&output($outputref, $js) if ($js);
 	}
	#-----------------------------------------------------------#
	# 				TAGS OF TYPE SELECT							#
	# e.g.:<SELECT NAME="mypopup" perldynamic 				\	#
	# value		=&Apps - don't use if addnewoption     		\	#
	# multiple size=3 										\	#
	# selected=#applications								\	#
	# addnewoption=	- allows user to enter new values		\   #
	# child=selectName - name of next select in hierarchy	\	#
	# loadfunction=getXXX - get data from database >        	# 
    # loadfunction is exclusive with child. 					#
    # both are used only with addnewoption.						#
	#-----------------------------------------------------------#
	elsif ($tagline =~ /<SELECT/i) 
	{
		my %selecteditems = ();
		my $noinstruction 	= 0;
		my $oneonly 		= 0;
		my $removecounts	= 0;
		my $addnewoption	= 0;
		my $value 			= '';
		my @dispary 		= ();
		#-----------------------------------------------#
		# 	interpolate 'selected' attribute, if any	#
		# If any selected attribute is in the form		#
		# id|value, where | is $col_delim, then we only	#
		# match on the id.								#
		#-----------------------------------------------#
		if ($pat=matchparam(\$tagline,'selected','$@&#')) 
		{
			my @vals = processPattern($pat);
			map {$_ =~ s/$col_delim.*$// } @vals;
			foreach my $val (@vals) {
				$selecteditems{$val} = 1;
			}
			substparam(\$tagline,"selected",'$&@#','');	# remove 'selected' attribute
		}
		#-----------------------------------------------#
		# 	first choice an instruction to user?		#
		#-----------------------------------------------#
		$noinstruction = 1 if $tagline =~ s/noinstruction//i;

		#-----------------------------------------------#
		# 	handle single/multiple selection			#
		#-----------------------------------------------#
		my $multiple = $tagline =~ /multiple/i;

		#-----------------------------------------------#
		# 	handle "one only" or "one at a time"		#
		#-----------------------------------------------#
		$oneonly = 1 if $tagline =~ s/oneonly//i;

		#-----------------------------------------------#
		# 	remove counts: trailing (\d+) if requested	#
		#-----------------------------------------------#
		$removecounts = 1 if $tagline =~ s/removecounts//i;

		#-----------------------------------------------#
		# 	addnewoption: allows user to add to list	#
		# syntax: addnewoption=sessionvariable			#
		#-----------------------------------------------#
		if ($tagline =~ /addnewoption/)
		{
			$addnewoption = 1;
			$tagline =~ s/addnewoption//;
		}
		#-----------------------------------------------#
		# 	interpolate 'value' attribute				#
		# 	list consists of array of scalars:			#
		#-----------------------------------------------#
		if ($pat=matchparam(\$tagline,'value','@&#')) 
		{
			@dispary = processPattern($pat);
			substparam(\$tagline,"value",'&@#','');	# remove 'value' attribute
		}
		
		if ($addnewoption)
		{
			# insert onchange event handler, before other one indicated
			# if any 
			my $selname = $1 if $tagline =~ /name=['"]?(\w+)/;
			&insertOnChangeHandler(\$tagline,
				qq!handleNewValueSelected(document.forms[0].$selname);new$selname()!);
		}

		&output($outputref,$tagline);	# output the <SELECT> tag
		
		#-----------------------------------------------#
		# 	start with "Select Multiple" or				#
		#	"Select One at a Time" unless noinstruction	#
		#-----------------------------------------------#
		unless ($noinstruction)
		{
			if (!@dispary) {
				&output($outputref,"<OPTION VALUE=''>No Sub-selection</OPTION>\n");
			}
			elsif ($multiple) {
				&output($outputref,"<OPTION VALUE=''>Select Multiple</OPTION>\n");
			}
			elsif ($oneonly) {
				&output($outputref,"<OPTION VALUE=''>Select One</OPTION>\n");
			}
			else {
				&output($outputref,"<OPTION VALUE=''>Select One at a Time</OPTION>\n");
			}
		}
		#-----------------------------------------------#
		#	substitute in html-friendly &amp; for &		#
		#-----------------------------------------------#
		map { $_ =~ s/&/&amp;/g } @dispary;
		
		#-----------------------------------------------#
		# 	Netscape requires at least one option in	#
		#	order to draw the list box at its specified	#
		#	width.										#
		#-----------------------------------------------#
		if ($noinstruction && !@dispary)
		{
			push (@dispary,'&nbsp;' x 60);
		}
		
		foreach my $dispval (@dispary) 
		{
			my ($optval, $count);
			
			if ($removecounts)
			{
				($optval,$count) = split(/(\(\d+\)$)/,$dispval);
				$optval =~ s/\s+$//;
			}
			#-----------------------------------------------#
			# Following is for cases where you have data in	#
			# the form 'id|readable_data', where '|' is 	#
			# replaced with $col_delim.  Then display 		#
			# readable_data and return id					#
			#-----------------------------------------------#
			elsif ($dispval =~ /$col_delim/)
			{
				($optval,$dispval) = split($col_delim,$dispval,2);
			}
			else
			{
				$optval = $dispval;
			}

			if (exists($selecteditems{$optval})) {
				&output($outputref,"<OPTION SELECTED='1' VALUE=\"$optval\">$dispval</OPTION>\n");
			}
			else {
				&output($outputref,"<OPTION VALUE=\"$optval\">$dispval</OPTION>\n");
			}
		}
		
		if ($addnewoption)
		{
			&output($outputref,qq!
			<OPTION style="color:red; font-weight:bold" VALUE='NewUserVal'>
				Add value not listed</OPTION>!);
		}
#		&output($outputref,"</SELECT>\n");
	}
	#----------------------------------------------------------------#
	# TAGS OF TYPE TABLE, EDIT_TABLE, UPDATE_TABLE, CHECKBOX_TABLE,  #
	#	RADIO_TABLE                                                   #
	# e.g.:														                 #
	#	<table border=1>															  #
	#	<tr><th>Order Date</th>													  #
	#		<th>Engagement ID</th>												  #
	#	<perldynamic type=update_table|edit_table|table|radio_table|  #
	#		checkbox_table name=Engagements OR "name1,name2|..."		  #
	#	[cbox=DeleteEngagement] value=array of hashes or vbar delim.  #
	#	strings																		  #
	#	[tdclass=CSS classid] objlabel=Engagement>						  #
	#	[hidecols=(0,2)]  -> don't display cols at these indices		  #
	#	[rowid =0 OR (0,...) -> pass these col values as the row 	  #
	#		number(s) for edits & deletes rather than array index		  #
	#	editlabel='Detail' -> defaults to 'Edit' if not set			  #
	#	<tr><td nowrap='true'>orderdate<td>money,$</tr>					  #
	#																					  #
	#	</table>																		  #
	#----------------------------------------------------------------#
	elsif ($attrs->{type} =~ /table$/i)
	{
		my $deleteName;
		my @formats;
		my @tds;
		
		my $tabletype = lc(processPattern($attrs->{type}));
		
		my $updatejsfunc;	# routine called to edit a row
		my $objlabel;		# label passed to editing routine
		
		unless (exists($attrs->{name}))
		{
			&output($outputref,"Error: expecting name=table_name");
			return;
		}
		my $tableName = $attrs->{name};
		my @checkedIDs;
		if ($tabletype =~ /(checkbox_table)|(radio_table)/)
		{
			@checkedIDs = $session->param($tableName);
		}
		
		$deleteName = $tableName if $tabletype eq 'edit_table';
		
		if ($tabletype eq 'update_table')
		{
			$deleteName = $attrs->{cbox} if exists($attrs->{cbox});
			unless (exists($attrs->{updatejsfunc}))
			{
				&output($outputref,"Error: expecting updatejsfunc=jscript function name");
				return;
			}
			$updatejsfunc = $attrs->{updatejsfunc};

			unless (exists($attrs->{objlabel}))
			{
				&output($outputref,"Error: expecting objlabel=name to show on OK button");
				return;
			}
			$objlabel = $attrs->{objlabel};
		}
		
		my $tdclass;
		if (my $pat=$attrs->{'tdclass'})
		{
			$tdclass = 'class="' . &processPattern($attrs->{tdclass}) . '"';
		}
		my @hidecols = ();
		if (my $pat=$attrs->{hidecols})
		{
			@hidecols = evalInMain($pat);
		}

		my $useRowID = 0;
		my @rowids;
		if (exists($attrs->{rowid}))
		{
			@rowids = evalInMain($attrs->{rowid});
			$useRowID = 1;
		}
		
		my $editlabel = 'Edit';
		if (exists($attrs->{editlabel}))
		{
			$editlabel = $attrs->{editlabel};
		}

		unless ($pat=$attrs->{value})
		{
			&output($outputref,"Error: expecting value=[$@&#]name");
			return;
		}
		#-----------------------------------------------#
		# Add <th> for the edit link if type=update_table
		# or for the radio buttons if type=radio_table	#
		#-----------------------------------------------#
		&output($outputref,qq!
		<th>&nbsp;</th>!) if $tabletype =~ /(radio|update)_table/i;
		#-----------------------------------------------#
		# Add <th> for the delete link if type=edit_table
		# or update_table								#
		#-----------------------------------------------#
		&output($outputref,qq!
		<th>&nbsp;</th>!) if length($deleteName);
		
		&output($outputref,qq!
	</tr>!);
		#-----------------------------------------------#
		# Read the next series of tags for keys of rows	#
		#-----------------------------------------------#
		my @keys = ();
		while (1) 
		{
			$tok = &getNextToken($inputref);
			$tok =~ s/^\s+//;	# remove leading, trailing white space
			$tok =~ s/\s+$//;
			
			next if $tok =~ /^<tr/i;					# <tr>
			last if $tok =~ /^<\/tr>$|^<\/table>$/i;	# </tr>, </table>

			# is it a td tag?
			if ($tok =~ /^<td(.*)>$/i)
			{
				push(@tds,$1);
			}
			else
			{
				my ($key,$fmt) = split(',',$tok);
				if ($key =~ /\w/)
				{
					push(@formats,$fmt);
					push(@keys,$key);
				}
			}
		}
		
		# splice out hidden @tds (in reverse order!)
		for (my $i=$#hidecols; $i>=0; $i--)
		{
			splice(@tds,$hidecols[$i],1);
		}
		
		#-----------------------------------------------#
		# The values must be one of:							#
		# [1] an array of strings, with column values 	#
		#		separated by "|"  OR								#
		# [2] a hash, with keys that are a superset of	#
		#		@keys.												#
		# Values may be array references, in which case #
		# 	they are listed, separated by <br>.				#
		# Values with $col_delim are assumed to be in	#
		# 	the form id|value (where | is $col_delim),	#
		# 	and the id is stripped off							#
		# Any value containing '@' is assumed to be		#
		#		email addresses, and will get a mailto:	#
		#		hyperlink.											#
		#-----------------------------------------------#
		my @ary = processPattern($pat);
		my $ix;	# need value after the loop is over
		for ($ix=0;$ix<@ary;$ix++)
		{
			my $row = $ary[$ix];
			my @vals = ();
			if (ref($row) eq 'HASH')
			{
				foreach my $key (@keys)
				{
					push(@vals, $$row{$key});
				}
			}
			else
			{	
				@vals = split('\|',$row);
				
				# discard everything up to the $col_delim
				map { $_ =~ s/^.*$col_delim// } @vals;
				
				# fill out @val with blanks, if short
				push(@vals,'') while @vals < @keys;
			}

			# apply special formatting, if any
			# note: array references within @vals not supported!
			&formatVals(\@vals,\@formats);
			
			my $rowidval = $useRowID ? 
				join(',',map($vals[$_],@rowids)) : $ix;
		
			my $checkstr = '';
			if (grep /$rowidval/,@checkedIDs)
			{
				$checkstr = 'checked="1"';
				$_expandParent |= 1;
			}
			
			# splice out hidden columns (in reverse order!)
			for (my $i=$#hidecols; $i>=0; $i--)
			{
				splice(@vals,$hidecols[$i],1);
			}
			
			if (@vals)
			{
				my $html = qq!
	<tr>!;

				for (my $i=0; $i<@vals; $i++)
				{
					my $val = $vals[$i];
					my $tdattrs = $tds[$i];
					my $anch = '';
					my $endanch = '';
					if ($val =~ /\@/)
					{
						$anch = qq!<a href='mailto:$val'>!;
						$endanch = qq!</a>!;
					}
					
					my $tdtag = &tdtag($val,$tdclass,$tdattrs);

					if (ref($val) eq 'ARRAY')
					{
						my $html;
						&tableizeArray($val,\$html);
						$val = $html;
					}
					#-----------------------------------------------------------#
					# add a checkbox to first column entry of checkbox or 		#
					# radio tables												#
					#-----------------------------------------------------------#
					if ($i == 0 && $tabletype =~ /(checkbox_table)|(radio_table)/)
					{
						my $_type = $tabletype;
						$_type =~ s/_table//;
						$val = qq!
			<input type='$_type' name='$tableName' class='OCB' value="$rowidval"
				id="$_cboxid,$ix" $checkstr>
			$val!;
					}

					$html .= qq!
		$tdtag $anch $val $endanch
		</td>!;
				}
				if ($tabletype eq 'update_table')
				{
					$html .= qq!
		<td $tdclass>
			<a href="Javascript:NoOp()" 
				onclick="$updatejsfunc('$objlabel','$tableName','$rowidval'); return false;">
				$editlabel</a>
		</td>!;
				}
				if (length($deleteName))
				{
					$html .= qq!
		<td $tdclass>
			<input type='checkbox' name='$deleteName' value='$rowidval'/>
			Delete
		</td>!;
				}
				$html .= qq!
	</tr>!;
				&output($outputref,$html);
			}
		}
		$_cboxid = $ix;		# return counter to outliner via _cboxid
		#-----------------------------------------------#
		# 			Read the </table> tag				#
		#-----------------------------------------------#
		while ($tok !~ /<\/table/i) {
			$tok = &getNextToken($inputref);
		}		
		&output($outputref,$tok);
	}
	#---------------------------------------------------------------#
	# 				TAGS OF TYPE SOURCE								#
	# e.g.:															#
	#---------------------------------------------------------------#
	elsif ($tagline =~ /^<SOURCE/i)
	{
		unless($pat=matchparam(\$tagline,'value',''))
		{
			&output($outputref,"Error($pat): expecting node=node_name");
			return;
		}

		my $html = '';

		if ($pat=matchparam(\$tagline,'value','@&#')) {
			my @reducedary = processPattern($pat);
			#---------------------------------------------------#
			# reduce array result by removing trailing (count)	#
			#---------------------------------------------------# 
			grep { s/ \(\d+\)$// } @reducedary;

			foreach(@reducedary) {
				$html .= "<SOURCE text='$_'></SOURCE>\n";
			}
		}

		&output($outputref,$html);
	}
	#-----------------------------------------------------------#
	# 				CDATA  SUBSTITUTIONS						#
	# (these remove the <> tag delimiters after substitution,	#
	# allowing even innerHTML DATA to be dynamically controlled)#
	#-----------------------------------------------------------#
	elsif ($tagline =~ /^<CDATA/i) 
	{
		if (exists ($attrs->{value})) 
		{
			my $val = processPattern($attrs->{value});
			$val =~ s#,#<br/>#g;
			$val =~ s#\n#<br/>#g;
			substparam(\$tagline,"value",'',$val);
			$tagline =~ s/<CDATA//;
			$tagline =~ s/>$//;
		} 
		&output($outputref,$tagline);
	}
	#-----------------------------------------------------------#
	# 				PRE  SUBSTITUTIONS							#
	#-----------------------------------------------------------#
	elsif ($tagline =~ /^<PRE/i) 
	{
		my $val='';
		if (exists ($attrs->{value})) 
		{
			$val = evalInMain($attrs->{value});
			substparam(\$tagline,"value",'#$&@%','');
		} 
		$tagline .= "$val</PRE>";
		&output($outputref,$tagline);
	}
	#-----------------------------------------------------------#
	# 				BARE subroutine SUBSTITUTIONS				#
	# e.g. perldynamic value=&totalRevenue						#
	#-----------------------------------------------------------#
	elsif ($pat=matchparam(\$tagline,'value','&')) 
	{
		my $val = processPattern($pat);
		substparam(\$tagline,"value",'&',$val);
		&output($outputref,$tagline);
	}
	#-----------------------------------------------------------#
	# 				BARE SESSION VARIABLE SUBSTITUTIONS			#
	# e.g. perldynamic value=#totalRevenue						#
	#-----------------------------------------------------------#
	elsif ($pat=matchparam(\$tagline,'value','#')) 
	{
		my @ary = processPattern($pat);
		substparam(\$tagline,"value",'#',"value='" .join(",",@ary) ."'");
		&output($outputref,$tagline);
	}
	#---------------------------------------------------------------#
	# 				TAGS OF TYPE MULTISELECT						#
	# e.g.:															#
	# <perldynamic input type=multiselect name=myinfo               #
	# value=#selectedvalues other=#othervalues                      #
	#---------------------------------------------------------------#
	elsif (matchliteral(\$tagline,'type','multiselect')) 
	{
		my $name 	= matchparam(\$tagline,'name','');
		my $other 	= matchparam(\$tagline, 'other', '#$&');
		my $value 	= matchparam(\$tagline, 'value', '#$&');
		my $size 	= matchparam(\$tagline, 'size', '');
		
		$size = 6 if (!$size);
		substqueryref(\$other) if ($other =~ /^#/);
		substqueryref(\$value) if ($value =~ /^#/);
		
		my $html = <<HTML;
                  <table cellpadding='0' cellspacing='0'>
                     <tr>
                        <td align='center'>
                           <select name="$name" size="$size" multiple>
HTML
		my @othervalues = evalInMain($other);
		my $maxlength = 0;
		for my $othervalue (@othervalues)
		{
			if ($maxlength < length $othervalue)
			{
				$maxlength = length $othervalue;
			} 
		}
		my ($n) = (($maxlength - 16)/2);
		$n = 13 if ($n < 13);		# Compute a minimum size to make things line up nicely

		my $selectvaluepad  = "-" x $n;
		my $defaultoption = $selectvaluepad . " Selected Values " . $selectvaluepad;

		my $defaultotheroption = $selectvaluepad . " Possible Values " . $selectvaluepad;
		my @values = evalInMain($value);

		# the next 'for' is because the selection list 'other' can change;
		# invalidating previously valid choices.
		# Moved this statement to put at top of listbox.
	    # Was after for loop previously.
	    
		$html .= ('<OPTION>' . $defaultoption);  
		for my $v (@values)
		{
			$html .= ('<OPTION>' . $v);
		}
		# we always have to print the widest option because html is brain dead
		# regarding widths of select lists.

		# $html .= ('<OPTION>' . $defaultoption);

		$html .= <<HTML;
                           </select>
                           <br>
                          <!--  <font size='-1'>Selected</font> -->
                        </td>
                        <td valign='top'>
                           <table>
                              <tr>
                                 <td>
                                    <input type='button' value="<<" onclick="moveIt(document.edit.$name\_other, document.edit.$name);"/>
                                 </td>
                              </tr>
                              <tr>
                                 <td>
                                    <input type='button' value=">>" onclick="moveIt(document.edit.$name, document.edit.$name\_other);"/>
                                 </td>
                              </tr>
                           </table>
                        </td>
                        <td align='center'>
                           <select name="$name\_other" size="$size" multiple>
HTML
        # Moved this statement to put at top of listbox.
        # Was after for loop previously.
        $html .= ('<OPTION>' . $defaultotheroption); 
        
		for my $othervalue (@othervalues)
		{
			$othervalue =~ s/\|/\\\|/;				# So that '|' works in the following grep
			if (!grep(/^$othervalue$/, @values))	# if it is not already selected
			{
				$othervalue =~ s/\\\|/\|/;			# Undo of previous grep
				$html .= ('<OPTION>' . $othervalue);
			}
		}
		# $html .= ('<OPTION>' . $defaultotheroption);
		$html .= '</select>';
		$html .= <<HTML;
                           <br>
                          <!--  <font size=-1>Other</font> -->
                        </td>
                     </tr>
                  </table>
HTML
		&output($outputref,$html);
	}
}

#====================================================================

sub matchliteral
{
	my ($sref,$static1,$static2) = @_;
	return $$sref =~ /$static1\s*=\s*['"]?$static2['"]?[\s>]/i;
}

#====================================================================

sub substliteral
{
	my ($sref,$static,$repl) = @_;
	return $$sref =~ s/$static\s*=\s*[^\s>]+/$repl/i;
}

#====================================================================

sub matchparam
{
	my ($sref,$static,$types) = @_;
	my $retval = 0;
	
	my ($lh,$rh) = split(/$static\s*=\s*/i,$$sref);
	return 0 if !defined($rh) or !length($rh);
	
	my $end_delim = ($rh =~ s/^"//) ? '[^"]' : 
		(($rh =~ s/^'//) ? "[^']" : '[^\s>]');
	
	if (length($types))
	{
		$types .= 'a-z_0-9\(';
		if ($rh =~ /(^[$types]$end_delim+)/i)
		{
			$retval = $1 ? $1 : '0e0';
		}
	}
	else
	{
		if ($rh =~ /^($end_delim+)/i)
		{
			$retval = $1 ? $1 : '0e0';
		}
	}
	$retval;
}

#====================================================================

sub substparam
{
	my ($sref,$static,$types,$repl) = @_;

	if (length($types)) {					# typed parameter
		$$sref =~ s/$static\s*=\s*([$types][^\s>]+)/$repl/i;
	}
	elsif ($$sref =~ /$static\s*=\s*"/) {	# quoted parameter
	    $$sref =~ s/$static\s*=\s*"([^"]+)"/$repl/i;
	}
	else {									# unquoted, untyped parameter
		$$sref =~ s/$static\s*=\s*([^\s>]+)/$repl/i;
	}
}

#---------------------------------------------------#
# Convert #paramname to $session->param('paramname')#
#---------------------------------------------------#
sub substqueryref
{
	my $sref = shift;
	$$sref =~ s/#(\w+)/\$session->param('$1')/g;
	
#	if (ref($$sref) eq 'ARRAY') {
	
}

#====================================================================

sub AdjustForEmptyField
{
	my $text = shift;
	if ($$text =~ /^\s*$/)
	{
		$$text = "$empty_field_text";
	}
}

#====================================================================

sub display_text
{
	my $text = shift;
	my $retval = 1;
	my $showblanks = length($session->param('show_blank_fields'));
	if	(!$showblanks)
	{
		if (($text eq $field_not_available) || ($text eq $empty_text1)) 
		{
			$retval = 0;
		}
	}
	return $retval;
}

#===================================================================#
# Evaluate patterns of the form [#$@%&]<value> to single or			#
# arrayed values, depending on context of caller					#
#===================================================================#
sub processPattern
{
	my $pat = shift;
	my @vals = ();
	
	#  "#" REFERENCES BECOME $session->param('REFERENCE')
	if ($pat =~ /#/)
	{
		substqueryref(\$pat);
		@vals = evalInMain($pat);
	}

	#	ARRAY REFERENCES: -> VAL1, VAL2, VAL3...
	elsif ($pat =~ /^['"]?\@/)
	{
		@vals = evalInMain($pat);
	}

	# HASH REFERENCES: -> KEY1=VAL1, KEY2=VAL2
	# return hash 'as is'
	elsif ($pat =~ /^['"]?\%/)
	{
		my %hsh = evalInMain($pat);
		push(@vals,\%hsh);
	}

	# SCALAR, SUB REFERENCES
	# evaluate in possibly two cascading stages, until
	# evaluation returns something other than a reference
	elsif ($pat =~ /^['"]?[\$\&]/)
	{
		my @tvals = evalInMain($pat);
#		@tvals = evalInMain($pat) if (!@tvals || !$tvals[0]);
		for (my $i=0; $i<@tvals; $i++) 
		{
			my $ref = ref($tvals[$i]);
			if ($ref eq 'ARRAY') 
			{
				push(@vals,@{$tvals[$i]});
			}
			else
			{
				push(@vals,$tvals[$i]);
			}
		}
	}
	else
	{
		push(@vals,$pat);
	}

	# REMOVE BLANK ENTRIES FROM MULTIPLES
	if (@vals)
	{
		my $index;
		for ($index = $#vals; $index>=0; $index--)
		{
			splice(@vals,$index,1) unless length($vals[$index]);
		}
	}

	return wantarray ? @vals : join(",",@vals);
}

#===========-=========================================================

sub processValueAttribute
{
	my ($attrs, $varname) = @_;
	my ($pat, $text);
	my @vals;
	
	$varname = 'value' if !length($varname);
	
	if (exists($attrs->{$varname}))
	{
		$pat = $attrs->{$varname};
	
		# HASH REFERENCES: -> KEY1=VAL1, KEY2=VAL2
		if ($pat =~ /^\%/)
		{
			my %hsh = evalInMain($pat);
			foreach my $key (sort keys %hsh)
			{
				push(@vals,"$key=" . $hsh{$key});
			}
		}
		else 
		{
			@vals = processPattern($pat);
		}
	}
	else
	{
		# IF NO VALS YET DEFINED, DISPLAY BLANK
		push(@vals,'');
	}

	$text = join("<br/>", @vals);
	$text =~ s/\|Not Used//g;
	$text =~ s/ \| Not Used//g;
	AdjustForEmptyField(\$text);
	
	return $text;
}

#====================================================================

sub processHRef
{
	#---------------------------------------------------#
	# we expect the structure of the href in $pat to be	#
	#	URL[?p1=v1[&p2=v2]...][#anchor]					#
	# in other words, the URL comes first, followed by 	#
	# parameters, if any,								#
	# followed by an optional internal anchor			#
	#					OR								#
	# src=&subroutine									#
	#---------------------------------------------------#
	my ($sref,$static,$pat) = @_;
	my ($term,$val);
	my $anchor = undef;
	
	# pull out possible 'mailto:' and put back after substitution
	my $mailto = '';
	$mailto = $1 if $$sref =~ /(mailto:)/i;	

	# subroutine or session var:
	if (my $_pat = &matchparam($sref,$static,'#&'))
	{
		if ($_pat =~ /^[&]/)
		{
			my $url = evalInMain($_pat);
			substparam($sref,$static,'&',qq/$static=$mailto/ . $url);
			return;
		}
		elsif ($_pat =~ /^#/)
		{			
			substqueryref(\$_pat);
			my $url = evalInMain($_pat);
			# remove any embedded HTML tags, such as <span>
			$url =~ s/<.*?>//g;
			if($url eq '') {
				$url = "''";
			}
			substparam($sref,$static,'#',qq/$static=$mailto/ . $url);
			return;
		}
	}
	
	# explicit url:
	# split off the optional anchor at the end, if it exists
	if ($pat =~ /[^=]#(.+)$/) {
		$anchor = $1;
		if ($anchor =~ /^#/)
		{			
			substqueryref(\$anchor);
			$anchor = evalInMain($anchor);
		}
		$pat =~ s/([^=])#.+$/$1/;
	}
	
	my ($url,$params) = split(/\?/,$pat);

	$val = "$static=" . '"';

	# handle dynamic tags in url
	my (@terms) = split(/(\/)/,$url);
	foreach $term (@terms) {
		if ($term =~ /^[\$&]/) {
			$val .= evalInMain($term);
		}
		else {
			$val .= $term;
		}
	}

	# handle dynamic tags in params
	if (length($params)) {
		$val .= "?";
		my (@terms) = split(/&/,$params);
		while (1) {
			$term = shift(@terms);
			my ($key,$kval) = split(/=/,$term);
			$val .= "$key=";
			if ($kval =~ /^\$/) {
				$val .= evalInMain($kval);
			}
			elsif ($kval =~ /^#/) {
				substqueryref(\$kval);
				$val .= evalInMain($kval);
			}
			else {
				$val .= $kval;
			}
			last unless (@terms);
			$val .= "&";
		}
	}

	# handle dynamic tags in anchor
	if ($anchor) {
		$val .= "#";
		if ($anchor =~ /^[\$&]/) {
			$val .= evalInMain($anchor);
		}
		else {
			$val .= $anchor;
		}
	}

	$val .= '"';
	substparam($sref,$static,'',$val);
}

#====================================================================

sub formState
{
	my $i;
	my $params = $session->query_string;
	my @pary = split("&",$params);
	for ($i=0; $i<@pary;) {
		if ($pary[$i] =~ /^(SaveState|NextBODY)/) {
			splice(@pary,$i,1);
		}
		else {
			$i++;
		}
	}
	return join("&",@pary);
}

#====================================================================

sub output
{
	my ($outputref,$string) = @_;
	
	#--------------------------------#
	# decode < and > codes in tags	#
	#--------------------------------#
	$string =~ s/&lt;/</g;
	$string =~ s/&gt;/>/g;

	if (ref($outputref) eq 'SCALAR')
	{
		$$outputref .= $string;
	}
	else {	# ref($outputref) eq 'GLOB'
#		print STDOUT $string;
		print $outputref $string;
	}
}

#====================================================================

sub insertOnChangeHandler
{
	my ($tagref, $handler) = @_;
	# e.g. (\$tagline,"handleNewValueSelected(this)");
	
	# existing handler takes form of 
	#	onchange="funcname(paramlist);"
	# where paramlist and trailing semicolon are optional
	my $existinghandler = $$tagref =~ /onchange=/i;
	if ($existinghandler)
	{
		$$tagref =~ s/(onchange=['"])/$1$handler; /i;
	}
	else
	{
		$$tagref =~ s/>$/ onchange="$handler">/;
	}
}

#====================================================================

sub tdtag
{
	my ($val,$tdclass,$inlineattrs) = @_;
	my $tdtag = $val =~ /$userflag$/ ? 
		qq!<td $tdclass style="color:blue" $inlineattrs>! : 
		qq!<td $tdclass $inlineattrs>!;
	$tdtag;
}

#====================================================================

sub processOnClick
{
	my $action = shift;
	$action =~ s/&&/_AND_/g;		# preserve javascript &&
	my @words = split(/(\W)/,$action);
	for (my $i=$#words; $i>=0; $i--)
	{
		if ($words[$i] =~ /[\@\#\$\%\&]/)
		{
			my $arg = $words[$i] . $words[$i+1];
			my $val = evalInMain($arg);
			splice(@words,$i,2,$val);
		}
	}
	$action = join("",@words);
	$action =~ s/_AND_/&&/g;
	return $action;
}

#====================================================================

sub evalInMain
{
	my $arg = shift;
	# convert perl vars to main package syntax (eg. $x => $::x)
	$arg =~ s/^([@#\$%&])([^:])/$1::$2/ unless $arg =~ /^\$session->/;
	
	return eval($arg);
}

#====================================================================

sub parseTagline
{
	my $lineptr = shift;
	
	# split on '..' ".." (..) < > and word boundaries
	my @tokens = split(/('[^']*?'|"[^"]*?"|\([^\)]*?\)|\b|<|>)/,$$lineptr);
	
	# remove empty tokens (but keep whitespace ones!)
	my @words = grep { $_ !~ /^$/ } @tokens;
	pop(@words);	# remove ending '>', we don't process it
	shift(@words); # remove leading '<', we don't process it

	my %hash = ();
#	my @attrs = ();	# debugging aid only

	my $str = '';
	while (@words)
	{
		my $word = shift(@words);
		
		if ($word =~ /^\s*$/)		# blank space
		{
			if (length($str))
			{
				my ($key,$val) = split('=',$str,2);
				
				# lowercase key
				$key =~ tr/A-Z/a-z/;
				
				# remove outer quotes, if any
				$val =~ s/^'(.*)'$/$1/;
				$val =~ s/^"(.*)"$/$1/;
				
				$hash{$key} = length($val) ? $val : 1;
#				push(@attrs,"$key=" . $hash{$key});
			}
			$str = '';
		}
		else
		{
			$str .= $word;
		}
	}

	# handle last word
	if (length($str))
	{
		my ($key,$val) = split('=',$str,2);
		# lowercase key
		$key =~ tr/A-Z/a-z/;
		
		# remove outer quotes, if any
		$val =~ s/^'(.*)'$/$1/;
		$val =~ s/^"(.*)"$/$1/;
		
		$hash{$key} = length($val) ? $val : 1;
#		push(@attrs,"$key=" . $hash{$key});
	}
	return \%hash;
}

#====================================================================

sub formatAsDecimal   
# comma every 3 left of decimal
# negative numbers red in ()
{
	my ($text,$precision) = @_;
	my $width = $precision + 5;
	my $precText = sprintf("%${width}.${precision}f",$text);
	my ($int, $dec) = split(/\./,$precText);
	my @ary = split("",$int);
	# find position of first nonblank in @ary
	my $nb;
	for ($nb=0; $nb<@ary; $nb++)
	{
		last if $ary[$nb] =~ /\d/;
	}
	for (my $i=$#ary-2; $i>$nb; $i-=3)
	{
		splice(@ary,$i,0,',');
	}
	$int = join("",@ary);
	$int .= '.' . $dec if length($dec);
	$int = "<SPAN style='color:red'>($int)</SPAN>" if $text =~ /^\s*-/;
	return $int;
}

#====================================================================

sub formatAsMoney   
# $ in front, comma every 3 left of decimal
# negative numbers red in ()
{
	my $text = shift;
	my ($int, $dec) = split(/\./,$text);
	my @ary = grep (/\d/, split("",$int));
	for (my $i=$#ary-2; $i>0; $i-=3)
	{
		splice(@ary,$i,0,',');
	}
	$int = join("",@ary);
	$int .= '.' . $dec if length($dec);
	$int = '$' . $int if length($int);
	$int = "<SPAN style='color:red'>($int)</SPAN>" if $text =~ /^\s*-/;
	return $int;
}

#====================================================================

sub formatVals   # pass in array of vals, formats by reference.
# returns valarray changed if formatting is supplied
{
	my ($vals,$fmts) = @_;
	
	for (my $i=0; $i<@$vals; $i++)
	{
		my $fmt = $$fmts[$i];
	
	 	SWITCH:
	 	{
	 		$fmt eq '$' && do {$$vals[$i] =  &formatAsMoney($$vals[$i]); };
	 		$fmt =~ /^D(\d+)/ && do {$$vals[$i] =  &formatAsDecimal($$vals[$i],$1); };
	 		
	 		#default:
	 	}
	 }
}
	
#====================================================================

sub BuildOutlineHTML
{
	my ($source,$terminalhtml,$depth,$cboxname,$cboxid) = @_;
	my $depthstr = '&nbsp;&nbsp;' x $depth;

	# return values: 
	my $expandParent = 0;		# expand parent if true
	my $html;					# string containing html for all children
	
	if (ref($source) eq 'HASH')
	{
		my $cboxctr = 1;
		foreach my $key (sort (keys %$source))
		{
			#---------------------------------------#
			#    		TERMINAL NODES				#
			# 1. any that aren't hashes	OR			#
			# 2. any that have key of _terminalnodes#
			#---------------------------------------#
			if (($key eq '_terminalnodes') or
				((ref($source->{$key}) ne 'HASH')
		 		)
	 		   )	
			{
				$outlinePasteboard = $source->{$key};
			
				&output(\$html,qq!
	<table style="width:200">
		<tr>
			<td>$depthstr</td>
			<td>!);			
				my $recsep = $/;
				$_expandParent = 0;		# can be set during &printBody below
				$_cboxid = $cboxid; 	# temp copy to file global for printBody
				&printBody($terminalhtml,\$html);
				$cboxctr = $_cboxid;	# get back counter from same global
				$expandParent |= $_expandParent;
				$/ = $recsep;
				&output(\$html,qq!
			</td>
		</tr>
	</table>!);
			}
			#---------------------------------------#
			#    		NON-TERMINAL NODES			#
			# 1. any that are hashes				#
			#---------------------------------------#
			else
			{
				my $dispkey = $key;
				my $icon;
				my $id;
				my $checkstr = '';
				my $display;
				my $expand = grep /^$depth$/, @_outlineExpand;

				my $cboxidstr = length($cboxid) ? "$cboxid,$cboxctr" : $cboxctr;
				$cboxctr++;

				#---------------------------#
				# recurse to next level		#
				#---------------------------#
				my ($childex,$childhtml) = 
				&BuildOutlineHTML($source->{$key},$terminalhtml,$depth+1,
					$cboxname,$cboxidstr);

				$expand |= $childex;
				$expandParent |= $expand;
		
				if ($key =~ /$col_delim/)
				{
					($id,$dispkey) = split($col_delim,$key);
					if (grep /$id/, @_outlineIDary)
					{
						$checkstr = 'checked="1"';
						$expandParent |= 1;
					}
				}

				if ($expand)
				{
					$icon = $_openicon;
					$display = '';
				}
				else
				{
					$icon = $_closeicon;
					$display = 'display:None';
				}
		
				my $cboxtoken = length($cboxname) ?
					qq!
	<input type=checkbox name="$cboxname" class="OCB" value="$id" 
		id="$cboxidstr" $checkstr>! : '';
	
				&output(\$html,qq!
	$depthstr
	$cboxtoken
	<IMG SRC="$icon" ID="Out${outlinedivcounter}" 
		CLASS="Outline" STYLE="cursor: hand" WIDTH="16" HEIGHT="16">
	$dispkey
	<BR>
	<DIV ID="Out${outlinedivcounter}d" 
		 STYLE="$display; position:relative; left:+10px">!);
			
				$outlinedivcounter = ($outlinedivcounter+1) & 0x7FF;
		
				&output(\$html,qq!
		$childhtml
	</DIV>!);
			}

		}
	}
	elsif (ref($source) eq 'ARRAY')
	{
		# not supported yet
	}
	return ($expandParent,$html);
}

#====================================================================

sub tableizeArray
{
	my ($val,$outputref) = @_;

	die "ref($val) not 'ARRAY'" unless ref($val) eq 'ARRAY';
	$::_arrayRef = $val;
	
	my $sample = $$val[0];	# use first row to create output template $tdstr
	my $tdstr;
	if ($sample =~ /\|/)
	{
		$tdstr = $sample;
		$tdstr =~ s/\|/<td>/g;
	}
	else
	{
		$tdstr = 'foo';
	}

	my $html = qq!
<table style='width:100px'>
<tr>
<perldynamic type='table' tdclass='contentTD'
	name='tableizedArray' value='\$::_arrayRef'
	hidecols=(0)>
<tr><td>$tdstr</tr>
</table>!;

	my $recsep = $/;
	&printBody($html,$outputref);
	$/ = $recsep;
}

1;