Subject: Re: CGI Help
Mon May 04 00:23:21 1998



>I thought I recently saw one of the basic perl form-email scripts which 
>would send the form results to the e-mail address which the user chose 
>from a select box.  My application is just a comments form.  I have 
>several staff members and would like the user to choose the staff 
>member/department to which the comments will be sent.
>
>All I can find right now are scripts which will send the form results to the 
>same address(es) every time.


here's one from my own collection which will do the job.. it
takes all its parameters from the form which triggers it.   you
specifically need items which define the target address
(send_to) and the URL of a response page ('reply_URL') to make
it work.   you can also define the sender of the message and the
subject line in the form, but they're not manditory.

all other items in the form are sorted alphabetically by key
name, and printed one to a line in the body of the email.   i
suggest giving your input items names like:  '01_first_name',
'02_last_name', etc.

the script uses my personal library of CGI routines, which i'll
post in the following message.



----  mail_form.pl  ----

#!/usr/local/bin/perl

import CGI;

$MAIL = "/usr/ucblib/sendmail";
&main();



sub main {
    &init_globals();
    &read_stdin();
    
    if ( ! &is_def ('send_to')) {
        &cgi_error (@ERR_DEST);
    }
    if ( ! &is_def ('reply_URL')) {
        &cgi_error (@ERR_REPLY);
    }
    
    %hash = map (($_, 1), &get_names());
    
    delete $hash{'from'};
    delete $hash{'reply_URL'};
    delete $hash{'send_to'};
    delete $hash{'subject'};
    
    @out = ();
    for $item (sort keys %hash) {
        push @out, "$item :  " . &get_val ($item);
    }
    
    $dest = &get_val ('send_to');   
    $from = "From: "    . &get_val ('from')    . "\n";
    $subj = "Subject: " . &get_val ('subject') . "\n\n";
    
    open (SEND, "| $MAIL $dest") or &cgi_error (@ERR_MAIL);
    print SEND $from, $subj, join ("\n", @out), "\n\n\n";
    close SEND;
    
    &redirect_to (&get_val ('reply_URL'));
}


sub init_globals {
    @ERR_DEST = (
        "Destination",
        "You have not specified an email address to which",
        "this information should be sent."
    );
    
    @ERR_REPLY = (
        "Reply",
        "You have not specified the URL of response page.",
    );
    
    @ERR_MAIL = (
        "Mailer",
        "Could not locate (or launch) the email program."
    );
}



---- EOF ----






this is my library of CGI routines.   it should be stored in the
same directory as the email script under the name 'CGI.pm'


---- CGI.pm ----


####  SUPPORT PACKAGE:  CGI ROUTINES  ####

package CGI;


###
#   
#   this function allocates storage for the global data used in the
#   other functions.   the main reason for abstracting a bunch of
#   assignments into a separate function is to make the functions
#   which use the values more readable.
#   

sub _init_globals {
    
    $HDR  = "Content-type: text/html\n\n";
    
    $HEADER   = $HDR;
    $REDIRECT = "Location:  ";
    $ERROR    = $HDR;

    @ERR_METHOD = (
        "Method", 
        "The input method",
        qq("$main::ENV{'REQUEST_METHOD'}"),
        "is not supported by this script."
    );
}


###
#   
#   this function sets up a lookup table which maps x-encoded
#   character codes to the corresponding ASCII characters.   at the
#   moment, it only maps the standard printing characters to the
#   correct values.. anything else is mapped to a space.
#   

sub _init_LUT {
    for $i (0..255) {
        $s = sprintf ("%02x", $i);
        $LUT{"\L$s"} = " ";
    }
    $sp = unpack 'c', ' ';
    $z  = unpack 'c', 'z';
    
    for $i ($sp..$z) {
        $s = sprintf ("%02x", $i);
        $LUT{"\L$s"} = pack "C", $i;
    }
    $LUT_READY = 1;
}


###
#
#   this function takes a string of x-encoded data as input and uses
#   the lookup table (configured above) to turn it into straight
#   ASCII.
#

sub clean {
    my $data = shift;
    
    if ( ! $LUT_READY ) {
        &_init_LUT;
    }
    
    $data =~ s/\+/ /g;
    my @parts = $data =~ /%(..)/g;
    my %uniq  = map (($_,1), @parts);
    
    for $item (keys %uniq) {
    	$data =~ s/%$item/$LUT{"\L$item"}/ig;
    }
    return ($data);
}


###
#   
#   this function checks the request method to make sure it matches
#   the script's preference.   this isn't as flexible as reading any
#   input whatsoever, but it's more disciplined.
#   

sub ck_method {
    my $method = shift;
    if ($main::ENV{'REQUEST_METHOD'} ne $method) {
        &cgi_error (@ERR_METHOD);
    }
}


