#!/usr/local/bin/perl # nameage.cgi # Perl Routines to Manipulate CGI input # S.E.Brenner@bioc.cam.ac.uk # $Header: /cys/people/brenner/http/cgi-bin/RCS/cgi-lib.pl,v 1.14 1995/10/25 15:08:37 brenner Exp $ # # Copyright (c) 1995 Steven E. Brenner # Unpublished work. # Permission granted to use and modify this library so long as the # copyright above is maintained, modifications are documented, and # credit is given for any use of the library. # # Thanks are due to many people for reporting bugs and suggestions # especially Meng Weng Wong, Maki Watanabe, Bo Frese Rasmussen, # Andrew Dalke, Mark-Jason Dominus, Dave Dittrich, Jason Mathews # For more information, see: # http://www.bio.cam.ac.uk/web/form.html # http://www.seas.upenn.edu/~mengwong/forms/ # Minimalist http form and script (http://www.bio.cam.ac.uk/web/minimal.cgi): # # require "cgi-lib.pl"; # if (&ReadParse(*input)) { # print &PrintHeader, &PrintVariables(%input); # } else { # print &PrintHeader,'

Data: '; #} # ReadParse # Reads in GET or POST data, converts it to unescaped text, and puts # one key=value in each member of the list "@in" # Also creates key/value pairs in %in, using '\0' to separate multiple # selections # Returns TRUE if there was input, FALSE if there was no input # UNDEF may be used in the future to indicate some failure. # Now that cgi scripts can be put in the normal file space, it is useful # to combine both the form and the script in one place. If no parameters # are given (i.e., ReadParse returns FALSE), then a form could be output. # If a variable-glob parameter (e.g., *cgi_input) is passed to ReadParse, # information is stored there, rather than in $in, @in, and %in. sub ReadParse { local (*in) = @_ if @_; local ($i, $key, $val); # Read in text if (&MethGet) { $in = $ENV{'QUERY_STRING'}; } elsif (&MethPost) { read(STDIN,$in,$ENV{'CONTENT_LENGTH'}); } @in = split(/[&;]/,$in); foreach $i (0 .. $#in) { # Convert plus's to spaces $in[$i] =~ s/\+/ /g; # Split into key and value. ($key, $val) = split(/=/,$in[$i],2); # splits on the first =. # Convert %XX from hex numbers to alphanumeric $key =~ s/%(..)/pack("c",hex($1))/ge; $val =~ s/%(..)/pack("c",hex($1))/ge; # Associate key and value $in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator $in{$key} .= $val; } return scalar(@in); } # PrintHeader # Returns the magic line which tells WWW that we're an HTML document sub PrintHeader { return "Content-type: text/html\n\n"; } # HtmlTop # Returns the of a document and the beginning of the body # with the title and a body

