parsequery.pl

#!/usr/bin/perl

# parsequery.pl
# =============
# (c) Copyright Paul Griffiths 2007
#
# CGI script decoding and outputting name/value pairs
# from the query string

$templatefile = "template.html";
$title        = "Parse Query Output";
$heading      = "Parse Query Output";


# Exit if GET request method not used

if ( $ENV{'REQUEST_METHOD'} ne "GET" ) {
  $mainmatter = "<p>Error! You must use the GET <acronym title=\"HyperText Transfer protocol\">HTTP</acronym> Method!</p>\n\n";
  &printHTMLOutputFromTemplate($templatefile, $title, $heading, $mainmatter);
  exit(0);
}


# Exit if query string is empty

if ( $ENV{'QUERY_STRING'} eq "" ) {
  $mainmatter = "<p>Error! You did not supply a query string!!</p>\n\n";
  &printHTMLOutputFromTemplate($templatefile, $title, $heading, $mainmatter);
  exit(0);
}


# Split query string into name/value pairs

@pairs = split(/&/,$ENV{'QUERY_STRING'});


# 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/&/&amp;/g;                            # Replace any & characters, as we'll be outputting this
  $name =~ s/</&lt;/g;                             # Replace any < characters, as we'll be outputting this
  $name =~ s/>/&gt;/g;                             # Replace any > characters, as we'll be outputting this
  $name =~ s/"/&quot;/g;                           # Replace any " characters, as we'll be outputting this
  $value =~ s/&/&amp;/g;                           # Replace any & characters, as we'll be outputting this
  $value =~ s/</&lt;/g;                            # Replace any < characters, as we'll be outputting this
  $value =~ s/>/&gt;/g;                            # Replace any > characters, as we'll be outputting this
  $value =~ s/"/&quot;/g;                          # Replace any " characters, as we'll be outputting this
  if ( $name eq "" ) {                             # Assign "<NONE"> to any empty names
    $name = "&lt;NONE&gt;";
  }
  if ( $value eq "" ) {                            # Assign "<NONE"> to any empty values
    $value = "&lt;NONE&gt;";
  }
  $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);
}