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/\>/>/go;
$expn =~ s/\</</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 )