parsestdin.pl
#!/usr/bin/perl
# parsestdin.pl
# =============
# (c) Copyright Paul Griffiths 2007
#
# CGI script decoding and outputting name/value pairs
# from standard in
$templatefile = "template.html";
$title = "Parse STDIN Output";
$heading = "Parse STDIN Output";
# Exit if POST request method not used
if ( $ENV{'REQUEST_METHOD'} ne "POST" ) {
$mainmatter = "<p>Error! You must use the POST <acronym title=\"HyperText Transfer protocol\">HTTP</acronym> Method!</p>\n\n";
&printHTMLOutputFromTemplate($templatefile, $title, $heading, $mainmatter);
exit(0);
}
# Exit if stdin is empty
if ( $ENV{'CONTENT_LENGTH'} == 0 ) {
$mainmatter = "<p>Error! You did not supply any input!!</p>\n\n";
&printHTMLOutputFromTemplate($templatefile, $title, $heading, $mainmatter);
exit(0);
}
# Exit if stdin is too long
if ( $ENV{'CONTENT_LENGTH'} > 1024 ) {
$mainmatter = "<p>Error! You supplied way too much data!!</p>\n\n";
&printHTMLOutputFromTemplate($templatefile, $title, $heading, $mainmatter);
exit(0);
}
# Get input from STDIN
read(STDIN,$input,$ENV{'CONTENT_LENGTH'});
# Split input into name/value pairs
@pairs = split(/&/,$input);
# Loop through pairs
foreach $pair (@pairs) {
$pair =~ s/\+/ /g; # Replace +'s with spaces
($name,$value) = split(/=/,$pair,2); # Split into name and value - must do this before next step as
# more '=' signs may be decoded
$name =~ s/%(..)/pack("c",hex($1))/ge; # Decode URL encoded characters in name
$value =~ s/%(..)/pack("c",hex($1))/ge; # Decode URL encoded characters in value
$name =~ s/&/&/g; # Replace any & characters, as we'll be outputting this
$name =~ s/</</g; # Replace any < characters, as we'll be outputting this
$name =~ s/>/>/g; # Replace any > characters, as we'll be outputting this
$name =~ s/"/"/g; # Replace any " characters, as we'll be outputting this
$value =~ s/&/&/g; # Replace any & characters, as we'll be outputting this
$value =~ s/</</g; # Replace any < characters, as we'll be outputting this
$value =~ s/>/>/g; # Replace any > characters, as we'll be outputting this
$value =~ s/"/"/g; # Replace any " characters, as we'll be outputting this
if ( $name eq "" ) { # Assign "<NONE"> to any empty names
$name = "<NONE>";
}
if ( $value eq "" ) { # Assign "<NONE"> to any empty values
$value = "<NONE>";
}
$input{$name} .= "---" if defined $input{$name}; # Use "---" as multiple separator if necessary
$input{$name} .= $value; # Populate associative array
}
# Output table of name/value pairs
$mainmatter .= "<table style=\"border: 1px solid #000000; border-collapse: collapse; text-align: left;\">\n";
$mainmatter .= " <tr><th scope=\"col\" style=\"border: 1px solid #000000; padding: 0.5em;\">Name</th><th scope=\"col\" style=\"border: 1px solid #000000; padding: 0.5em;\">Value</th></tr>\n";
foreach $name (keys %input) {
$mainmatter .= " <tr><td style=\"border: 1px solid #000000; padding: 0.5em;\">$name</td><td style=\"border: 1px solid #000000; padding: 0.5em;\">$input{$name}</td></tr>\n";
}
$mainmatter .= "</table>\n\n";
# Output and explicitly exit
&printHTMLOutputFromTemplate($templatefile, $title, $heading, $mainmatter);
exit 0;
# printHTMLOutputFromTemplate subroutine
#
# Parameters:
# $_[0] - name of template file
# $_[1] - title of document (replaces the string <??TITLE??> in the template file
# $_[2] - main heading of document (replaces the string <??HEADING??> in the template file
# $_[3] - main matter of document (replaces the string <??MAINMATTER??> in the template file
sub printHTMLOutputFromTemplate {
die "Not enough parameters specified!\n" unless @_ == 4;
local($templatefile, $title, $heading, $mainmatter) = @_;
open(TEMPLATEFILE, $templatefile) or die "Can't open $templatefile!\n";
print "Content-Type: text/html\n\n";
# loop until we reach <??MAINMATTER??> or until end of file
while ( $templateline = <TEMPLATEFILE> and not $templateline =~ /<\?\?MAINMATTER\?\?>/ ) {
$templateline =~ s/<\?\?TITLE\?\?>/$title/g;
$templateline =~ s/<\?\?HEADING\?\?>/$heading/g;
print "$templateline";
}
# print main matter and rest of template unless at end of file
if ( $templateline ) {
print "$mainmatter";
while ( $templateline = <TEMPLATEFILE> ) {
print "$templateline";
}
}
close(TEMPLATEFILE);
}