LoadHtml

 view release on metacpan or  search on metacpan

lib/LoadHtml.pm  view on Meta::CPAN

Generates today's date (default format is "mm/dd/yy" if DBD::Sprite is installed and the "to_char" function from that library is available, otherwise, the format is: scalar(localtime($mtime).

    <!FILEDATE> (or <!FILEDATE:>replace this standalone default text<!/FILEDATE>)

    <!FILEDATE="yyyy-mm-dd"> (or <!FILEDATE="mm/yyyy":>replace this standalone default text<!/FILEDATE>)

Generates the last-modified date/time of the template file (default format is "mm/dd/yy" if DBD::Sprite is installed and the "to_char" function from that library is available, otherwise, the format is: scalar(localtime($mtime).

 V). User-callable Functions (Details):

    &loadhtml($htmlfile, @args)

Main function to read/process a specified template file / url ($htmlfile) and prints out the resulting html page to STDOUT. @args represents a list of values. Each argument value replaces any occurrance of the corresponding parameter number (ie. ":1"...

You can also convert programs that use Template::Toolkit by changing:

    $template_object->process($template_file, $template_hashref);

to:

    &loadhtml($template_file, %{$template_hashref});

    &loadhtml($htmlfile, @args);

is equivalent to:

    print &buildhtml($htmlfile, @args);

    my $html = &buildhtml($htmlfile, @args);

Same as loadhtml, except returns the generated webpage as a string instead of writing it to STDOUT;

    print &dohtml($htmlstring, @args);

    my $html = &dohtml($htmlstring, @args);

Same as buildhtml, except processes a input string instead of a template file or url.

    &AllowEvals(1|0);

Toggles whether or not embedded Perl variables and expressions are performed, namely the <!PERL> and <EVAL> constructs and Perl variables in the format: "<!:$variable>".
Default is 0.

    &set_poc($str);

Sets the string to replace the special "<POCS>" construct. Default is to ignore this tag. If called without a string or an empty string, the string is set to "your website administrator".

    &SetRegices(%optionshash);

Sets special control options. The currently defined options (with their default values) are: -hashes => 0, -CGIScript => 0, -includes => 1, -embeds => 0, -loops => 1, -numbers => 1, -pocs => 0, -perls => 0)

These options allow speeding up processing when turned off (not needed).

    -hashes: Allows the <!HASH> tag sto be processed if on, otherwise ignored.

    -CGIScript: Causes s special hidden form variable called "CGIScript" to be added at
the bottom of the first form with the value set to "$ENV{SCRIPT_NAME}" if on, otherwise not added.

    -includes: Allows the <!INCLUDE> tags to be processed if on, otherwise ignored.

    -embeds: Allows the <!EMBED> tags to be processed if on, otherwise ignored.

    -loops: Allows the <!LOOP> tags to be processed if on, otherwise ignored.

    -numbers: Allows the classic numeric parameter (":1", ":2", etc.) tags to be processed if on, otherwise ignored.

    -pocs: Allows the <!POC> tags to be processed if on, otherwise ignored.

    -perls: Allows the <!PERL> tags to be processed if on, otherwise ignored.

&SetListSeperator($separator_string);

Sets the separator string to be used if an array-reference is passed to a parameter that appears outside of a loop (where a scalar value is expected) Such values are automatically converted to a string of values ala Perl's "join()" function. The defa...

    &SetHtmlHome($htmlhome, $roothtmlhome, $hrefhtmlhome, $hrefcase);

This allows certain embedded links within a document to be "converted" for proper handling. Relative links refer to a different path when the document is loaded via CGI/LoadHTML than then they are loaded directly as urls by a browser, for example, th...

$htmlhome - specifies the URL path to append to relative links in SRC=, HREF=, CL=, HT=, GROUND=, and window.open() arguments.

$roothtmlhome specifies the filesystem path to append to relative file names in <INCLUDE> tags.

$hrefhtmlhome - similar to $htmlhome, but only applies to HREF= links, if it is necessary to redirect them to a different path, ie. a cgi-script for pre-processing. If both $hrefhtmlhome and $htmlhome are specified and non-empty, the former will over...

$hrefcase - used to limit the substitutions of $htmlhome and $hrefhtmlhome to specific links. It can be set to 'l' (Lower-case links only), left undefined for all links, or set to anything else for Upper-case links only. For purposes of case, a "Lowe...

    &loadhtml_package($package_name);

Change the default package LoadHTML uses for embedded Perl variables. Default is main. Best way to set this is to call "loadhtml_package(__PACKAGE__);".
 VI). Minimum System Requirements:

    * 1) Any system supporting Perl and CGI.
    * 2) Perl, v. 5.003 or better.
    * 3) Perl's "LWP" module (not an absolute requirement, but VERY useful) and required prerequesites:  MIME-Base64 (MIME), HTML-Parser (HTML), libnet (Net), MD5, and Data-Dumper (Data).  All of these are available for download from CPAN. 

