cgitest.cgi Annotated Source

This is the script which displays variables to the user. Generally, its operation is to read in a chtml-processed template, replace the variables section with table rows containing the environment variables, then replace the data section with the appropriate content.

#!/usr/local/bin/perl5

package main;

use strict;
use CGI;
use lib '/www/lib', '/usr/local/www/lib';
require 'chtml-template.pl';

This section defines libraries we wish to use. In our case, we use the strict, CGI, and chtml-template.pl libraries.

sub mangle ($@);
sub abort ($$);

my $cgi = new CGI;

Definition for a couple functions we use later, and declaration of the object we use from CGI.pm.

my $tmpl = $ENV{'SCRIPT_FILENAME'};
$tmpl =~ s{[^/]*$}{cgitest.tmpl};
my $file = chtml_procfile ($tmpl);

abort ($cgi, "Couldn't open template") unless open F, "<$file";

This is where we read in the template after processing through chtml. The template will always be in the current directory with the name of cgitest.tmpl.

my $data = undef;
while (<F>) {
    $data .= $_;
}
close F;

We read the template into a variable all at once. Note this method will not work if the template grew very large, but for this particular application, we know it will remain small enough.

my $env = join "\n",
            map {
                $cgi->TR ($cgi->td ($_), $cgi->td mangle ($cgi, ($ENV($})}));
            } sort keys %ENV;
$data =~ s{<!--ENV_TABLE-->}{$env};

The first statement builds the table rows for all the environment variables, and the second one puts it into our output. If you're not familiar with Perl, this statement is most easily read from the inside out:

  1. For each parameter we're given, we create a table row which consists of two cells, the parameter name, and the value of that environment variable. Note the value is passed through a function which will quote any special characters.
  2. The map expression will take a list we give it and iterate the table row generation expression over each of the list items.
  3. We give the map expression the names of all the environment variables in alphabetical order.
  4. The results of creating all the table rows are joined together by a string (each row separated by a newline for formatting reasons.)
  5. This long string is saved in a variable.
my @params = $cgi->param;
if (! scalar @params) {
    $data =~ s{<!--DATA-->.*<!--/DATA-->}{}s;
    $data =~ s{<!--/?DATA_NOVAL-->}{}g;

If we don't have any data, remove the text between the DATA and /DATA comments, and then remove just the DATA_NOVAL and /DATA_NOVAL strings themselves, leaving the content between them.

} else {
    my $vals = join "\n",
                map {
                    $cgi->TR ($cgi->td ($_),
                                $cgi->td (mangle $cgi, ($cgi->param ($_))));
                } @params;

This statement builds table rows of data variables just like we built the table rows for environment variables. The difference is that we don't sort the variable names, because form variables can be duplicated, and their order can be important depending on the application.

    $data =~ s{<!--/?DATA-->}{}g;
    $data =~ s{<!--DATA_TABLE-->}{$vals};
    $data =~ s{<!--DATA_NOVAL-->.*<!--/DATA_NOVAL-->}{}s;

We remove the DATA and /DATA comments, leaving the text between them. We then insert the data values into the correct place in the tepmlate, and remove the block which shows if there is no data.

    if (1 == scalar @params and $params[0] eq 'keywords') {
        $data =~ s{<!--/?DATA_KEYWORD-->}{}g;
    } else {
        $data =~ s{<!--DATA_KEYWORD-->.*<!--/DATA_KEYWORD-->}{}s;
    }

We then check if it looks as if the data wasn't presented to us as the result of form input, and display or hide the text between DATA_KEYWORD and /DATA_KEYWORD as appropriate.

}
print $cgi->header ('-content-length' => length $data), $data;

Finally, we print the data. One extra touch we do is to make sure that the CGI headers include the length of our content, which makes persistent connections work better for some servers and browsers.

sub mangle ($@) {
    my $cgi = shift;
    join $cgi->hr, map {;
         s/\&/\&amp;/g;
         s/</\&lt;/g;
         s/>/\&gt;/g;
         $_;
    } @_;
}

This function takes a string and returns the same string with special HTML characters quoted, so they'll be properly displayed. If we are passed multiple parameters, we separate them with a horizontal rule.

sub abort ($$) {
    my ($cgi, $str) = @_;
    my $data = $cgi->start_html (-title => 'Error') .
                $cgi->h1 ('Error') . $str . $cgi->end_html . "\n";
    print $cgi->header ('-content-length' => length $data), $data;
    exit 1;
}

This function takes a CGI object and an error string, and builds a short page describing the error.