Viewing cgitest.cgi

#!/usr/local/bin/perl5

package main;

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

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

my $cgi = new CGI;

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

abort ($cgi, "Couldn't open template") unless open F, "<$file";
my $data = undef;
while (<F>) {
    $data .= $_;
}
close F;

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

my @params = $cgi->param;
if (! scalar @params) {
    $data =~ s{<!--DATA-->.*<!--/DATA-->}{}s;
    $data =~ s{<!--/?DATA_NOVAL-->}{}g;
} else {
    my $vals = join "\n",
		map {
		    $cgi->TR ($cgi->td ($_),
				$cgi->td (mangle ($cgi, $cgi->param ($_))));
		} @params;
    $data =~ s{<!--/?DATA-->}{}g;
    $data =~ s{<!--DATA_TABLE-->}{$vals};
    $data =~ s{<!--DATA_NOVAL-->.*<!--/DATA_NOVAL-->}{}s;
    if (1 == scalar @params and $params[0] eq 'keywords') {
	$data =~ s{<!--/?DATA_KEYWORD-->}{}g;
    } else {
	$data =~ s{<!--DATA_KEYWORD-->.*<!--/DATA_KEYWORD-->}{}s;
    }
}
print $cgi->header ('-content-length' => length $data), $data;

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

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;
}