=head1 METHODS

=over 4

=item B<loadhtml_package>([package_name])

Change the default package LoadHTML uses for embedded Perl variables. Default is I<main>. Best way to set this is to call "loadhtml_package(__PACKAGE__);".

=item B<loadhtml>(template_file, @arguments)

Main function to read/process a specified template file / url ($htmlfile) and prints out the resulting html page to STDOUT. @args represents a list of values. Each argument value replaces any occurrance of the corresponding parameter number (ie. ":1"...

=item $html = B<buildhtml>([package_name])

Same as loadhtml, except returns the generated webpage as a string instead of writing it to STDOUT;

=item $html = B<dohtml>(html_datastring, @arguments)

Same as buildhtml, except reads it's template data from a string variable instead of a file.

=item B<AllowEvals>(1|0)

Toggles whether or not embedded Perl variables and expressions are performed, namely the <!PERL> and <EVAL> constructs and Perl variables in the format: "<!:$variable>".
Default is 0.

=item B<set_poc>(string)

Sets the string to replace the special "<POCS>" construct. Default is to ignore this tag. If called without a string or an empty string, the string is set to "your website administrator".

=item B<SetListSeperator>(separator_string)

Sets the separator string to be used if an array-reference is passed to a parameter that appears outside of a loop (where a scalar value is expected) Such values are automatically converted to a string of values ala Perl's "join()" function.  
Default:  I<", ">.

=item B<SetRegices>(%optionshash)

Sets special control options. The currently defined options (with their default values) are: -hashes => 0, -CGIScript => 0, -includes => 1, -embeds => 0, -loops => 1, -numbers => 1, -pocs => 0, -perls => 0)
These options allow speeding up processing when turned off (not needed).

=over 4

B<-hashes>:  Allows the <!HASH> tag sto be processed if on, otherwise ignored.

B<-CGIScript>:  Causes s special hidden form variable called "CGIScript" to be added at
the bottom of the first form with the value set to "$ENV{SCRIPT_NAME}" if on, otherwise not added.

B<-includes>:  Allows the <!INCLUDE> tags to be processed if on, otherwise ignored.

B<-embeds>:  Allows the <!EMBED> tags to be processed if on, otherwise ignored.

B<-loops>:  Allows the <!LOOP> tags to be processed if on, otherwise ignored.

B<-numbers>:  Allows the classic numeric parameter (":1", ":2", etc.) tags to be processed if on, otherwise ignored.

B<-pocs>:  Allows the <!POC> tags to be processed if on, otherwise ignored.

B<-perls>:  Allows the <!PERL> tags to be processed if on, otherwise ignored.

=back

=item B<SetHtmlHome>(htmlhome, roothtmlhome, hrefhtmlhome, hrefcase)

This allows certain embedded links within a document to be "converted" for proper handling. Relative links refer to a different path when the document is loaded via CGI/LoadHTML than then they are loaded directly as urls by a browser, for example, th...

=over 4

B<htmlhome> - specifies the URL path to append to relative links in SRC=, HREF=, CL=, HT=, GROUND=, and window.open() arguments.

