#!/usr/local/bin/perl # 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.10 1995/08/15 16:08:52 brenner Exp brenner $ # # 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 and Dave Dittrich. # For more information, see: # http://www.bio.cam.ac.uk/web/form.html # http://www.seas.upenn.edu/~mengwong/forms/ # Warning: this file is not the standard one but the irdp-sparc4 library # Reference in ~bab/cgi-bin/cgi-lib.pl # Last modified: 15 sept. 1997 0810 # 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"; } # PrintTitle # Returns the of a document and the beginning of the body # with the title and a body

header as specified by the parameter sub PrintTitle { local ($title) = @_; return "$title\n\n

$title

\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 = ("Erreur: le script $name est a provoque une erreur fatale"); }; print &PrintHeader; print "$msg[0]\n"; print "

$msg[0]

\n"; foreach $i (1 .. $#msg) { print "

$msg[$i]

\n"; } print "\n"; } # CgiDie # Identical to CgiEror, 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 .= "

$key: $out
"; } } $output .= "

"; $* = $old; return $output; } # PrintVariablesShort # Now obsolete; just calls PrintVariables sub PrintVariablesShort { return &PrintVariables(@_); } sub URLencode { local ($in) = @_; @mot = split(//,$in); $count = 0; while ($mot[$count] ne "") { if ($mot[$count] !~ /\w/ && $mot[$count] ne ' ') { $mot[$count] = "%" . sprintf('%x',ord($mot[$count])); } $count++; } $in = join("",@mot); $in =~ s/ /\+/g; return($in); } sub URLdecode { local($in) = @_; $in =~ s/\+/ /g; # Convert %XX from hex numbers to alphanumeric $in =~ s/%(..)/pack("c",hex($1))/ge; return($in); } sub addrserver { local($symbolique) = "0"; open(HOSTNAME,"/etc/hostname.le0"); $hostname = ; chop($hostname); close(HOSTNAME); open(HOSTS,"/etc/hosts"); $host = ; chop($host); while ($host ne "") { if ($host =~ /^(.+)[\s]+($hostname)$/) { $adresse = $1; last; } $host = ; chop($host); } close(HOSTS); if ($symbolique) { return($hostname); } else { return($adresse); } } 1; # return true