###
#   
#   this function takes a string of x-encoded data as its input, and
#   returns a reference to a hash of decoded name/value pairs. 
#
#   for a given key, the hash actually contains a reference to an
#   anonymous list, which in turn contains the data.   it's a bit
#   memory-intensive, but i don't expect to see large numbers of
#   variables, and it's a more effective way to store things.
#   

sub parse_input {
    my $data = shift;
    
    %HASH = ();
    if ( ! $LUT_READY ) {
        &_init_LUT;
    }
    
    my @pairs = split (/&/, $data);
    
    for $item (@pairs) {
        my ($name, $val) = split (/=/, $item);
        $name = &clean ($name);
        $val  = &clean ($val);
        
        my $key = $HASH{ $name };
        
        if (ref $key) {
            push @{ $key }, $val;
        } else {
            my $ref = [];
            $ref->[0] = $val;
            $HASH{ $name } = $ref;
        }
    }
}


###
#
#   this is the main input routine.   it reads standard input and 
#   parses what it finds into the appropriate data structures.
#

sub read_stdin {
    &ck_method ('POST');
    
    $RAW_INPUT = "";
    read (STDIN, $RAW_INPUT, $main::ENV{'CONTENT_LENGTH'});
    
    &parse_input ($RAW_INPUT);
}


###
#
#   this is the main input routine.   it reads standard input and 
#   parses what it finds into the appropriate data structures.
#

sub read_query {
    &ck_method ('GET');
    
    $RAW_INPUT = $ENV{'QUERY_STRING'};    
    &parse_input ($RAW_INPUT);
}


###
#   
#   this is an accessor function.   it's used in those cases where
#   the main code needs the data direct from the httpd.
#   

sub get_raw_input {
    return $RAW_INPUT;
}


###
#   
#   this is an accessor function.   it returns a list of all the
#   variables passed from the form.
#   

sub get_names {
    return (sort keys %HASH);
}


###
#   
#   this is an accessor function.   it takes a variable name as
#   input and returns a list containing the associated value(s).   it
#   makes the way &parse_input() stores data in the hash transparent.
#   

sub get_val {
    my $name = shift;
    
    my $val = $HASH{ $name };
    
    if (ref $val) {
        return (wantarray) ? @{ $val } : join (', ', @{ $val });
    } else {
        return 0;
    }
}


###
#   
#   this is a debugging function which dumps the incoming data as a
#   webpage, then quits.
#   

sub echo {
    print $HDR;
    for $item (&get_names) {
        print "<br> $item = ", get_val ($item);
    }
    exit (1);
}


###
#
#   this is an accessor function.   it takes the name of a variable
#   as input and returns (efffectively) a boolean which indicates
#   whether the hash contains an entry by that name.   it's intended
#   for use with switching variables (i.e.: checkboxes), where the
#   item's actual value is irrelevant.
#

sub is_def {
    my $name = shift;
    return ($HASH{ $name }) ? 1 : 0;
}


###
#   
#   this is a utility routine which prints an error page and
#   terminates the program.
#   

sub cgi_error {
    my $type    = shift;
    my $message = join ("\n", @_);
    
    print <<__done
$ERROR

<head><title>$type Error</title></head>
<body>
<h1>510 $type Error</h1>
        $message
</body>

__done
    exit (1);
}


###
#   
#   this is a utility function which redirects the browser to
#   another file.
#   

sub redirect_to {
    my $url = shift;
    print <<__done;
$REDIRECT, $url

<head><title>redirection</title></head>
<body>
The page you requested has been moved <a href="$url">here.</a>
</body>

__done
}


###
#   
#   the import function which carries function names into the
#   scope of the calling package.
#   

sub import {
    my $pkg = caller;

    &_init_globals;
    &_init_LUT;

    if ($pkg) {
        *{"${pkg}::ck_method"}      = \&ck_method;
        *{"${pkg}::ck_get"}         = sub { &ck_method ('GET') };
        *{"${pkg}::ck_post"}        = sub { &ck_method ('POST') };
        *{"${pkg}::parse_input"}    = \&parse_input;
        *{"${pkg}::read_stdin"}     = \&read_stdin;
        *{"${pkg}::read_query"}     = \&read_query;
        *{"${pkg}::get_raw_input"}  = \&get_raw_input;
        *{"${pkg}::get_names"}      = \&get_names;
        *{"${pkg}::get_val"}        = \&get_val;
        *{"${pkg}::echo"}           = \&echo;
        *{"${pkg}::is_def"}         = \&is_def;
        *{"${pkg}::cgi_error"}      = \&cgi_error;
        *{"${pkg}::redirect_to"}    = \&redirect_to;

        ${"${pkg}::HDR"}            = $HDR;
        ${"${pkg}::CGI_HDR"}        = $HEADER;
    }   
}



1;


---- EOF ----