##
## f2cgi.pm - assorted CGI routines
package f2cgi;
use CGI::Carp qw(fatalsToBrowser set_message);
set_message('For help, please send mail to the webmaster (fred@f2.org), giving this error message.');
## urlquerysafe($str)
##
## Returns:
## A version of $str safely escaped for use in a query URL
## The specifications are a dog's breakfast. RFC 2396 specifies
## that unreserved characters are and
## "-" | "_" | "." | "!" | "~" | "*" | "'" | "(" | ")" ; these
## characters need not be escaped within a URI query. Common
## practice, however, encodes spaces as the '+' character.
##
sub urlquerysafe {
my($str) = @_;
$str =~ s{([^A-Za-z0-9\-_\.!~\*'\(\) ])}{"%".unpack("H*",$1)}ges;
$str =~ tr/ /+/;
return $str;
}
## htmlsafe($str)
##
## Returns:
## $str with "<" ">" "&" characters replaced by HTML entity codes
##
sub htmlsafe {
my($str) = @_;
$str =~ s{&}{&}g;
$str =~ s{<}{<}g;
$str =~ s{>}{>}g;
return $str;
}
## parseQuery([ $queryString ])
##
## Returns:
## (\%values, \%rawValues) - hashes of processed & raw CGI variables
## from $query (if specified) or CGI environment variables if $queryString
## not specified
##
sub parseQuery {
my($query) = @_;
if (!defined($query)) {
if ($ENV{"REQUEST_METHOD"} =~ /\Apost\Z/i) {
my $oldsep = $/;
undef $/;
$query=;
$query =~ s/[\n\r]+$//;
$/ = $oldsep;
} else {
$query = $ENV{"QUERY_STRING"};
if (!defined($query) || $query eq '') {
$query = $ENV{"PATH_INFO"};
if (defined($query)) {
$query =~ s{^/}{};
}
}
}
$query = '' if (!defined($query));
}
## Extract query variables from query string
##
my %values = ();
my %rawValues = ();
foreach (split(/\&/, $query)) {
my($var, $val) = $_ =~ /(.*)=(.*)/;
if (defined($var)) {
$rawValues{$var} = $val;
$val =~ tr/+/ /;
$val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
require Encode;
$val = Encode::decode_utf8( $val );
$values{$var}=$val;
}
}
return (\%values, \%rawValues);
}
## redirOutput($redirURL)
##
## Redirect the browser to $redirURL
##
sub redirOutput {
my($redirURL) = @_;
print <$redirURL
END
exit(0);
}
## pngOutput($pngData)
##
## Output a PNG file
##
sub pngOutput {
binmode(STDOUT);
my($pngData) = @_;
print <' and '&' characters
##
sub textOutput {
my($msg, $title) = @_;
headerOutput($title);
print <@{[htmlsafe($msg)]}
END
tailerOutput($title);
exit(0);
}
## htmlOutput($msg, $title)
##
## Output a chunk of HTML
##
sub htmlOutput {
my($html, $title) = @_;
headerOutput($title);
print $html;
tailerOutput();
exit(0);
}
sub headerOutput {
my($title) = @_;
$title = ((defined($title) && $title =~ m{\S}) ? "@{[htmlsafe($title)]}" : "");
print <
$title
END
}
sub tailerOutput {
print <
END
exit(0);
}
1;