#!/usr/local/bin/perl # (The above line tells the system where the perl # language program resides on this computer.) #------------------------------------------------ # File: form1.cgi # Function: Exemplary Web Form Script! # Better diagnostics! Combines # form-display (if no input) # and result-processing. # URL: http://www.cclabs.missouri.edu/ # perl/demo/form1.cgi # Author: Greg Johnson, # Original: 07 March 1996 gkj # Update: 24 June 1996 gkj, more comments. # # Outline: # Set up necessary output and some variables. # If there was input, then # call subroutine interpret_inputs. # Otherwise, call subroutine show_form. # Exit. # Subroutine interpret_inputs validates the # inputs, and if they're ok, calls subroutine # mail_results to save the results via email. #------------------------------------------------ # The First Thing to do in almost any Perl CGI Script: open(STDERR,'>&STDOUT'); $| = 1; # This causes error messages to display with # standard output, as soon as they occur. # Otherwise CGI-run errors display to the # web server error log, which may not be # easy to access. # The Second Thing to do in almost any Perl CGI Script: print "Content-type: text/html\n\n"; # Every browser expects a header such as this. # If we delay sending the header, and we make an # error, then this error would be the first # thing to print, as a "malformed header". # Now we can do our intended tasks. # Initialize: $mailto = 'substitute@some.email.addresss'; $subject = 'CGI-Demo: form1'; $mailcmd = '/usr/lib/sendmail -n -t -oi'; # Unix server! # These assign character strings to meaningful # variable names, simplifying work for anyone # who wants to modify this program. $server=$ENV{'SERVER_NAME'}; $script=$ENV{'SCRIPT_NAME'}; # The Web Server passes several items # via environment variables $ENV{}. # Access external programs: require "cgi-lib.pl" || die "Can't find cgi-lib.pl $! "; # Call the &ReadParse subroutine to try to read # data from the web form. # The call evaluates as "true" if there was input. if ( &ReadParse(*input) ) { &interpret_inputs; # There was input } else { &show_form; # No input } exit; #------------------------------------------------ # The subroutines follow: #------------------------------------------------ sub show_form { # Subroutine sub_form displays a blank form. # First, echo the URL http://servername:port/path # Did we use other than the default http port 80? $port = $ENV{'SERVER_PORT'}; if ($port eq '80' || $port eq '') { $sport = ''; } else { $sport = ':' . $port; } # Now, print the HTML for the blank form: print <Hello

Hello!

from http://$server$sport$script

to $ENV{'REMOTE_HOST'}

Full Email Address... 
Family Name.......... 
Given Name........... 
Title................ 
Comments............. 
Press to submit information, or to clear fields.
ThatsAll # We used
 to align fields for 
	# simplicity and because a few 
	# browsers still don't grok tables.

# Let's finish with an intentional 
# run-time error.
# $oops is unitialized, and therefore as 
# a number evaluates to zero.

$sport = 1 / $oops;
print "

This line won't display!\n"; } # end of subroutine show_form # #------------------------------------------------ sub interpret_inputs { # Subroutine interpret_inputs validates # that all required values were entered and # that they have the correct formats. # First, copy values from associative array # %input into convenient scalar variables: $email=$input{'email'}; $fname=$input{'fname'}; $gname=$input{'gname'}; $title=$input{'title'}; $comments=$input{'comments'}; $errmsg=''; # Check that required inputs are # present and meaningful. # Email must have form user@host.somewhere if ($email =~ /^\s*$/ ) { # Is email missing? # ^ means start of string, # \s means blank,tab,newline or return # * means "zero or more" # $ means end of string. # "Does $email match the pattern: # zero or more spaces?" $errmsg .= '

You must supply an email address!'; } elsif ($email !~ /(\S+@\S+\.\S+)/ ) { # Does $email match "user@host.somewhere"? # \S means "non-space" # + means "one or more" # \. means "period" # ( ) means "capture this part of pattern" $errmsg .= '

Email address must have form:' . 'id@host.whatever'; } else { $email = $1 } # Strips off leading and trailing blanks # $1 means "what was between () in previous # match. if ($fname =~ /^\s*$/ && $gname =~ /^\s*$/) { $errmsg .= '

You must supply family or given name.'; } print <Results EOF if ($errmsg eq '') {&mail_results} if ($errmsg ne '') {print '


',$errmsg} else {print '

Your entry was submitted: ', `date`} print "

", "


\n"; } # end of subroutine interpret_inputs # #------------------------------------------------ # We've got form input values and they're ok, so email # them to some address. # Disadvantage of email: We still need a program to # extract results from mail. # Advantage of email: Writing directly to a disk file # requires special attention to security; otherwise # not only can my cgi script write to my file, # so can anyone else's cgi script on that server. sub mail_results { # If we can't connect our output to the mail command, # then issue an error message. if (! open(MAILCMD, "|$mailcmd") ) { $errmsg .= "

Can't send mail to $mailto, $!"; return; } eval print MAILCMD <