header as specified by the parameter sub HtmlTop { local ($title) = @_; return < $title
$title
END_OF_TEXT } # Html Bot # Returns the , codes for the bottom of every HTML page sub HtmlBot { return "\n\n"; } # MethGet # Return true if this cgi call was using the GET request, false otherwise sub MethGet { return ($ENV{'REQUEST_METHOD'} eq "GET"); } # MethPost # Return true if this cgi call was using the POST request, false otherwise sub MethPost { return ($ENV{'REQUEST_METHOD'} eq "POST"); } # MyURL # Returns a URL to the script sub MyURL { local ($port); $port = ":" . $ENV{'SERVER_PORT'} if $ENV{'SERVER_PORT'} != 80; return 'http://' . $ENV{'SERVER_NAME'} . $port . $ENV{'SCRIPT_NAME'}; } # CgiError # Prints out an error message which which containes appropriate headers, # markup, etcetera. # Parameters: # If no parameters, gives a generic error message # Otherwise, the first parameter will be the title and the rest will # be given as different paragraphs of the body sub CgiError { local (@msg) = @_; local ($i,$name); if (!@msg) { $name = &MyURL; @msg = ("Error: script $name encountered fatal error"); }; print &PrintHeader; print "$msg[0]\n"; print "
$msg[0]
\n"; foreach $i (1 .. $#msg) { print "
$msg[$i]
\n"; } print "\n"; } # CgiDie # Identical to CgiError, but also quits with the passed error message. sub CgiDie { local (@msg) = @_; &CgiError (@msg); die @msg; } # PrintVariables # Nicely formats variables in an associative array passed as a parameter # And returns the HTML string. sub PrintVariables { local (%in) = @_; local ($old, $out, $output); $old = $; $ =1; $output .= "\n
\n"; foreach $key (sort keys(%in)) { foreach (split("\0", $in{$key})) { ($out = $_) =~ s/\n/
\n/g; $output .= "
$key\n
$out
\n"; } } $output .= "
\n"; $* = $old; return $output; } # PrintVariablesShort # Now obsolete; just calls PrintVariables sub PrintVariablesShort { return &PrintVariables(@_); } 1; #return true #*********************************** # # muc.cgi - main program, Using user input from a web page, choose # the degees and Institutions that match the criteria # indicated by the user. # #* #* # # open the school database and read all data into an array # use lines to destinguish records # # Failure to open correctly builds abreviated web page with error msg # #* unless( open( SCHOOL, "/usr2/berezin/ph/muc/school.txt" ) ) { print "Content-Type: text/html\r\n\r\n"; print " \n"; print "Degree Information \n"; print "\n"; print "\n"; print "Unable to open school file\n"; print "\n"; print " \n"; die( "" ); }; @school = ; $schoolcnt = @school; close( SCHOOL ); #* # # open the degrees database # and read all data into an array # # Failure to open correctly builds abreviated web page with error msg # #* unless( open( DEGREES, "/usr2/berezin/ph/muc/degrees.txt" )) { print "Content-Type: text/html\r\n\r\n"; print " \n"; print "Degree Information \n"; print "\n"; print "\n"; print "Unable to open degrees file\n"; print "\n"; print " \n"; die( "" ); }; @degrees = ; $degreescnt = @degrees; close( DEGREES ); #* # # begin building web page # #* { print "Content-Type: text/html\r\n\r\n"; print " \n"; print "Degree Information \n"; print "\n"; print "\n"; #* # # Get information from user's input on web page # #*********************************** &ReadParse(*i); #*********************************** # Search for information requested by caller. # Begin by searching degree database for matches on criteria # If no criteria specified get all records #* $cntr = 0; $srchstr = $i{'topic'}; if( $srchstr ne "" ) { @topicfnd = grep ( /$srchstr/, @degrees ); } else { @topicfnd = grep ( /./, @degrees ); }; $topicfnd = @topicfnd; #* # search located information for specific degree type # If no criteria specified get all records #* $srchstr = $i{'Degree'}; if( $srchstr eq "All" ) { @degreesfnd = grep ( /./, @topicfnd ); } elsif( $srchstr ne "" ) { @degreesfnd = grep ( /$srchstr/, @topicfnd ); } else { @degreesfnd = grep ( /./, @topicfnd ); } $degreesfnd = @degreesfnd; $lastfnd = ""; #* # For each degree identified, use the Institution key to fetch the # Institution information #* for( $cntr = 0; $cntr < $degreesfnd; $cntr++ ) { # for each degree record, break up the list of fields in to an array @degreeline = split( /,/, $degreesfnd[$cntr] ); # Using the first field (key), find match in school record @schoolfnd = grep( /$degreeline[0]/, @school ); @schoolline = split( /,/, $schoolfnd[$cntr] ); #* # if the current degree applies to a different school from previous # degree, then print school info #* if( $degreeline[0] ne $lastfnd ) { $schoolinfo = join( " ", @schoolfnd ); $schoolinfo =~ tr/^"/ /; $schoolinfo =~ tr/","/ /; print "
$schoolinfo
\n"; } # print degree info @degreeinfoline = @degreeline[1,2,3,4]; $degreeinfo = join( " ", @degreeline[1,2,3,4] ); # print( " $degreeinfo
" ); print( " @degreeline[1,2,3,4]
\n" ); # remember the school key of the info just printed $lastfnd = $degreeline[0]; } print "\n"; print " \n"; # end of web page generation #* # # Get caller info from web page and store in file # #*********************************** $calldate = `date`; chop( $calldate ); @caller = join( '","', "$i{lname}","$i{fname}" ); @caller = join( '","', @caller,"$i{address}","$i{city}" ); @caller = join( '","', @caller,"$i{county}","$i{state}" ); @caller = join( '","', @caller,"$i{zip}","$i{phone}", "$calldate" ); @caller = join( '', '"',@caller,'"' ); if( open( CALLER, ">>/usr2/berezin/ph/callers" ) ) { print CALLER ( @caller ); } close( CALLER ); }