B<roothtmlhome> - specifies the filesystem path to append to relative file names in <INCLUDE> tags.

B<hrefhtmlhome> - similar to $htmlhome, but only applies to HREF= links, if it is necessary to redirect them to a different path, ie. a cgi-script for pre-processing. If both B<hrefhtmlhome> and B<htmlhome> are specified and non-empty, the former wil...

B<hrefcase> - used to limit the substitutions of B<htmlhome> and B<hrefhtmlhome> to specific links. It can be set to 'l' (Lower-case links only), left undefined for all links, or set to anything else for Upper-case links only. For purposes of case, a...

=back

=back

=head1 AUTHOR

Jim Turner, C<< <https://metacpan.org/author/TURNERJW> >>.

=head1 COPYRIGHT

Copyright (c) 1996-2018 Jim Turner C<< <mailto:turnerjw784@yahoo.com> >>.
All rights reserved.  

This program is free software; you can redistribute 
it and/or modify it under the same terms as Perl itself.

=cut

package LoadHtml;

#use lib '/home1/people/turnerj';

use strict;
#no strict 'refs';
#use vars (qw(@ISA @EXPORT $useLWP $err $rtnTime $VERSION));
use vars (qw(@ISA @EXPORT $err $VERSION));

our $VERSION = '7.10';

require Exporter;
#use LWP::Simple;
my $useLWP = 0;
my $haveTime2fmtstr = 0;
eval 'use  LWP::Simple; $useLWP = 1;';
#use Socket;

