Sample search form script

The following script was used to display a search form (in this case to the 1993 Research Report) and then process the form inputs for passing on to kid-of-wais.pl (the World Wide Web to WAIS gateway).

Following that is the script 'postform.pl' which is required in this script.


#!/usr/local/bin/perl
#
#This script MUST be called resrep93qry.pl
#
#$debug=1;
if( $debug ) {print "Content-type: text/plain\n\n$0\n"; }

########################################################
#
# $form contains the full html text of the form
# $form name is mandatory as it is printed in postform.pl'printform
$form = &declareform;

require "postform.pl";

if ( ! %INPUT_ARRAY ) { exit; }

#########################################################
#
# 
# We only get to here if it was a POST; i.e., there is stuff in
# array %INPUT_ARRAY.  It is an array keyed by param name.


#  %INPUT_ARRAY and there is work to do.

 $ENV{QUERY_STRING} = $INPUT_ARRAY{query};
 $ENV{PATH_INFO} = "/Research.report.93";
 exec '/cern/unimelb/cgi-bin/waisquery.pl';
 
 ### waisquery.pl is really kid-of-wais.pl


#########################################################
#
# set up the form
#
sub declareform{
return '
<html>
<head>
<title>Search University of Melbourne 1993 Research Report</title>
</head>

<form method="POST"
      action="http://miricle.its.unimelb.edu.au/cgi-bin/resrep93qry.pl">

<h2>Search University of Melbourne 1993 Research Report</h2>

This is a keyword index of the University of Melbourne Research
Report 1993.<P>

You can specify a word to search for, e.g. <list>irrigation</list><br>
or several words,separated by <i>and</i> or <i>or</i>,
e.g. <list>pest and control</list><p>

<input type="text" name = "query" size=40>

<p>
<input type="submit" value="Search">
<input type="reset" value="Reset">
</form>

</html>
';
}

The postform.pl script follows. It is required by the search form script.

;#
;# Need ;# for comments in the config section
;# If the method is GET, send form
;# If they are still using Mac Mosaic v1.0, tell them to upgrade.
;# If the request is POST, get the form and put it into %INPUT_ARRAY

 CONFIG: { 
    if ( $ENV{REQUEST_METHOD} eq "GET") {
        if( index( $ENV{HTTP_USER_AGENT} , "MacMosaicB") != $[-1 )
        {
                &getnewbrowser;
        }
        else
        {
                &printform;
        }
    }
    else
    {
		%INPUT_ARRAY = &getpostinput;	
    }
    1;
}

#########################################################
#
# MacMosaic v1: tell the user to upgrade.
#
sub getnewbrowser{
print <<EOMSG;
Content-type: text/html

<html>
<head>
     <title>NOTICE: This browser does not support forms.</title>
</head>
<body>
<hr>
<h2>Notice:</h2>
  You are using a very old version of Mosaic, which does not support
  query forms of the type necessary for this search.
  We suggest you upgrade to Netscape, MacWeb or Mosaic v2.<p>
<hr>

</body>
EOMSG
}


#######################################################
#
# Read stdin and collect the posted input.
#
# Returns %INPUT_ARRAY
#
sub getpostinput{

local( $len, $postinput, $param, $value, $item, @INPUT, %INPUT_ARRAY );

# httpd gives us the Content-length in CONTENT_LENGTH

        $len = $ENV{CONTENT_LENGTH};

# Collect the input up to content-length chars
        while( <STDIN> )
        {
                $postinput.= $_;
                if( length( $postinput ) >= $len ){ last; }
        }
# remove any newlines and convert + to <space>
# can't use chop or it will upset the length calculations

        $postinput =~ s/\n|\r//g;
        $postinput =~ s/\+/ /g;

# Break the input up into an assoc. arrary.

        @INPUT = split( /&/, $postinput);

        foreach $item (@INPUT) {
                ($param, $value) = split( /=/, $item);

# unescape *after* splitting the input, so we don't split in the
# wrong places.

                $value =~ s/%([\da-f]{1,2})/pack(C,hex($1))/eig;
                $param =~ s/%([\da-f]{1,2})/pack(C,hex($1))/eig;
                 $INPUT_ARRAY{$param} = $value;
        }

    return (%INPUT_ARRAY);

}


#########################################################
#
# print out the form, with appropriate headers
#
sub printform{
	print "Content-type: text/html\n";
	print "Content-length: ";
	print length( $form );
	print "\n\n";
	print $form;
}