lib/LoadHtml.pm  view on Meta::CPAN

	if ($selpart =~ s/\:(\w+)\s*>$//o)
	{
		$selpart .= '>';
		my $selparm = $1;
		my ($opspart2);
		$opspart =~ s/SELECTED//gio;
		while ($opspart =~ s/(\s*)<OPTION(?:(\s+VALUE\s*\=\s*)([\"\'])([^\3]*?)\3[^>]*)?\s*\>([^<]*)//is)
		{
			$opspart2 .= &makaselop($selparm,$1,$2,$4,$5);
		}
		$opspart = $opspart2;
	}
	$rtn = $selpart . $opspart . $endpart;
	return ($rtn);
};

sub fetchinclude
{
	my $parms = shift;
	my ($fidurl) = shift;
	my ($modhtmlflag) = shift;
	my $tag = shift;
	my %includeparms;    #NEXT 6 ADDED 20030206 TO SUPPORT PARAMETERIZED INCLUDES!
	while (@_)
	{
		$_ = shift;
		$_ =~ s/\-//o;
		$includeparms{$_} = shift;
	}

	my ($html,$rtn);

	#$fidurl =~ s/\:(\w+)/&makaswap($1)/eg;      #JWT 05/19/1999
	$fidurl =~ s/^\"//o;          #JWT 5 NEXT LINES ADDED 1999/08/31.
	$fidurl =~ s/\"\s*$//o;
	$fidurl =~ s/\:\{?(\w+)\}?/&makaswap($parms,$1)/eg;
	if (defined($roothtmlhome) && $roothtmlhome =~ /\S/o)
	{
		$fidurl =~ s#^(?!(/|\w+\:))#$roothtmlhome/$1#ig;
	}
	#$fidurl =~ s/\:\{?(\w+)\}?/&makaswap($parms,$1)/eg;  #JWT 20010703: MOVED ABOVE PREV. IF
	if (open(HTMLIN,$fidurl))
	{
		$html = (<HTMLIN>);
		close HTMLIN;
	}
	else
	{
		$html = LWP::Simple::get($fidurl)  if ($useLWP);
		unless(defined($html) && $html =~ /\S/o)
		{
			$rtn = &html_error(">Could not include html page: \"$fidurl\"!");
			return ($rtn);
		}
	}
	if ($tag)  #ADDED 20060117 TO ALLOW PARTIAL FILE INCLUDES BASED ON TAGS.
	{
		$html =~ s/^.*\<\!\-\-\s+BEGIN\s+$tag\s*\-\-\>//is or $html = '';
		$html =~ s#\<\!\-\-\s+END\s+$tag\s*\-\-\>.*$##is;
	}
	#$rtn = &modhtml(\$html, %parms);  #CHGD. 20010720 TO HANDLE EMBEDS.
	#return ($rtn);
	#return $modhtmlflag ? &modhtml(\$html, %parms) : $html;  #CHD 20030206 TO SUPPORT PARAMETERIZED INCLUDES.
	return $modhtmlflag ? &modhtml(\$html, {%{$parms}, %includeparms}) : $html;
};

sub doeval
{
	my ($expn) = shift;
	my ($fid) = shift;
	if ($fid)
	{
		my ($dfltexpn) = $expn;
		$fid =~ s/^\s+//o;
		$fid =~ s/^.*\=\s*//o;
		$fid =~ s/[\"\']//go;
		$fid =~ s/\s+$//o;
		if (open(HTMLIN,$fid))
		{
			my @expns = (<HTMLIN>);
			$expn = join('', @expns);
			close HTMLIN;
		}
		else
		{
			$expn = LWP::Simple::get($fid)  if ($useLWP);
			unless (defined($expn) && $expn =~ /\S/o)
			{
				$expn = $dfltexpn;
				return (&html_error("Could not load embedded perl file: \"$fid\"!"))
				unless ($dfltexpn =~ /\S/o);
			}
		}
	}
	$expn =~ s/^\s*<!--//o;   #STRIP OFF ANY HTML COMMENT TAGS.
	$expn =~ s/-->\s*$//o;
	return ('')  if ($expn =~ /\`/o);   #DON'T ALLOW GRAVS!
#	return ('')  if ($expn =~ /\Wsystem\W/o);   #DON'T ALLOW SYSTEM CALLS - THIS NOT GOOD WAY TO DETECT!

	$expn =~ s/\&gt/>/go;	
	$expn =~ s/\&lt/</go;	

	$expn = 'package htmlpage; ' . $expn;
	my $x = eval "$expn";
	$x = "Invalid Perl Expression - returned $@"  unless (defined $x);
	return ($x);
};

sub dovar
{
	my $var = shift;
	my $two = shift;
	$two =~ s/^=//o;
	#$var = substr($var,0,1) . 'main::' . substr($var,1)  unless ($var =~ /\:\:/);
	#PREV. LINE CHANGED 2 NEXT LINE 20000920 TO ALLOW EVALS IN ASP!
	#$var = substr($var,0,1) . $calling_package . '::' . substr($var,1)  unless ($var =~ /\:\:/);
	#PREV. LINE CHGD. TO NEXT 20031006 TO FIX "${$VAR}...".
	$var =~ s/\$(\w)/\$$calling_package\:\:$1/g;
	my $one = eval $var;
	$one = $two  unless ($one);
	return $one;

lib/LoadHtml.pm  view on Meta::CPAN

#$one =~ s/default=\"(.*?)\"//i;
#$one =~ s/default=\"(.*?)\"//i;
#if ($one =~ s/(default|defaultsel)=\"(.*?)\"//i)  #20000505: CHGD 2 NEXT 2 LINES 2 MAKE QUOTES OPTIONAL!
	if (($one =~ s/(default|defaultsel)\s*=\s*\"(.*?)\"//io) 
			|| ($one =~ s/(default|defaultsel)\s*=\s*(\:?\S+)//io))  #20000505: CHGD 2 NEXT LINE 2 MAKE QUOTES OPTIONAL!
	{
		$dflttype = $1;
		$dfltval = $2;
		$dflttype =~ tr/a-z/A-Z/;
		#$dfltval =~ s/\:(\w+)/
		$dfltval =~ s/\:\{?(\w+)\}?/
				if (ref($parms->{$1}) eq 'ARRAY')
				{
					'(?:'.join('|',@{$parms->{$1}}).')'
				}
				else
				{
					quotemeta($parms->{$1})
				}
		/eg;
	}
#$one =~ s/\:(\w+)/$parms->{$1}/g;
	$one =~ s/\:\{?(\w+)\}?/$parms->{$1}/g;      #JWT 05/24/1999
	$rtn = "<SELECT $one>\n";
	$one = $dfltval;
	for (my $i=0;$i<=$#{$options->{sel}};$i++)
	{
		#if (${$options->{value}}[$i] =~ /^\Q${one}\E$/)
#		if (${($dfltindex{$dflttype}.'_options')}[$i] =~ /^${one}$/)
		if (${$options->{$dfltindex{$dflttype}}}[$i] =~ /^${one}$/)
		{
			$rtn .= "<OPTION SELECTED VALUE=\"${$options->{value}}[$i]\">${$options->{sel}}[$i]</OPTION>\n";
		}
		else
		{
			$rtn .= "<OPTION VALUE=\"${$options->{value}}[$i]\">${$options->{sel}}[$i]</OPTION>\n";
		}
	}
	$rtn .= '</SELECT>';
	return ($rtn);
};

sub modhtml
{
	my ($html, $parms) = @_;
	my ($v);

	#NOW FOR THE REAL MAGIC (FROM ANCIENT EGYPTIAN TABLETS)!...

	if ($cfgOps{loops})
	{
		while ($$html =~ s#<\!LOOP(\S*)\s+(.*?)>\s*(.*?)<\!/LOOP\1>\s*#&makaloop($parms, $2,$3,$1)#eis) {};
	}

	$$html =~ s#<\!HASH\s+(\w*?)\s*>(.*?)<\!\/HASH[^>]*>\s*#&buildahash($1,$2)#eigs
			if ($cfgOps{hashes});

	$$html =~ s#</FORM>#<INPUT NAME="CGIScript" TYPE=HIDDEN VALUE="$ENV{'SCRIPT_NAME'}">\n</FORM>#i 
			if ($cfgOps{CGIScript});

	#$$html =~ s#<\!INCLUDE\s+(.*?)>\s*#&fetchinclude($parms, $1)#eigs  #CHGD. TO NEXT 20010720 TO SUPPORT EMBEDS.
	$$html =~ s!<\!INCLUDE\s+(.*?)>\s*!
		my $one = $1;
		$one =~ s/^\"//o;
		$one =~ s/\"\s*$//o;
		my $tag = 0;
		$tag = $1  if ($one =~ s/\:(\w+)//o);  #ADDED 20060117 TO ALLOW PARTIAL FILE INCLUDES BASED ON TAGS.
		if ($one =~ s/\((.*)\)\s*$//)
		{
			my $includeparms = $1;
			$includeparms =~ s/\=/\=\>/go;
			eval "&fetchinclude($parms, \"$one\", 1, $tag, $includeparms)";
		}
		else
		{
			&fetchinclude($parms, $one, 1, $tag);
		}
	!eigs  if ($cfgOps{includes});

	if ($cfgOps{pocs})
	{
		$$html =~ s#<\!POC:>(.*?)<\!/POC>#$poc#ig  if ($cfgOps{pocs});  #20000606
		$$html =~ s#<\!POC>#$poc#ig  if ($cfgOps{pocs});
	}

	$$html =~ s#\<\!FILEDATE([^\>]*?)\:\>.*?\<\!\/FILEDATE\>#&filedate($parms,$1,0)#eig;  #20020327
	$$html =~ s#\<\!FILEDATE([^\>]*)\>#&filedate($parms,$1,0)#eig;  #20020327
	$$html =~ s#\<\!TODAY([^\>]*?)\:\>.*?\<\!\/TODAY\>#&filedate($parms,$1,1)#eig;  #20020327
	$$html =~ s#\<\!TODAY([^\>]*)\>#&filedate($parms,$1,1)#eig;  #20020327

	while ($$html =~ s#<\!IF(\S*)\s+(.*?)>\s*(.*?)<\!/IF\1>\s*#&makanif($parms, $2,$3,$1)#eigs) {};

	$$html =~ s#<\!\:(\w+)([^>]*?)\:>.*?<\!\:\/\1>#&makanop1($parms,$1,$2)#egs;
	$$html =~ s#<\!\:(\w+)([^>]*?)>#&makanop1($parms,$1,$2)#egs;
#JWT:CHGD. TO NEXT 20100920 TO ALLOW STYLES IN SELECT TAG!	$$html =~ s#(<SELECT\s+[^\:\>]*?\:\w+\s*>)(.*?)(<\/SELECT>)#&makasel($parms, $1,$2,$3)#eigs;
	$$html =~ s#(<SELECT\s+[^\>]*\>)(.*?)(<\/SELECT>)#&makasel($parms, $1,$2,$3)#eigs;
	$$html =~ s#<\!SELECTLIST\s+(.*?)\:(\w+)\s*>(.*?)<\!\/SELECTLIST>\s*#&makaselect($parms, $1,$2,$3)#eigs;

	$$html =~ s#(<TEXTAREA[^>]*?)\:(\w+)(?:\=([\"\']?)([^\3]*)\3|\>)?\s*>.*?(<\/TEXTAREA>)#$1.'>'.($parms->{$2}||$4).$5#eigs;
	$$html =~ s/(TYPE\s*=\s*\"?)(CHECKBOX|RADIO)([^>]*?\:)(\w+)(\s*>)/&makabutton($parms,$1,$2,$3,$4,$5)/eigs;
	$$html =~ s/(<\s*INPUT[^\<]*?)\:(\w+)(\=.*?)?>/&makatext($parms, $1,$2,$3).'>'/eigs;
	$$html =~ s/\:(\d+)/&makaswap($parms,$1)/egs 
			if ($cfgOps{numbers});   #STILL ALLOW JUST ":number"!
	$$html =~ s/\:\{(\w+)\}/&makaswap($parms,$1)/egs;   #ALLOW ":{word}"!
	$$html =~ s#<\!\%(\w+)\s*\{([^\}]*?)\}([^>]*?)>#&makahash($1,$2,$3)#egs 
			if ($cfgOps{hashes});
#	$$html =~ s/\:\{(\w+)\}/&makaswap($parms,$1)/egs;   #ALLOW ":{word}"!  #MOVED ABOVE PREV. LINE 20070428 SO "<!%hash{:{parameter}}>" WOULD WORK (USED IN "dsm")!

	#NEXT LINE ADDED 20031028 TO ALLOW IN-PARM EXPRESSIONS!
	$$html =~ s/\:\{([^\}]+)\}/&makamath($1)/egs;   #ALLOW STUFF LIKE ":{:{parm1}+:{parm2}+3}"!
	if ($evalsok)
	{
		$$html =~ s#<\!\:([\$\@\%][\w\:]+\{.*?\})([^>]*?)\:>.*?<\!\:\/\1>#&dovar($1,$2)#egs;  #ADDED 20000123 TO HANDLE HASHES W/NON VARIABLE CHARACTERS IN KEYS.
		$$html =~ s#<\!\:(\$[\w\:\[\{\]\}\$]+)([^>]*?)\:>.*?<\!\:\/\1>#&dovar($1,$2)#egs;
		$$html =~ s#<\!\:([\$\@\%][\w\:]+\{.*?\})([^>]*?)>#&dovar($1,$2)#egs;  #ADDED 20000123 TO HANDLE HASHES W/NON VARIABLE CHARACTERS IN KEYS.
		$$html =~ s#<\!\:(\$[\w\:\[\{\]\}\$]+)([^>]*?)>#&dovar($1,$2)#egs;
		$$html =~ s/\:(\$[\w\:\[\{\]\}\$]+)/&dovar($1)/egs;
		$$html =~ s/<\!EVAL\s+(.*?)(?:\/EVAL)?>/&doeval($1)/eigs;
		$$html =~ s#<\!PERL\s*([^>]*)>\s*(.*?)<\!\/PERL>#&doeval($2,$1)#eigs  if ($cfgOps{perls});
	}
	else

lib/LoadHtml.pm  view on Meta::CPAN

	#A CGI-WRAPPER, IE. ' HREF="http://my/path/cgi-bin/myscript.pl?relative/link.htm".

	if (defined($hrefhtmlhome))
	{
#		my $hrefhtmlback = $hrefhtmlhome;
#		$hrefhtmlback =~ s#\/[^\/]+$##o;
		if (defined($hrefcase))     #THIS ALLOWS CONTROL OF WHICH "href=" LINKS TO WRAP WITH CGI!
		{
			if ($hrefcase eq 'l')   #ONLY CONVERT LOWER-CASE "href=" LINKS THIS WAY.
			{
				$$html =~ s# (href)\s*=\s*\"(?!(\#|/|\w+\:))# $1=\"$hrefhtmlhome/$2#g;   #ADDED HREF ON 20010719!
			}
			else                    #ONLY CONVERT UPPER-CASE "HREF=" LINKS THIS WAY.
			{
				$$html =~ s# (HREF)\s*=\s*\"(?!(\#|/|\w+\:))# $1=\"$hrefhtmlhome/$2#g;   #ADDED HREF ON 20010719!
			}
		}
		else                        #CONVERT ALL "HREF=" LINKS THIS WAY.
		{
			$$html =~ s#( href)\s*=\s*\"(?!(\#|/|\w+\:))# $1=\"$hrefhtmlhome/$2#gi;   #ADDED HREF ON 20010719!
			#$$html =~ s# (href)\s*=\s*\"(?!(\#|/|\w+\:))# $1=\"$hrefhtmlhome/\x02$2#gi;   #ADDED HREF ON 20010719!
		}

		#RECURSIVELY CONVERT "my/deep/deeper/../../path" to "my/path".

	}
	if (defined($htmlhome) && $htmlhome =~ /\S/o)      #JWT 6 NEXT LINES ADDED 1999/08/31.
	{
		$$html =~ s#([\'\"])((?:\.\.\/)+)#$1$htmlhome/$2#ig;  #INSERT <htmlhome> between '|" and "../[../]*"
		1 while ($$html =~ s#[^\/]+\/\.\.\/##o);   #RECURSIVELY CONVERT "my/deep/deeper/../../path" to "my/path".
		if (defined($hrefcase))     #ADDED 20020117:  THIS ALLOWS CONTROL OF WHICH LINKS TO WRAP WITH CGI!
		{
			if ($hrefcase eq 'l')   #ONLY CONVERT LOWER-CASE "href=" LINKS THIS WAY.
			{
				$$html =~ s#(src|ground|href)\s*=\s*\"(?!(\#|/|\w+\:))#$1=\"$htmlhome/$2#g;   #CONVERT RELATIVE LINKS TO ABSOLUTE ONES.
				$$html =~ s# (cl|ht)\s*=\s*\"(?!(\#|/|\w+\:))# $1=\"$htmlhome/$2#g;   #CONVERT RELATIVE SPECIAL JAVASCRIPT LINKS TO ABSOLUTE ONES.
				$$html =~ s#(\s+window\.open\s*\(\s*\')(?!(\#|/|\w+\:))#$1$htmlhome/$2#g;     #ADDED 20050504 TO MAKE CALENDAR.JS WORK!
			}
			else
			{
				$$html =~ s#(SRC|GROUND|HREF)\s*=\s*\"(?!(\#|/|\w+\:))#$1=\"$htmlhome/$2#g;   #CONVERT RELATIVE LINKS TO ABSOLUTE ONES.
				$$html =~ s# (CL|HT)\s*=\s*\"(?!(\#|/|\w+\:))# $1=\"$htmlhome/$2#g;   #CONVERT RELATIVE SPECIAL JAVASCRIPT LINKS TO ABSOLUTE ONES.
			}
		}
		else
		{
			$$html =~ s#(src|ground|href)\s*=\s*\"(?!(\#|/|\w+\:))#$1=\"$htmlhome/$2#ig;   #CONVERT RELATIVE LINKS TO ABSOLUTE ONES.
			$$html =~ s# (cl|ht)\s*=\s*\"(?!(\#|/|\w+\:))# $1=\"$htmlhome/$2#ig;   #CONVERT RELATIVE SPECIAL JAVASCRIPT LINKS TO ABSOLUTE ONES.
			$$html =~ s#(\s+window\.open\s*\(\s*\')(?!(\#|/|\w+\:))#$1$htmlhome/$2#ig;     #ADDED 20050504 TO MAKE CALENDAR.JS WORK!
		}
		$$html =~ s#\.\.\/##g;   #REMOVE ANY REMAING "../".

		#NOTE:  SOME JAVASCRIPT RELATIVE LINK VALUES MAY STILL NEED HAND-CONVERTING 
		#VIA BUILDHTML, FOLLOWED BY ADDITIONAL APP-SPECIFIC REGICES, ONE EXAMPLE 
		#WAS THE "JSFPR" SITE, FILLED WITH ASSIGNMENTS OF "'image/file.gif'", 
		#WHICH WERE CONVERTED USING:
		#	$html =~ s#([\'\"])images/#$1$main_htmlsubdir/images/#ig;

	}

	#NEXT LINE ADDED 20010720 TO SUPPORT EMBEDS (NON-PARSED INCLUDES).

#	$$html =~ s#<\!EMBED\s+(.*?)>\s*#&fetchinclude($parms, $1, 0)#eigs  
#			if ($cfgOps{embeds});

	#ABOVE CHANGED TO NEXT REGEX 20060117 TO ALLOW PARTIAL FILE INCLUDES BASED ON TAGS.
	$$html =~ s!<\!EMBED\s+(.*?)>\s*!
		my $one = $1;
		$one =~ s/^\"//o;
		$one =~ s/\"\s*$//o;
		my $tag = 0;
		$tag = $1  if ($one =~ s/\:(\w+)//o);
		&fetchinclude($parms, $one, 0, $tag);
	!eigs  if ($cfgOps{embeds});

	return ($$html);
}

sub html_error
{
	my ($mymsg) = shift;
	
	return (<<END_HTML);
<html>
<head><title>CGI Program - Unexpected Error!</title></head>
<body>
<h1>$mymsg</h1>
<hr>
Please contact $poc for more information.
</body></html>
END_HTML
}

sub SetHtmlHome
{
	($htmlhome, $roothtmlhome, $hrefhtmlhome, $hrefcase) = @_;

	# hrefcase = undef:  convert all "href=" to $hrefhtmlhome.
	# hrefcase = 'l':    convert only "href=" to $hrefhtmlhome.
	# hrefcase = '~l':    convert only "HREF=" to $hrefhtmlhome.
}

sub loadhtml_package   #ADDED 20000920 TO ALLOW EVALS IN ASP!
{
	$calling_package = shift || 'main';
}

sub filedate    #ADDED 20020327
{
	my $parms = shift;
	my $fmt = shift;
	my $usetoday = shift;   #ADDED 20030501 TO SUPPORT DISPLAYING CURRENT DATE!

	$fmt =~ s/^\=\s*//o;
	$fmt =~ s/[\"\']//go;
	$fmt =~ s/\:$//go;
	$fmt ||= 'mm/dd/yy';    #SUPPLY A REASONABLE DEFAULT.
	my $mtime = time;
	(undef,undef,undef,undef,undef,undef,undef,undef,undef,undef,$mtime) 
			= stat ($0)  unless ($usetoday);   #CHGD. TO NEXT:12/30/15:
#			= stat ($parms->{'0'})  unless ($usetoday);
	$mtime ||= time;

#to_char() comes from DBD::Sprite, but is usable as a stand-alone program and is optional.

#x	my @parmsave = @_;
#x	@_ = ($mtime, $fmt);



( run in 0.914 second using v1.01-cache-2.11-cpan-71847e10f99 )