[Chapter 4] 4.3 Designing Applications Using Forms in Perl

4.3 Designing Applications Using Forms in Perl

Here is a simple form that prompts for a name:

<HTML>
<HEAD><TITLE>Testing a Form</TITLE></HEAD>
<BODY>
<H1>Testing a Form</H1>
<HR>
<FORM ACTION="/cgi-bin/greeting.pl" METHOD="POST">
Enter your full name: <INPUT TYPE="text" NAME="user" SIZE=60><BR>
<P>
<INPUT TYPE="submit" VALUE="Submit the form">
<INPUT TYPE="reset"  VALUE="Clear all fields">
</FORM>
<HR>
</BODY>
</HTML>

The form consists of an input field and the Submit and Reset buttons.

Now, here is the Perl program to decode the information and print a greeting:

#!/usr/local/bin/perl
$webmaster = "shishir\@bu.edu";
&parse_form_data (*simple_form);

The subroutine parse_form_data decodes the form information. Here, the main program passes the subroutine a reference to a variable named simple_form. The subroutine treats it as an associative array (a common data type in Perl) and fills it with key-value pairs sent by the browser. We will see how parse_form_data works later; the important thing right now is that we can easily get the name of the user entered into the form.

You may find it confusing, trying to track what happens to the information entered by the user. The user fills out the forms, and the browser encodes the information into a string of key-value pairs. If the request method is POST, the server passes the information as standard input to the CGI program. If the request method is GET, the server stores the information in an environment variable, QUERY_STRING. In either case, parse_form_data retrieves the data, breaks it into key-value pairs, and stores it into an associative array. The main program can then extract any information that you want.

print "Content-type: text/plain", "\n\n";
$user = $simple_form{'user'};
if ($user) {
    print "Nice to meet you ", $simple_form{'user'}, ".", "\n";
    print "Please visit this Web server again!", "\n";
} else {
    print "You did not enter a name. Are you shy?", "\n";
    print "But, you are welcome to visit this Web server again!", "\n";
}
exit(0);

The main program now extracts the user name from the array that parse_form_data filled in. If you go back and look at the form, you'll find it contained an <INPUT> tag with a NAME attribute of "user." The value "user" becomes the key in the array. That is why this program checks for the key "user" and extracts the value, storing it in a variable that also happens to be named "user."

The conditional checks to see if the user entered any information. One of two possible greetings is printed out. It is always very important to check the form values to make sure there is no erroneous information. For example, if the user entered "John Doe" the output would be:

Nice to meet you John Doe.
Please visit this Web server again!

On the other hand, if the user did not enter any data into the input field, the response would be:

You did not enter a name. Are you shy?
But, you are welcome to visit this Web server again!

Now, let's look at the core of this program: the subroutine that does all of the work.

sub parse_form_data
{
    local (*FORM_DATA) = @_;
    local ( $request_method, $query_string, @key_value_pairs,
                  $key_value, $key, $value);

The local variable FORM_DATA is a reference (or, in Perl terms, a glob) to the argument passed to the subroutine. In our case, FORM_DATA is a reference to the simple_form associate array. Why did we pass a reference with an asterisk (*simple_form) instead of just naming the array (simple_form)? The reasoning will be a little hard to follow if you are not familiar with programming, but I will try to explain. If I passed simple_form without the asterisk, the subroutine would not be able to pass information back to the main program in that array (it could return it in another array, but that is a different matter). This would be pretty silly, since the array is empty to start with and the only purpose of the subroutine is to fill it.

As you can see, the first thing I do is create another reference to the array, FORM_DATA. This means that FORM_DATA and simple_form share the same memory, and any data I put in FORM_DATA can be extracted by the main program from simple_form. You will see that the subroutine does all further operations on FORM_DATA; this is the same as doing them on simple_form.

Now let's continue with the rest of this subroutine.

    $request_method = $ENV{'REQUEST_METHOD'};
    if ($request_method eq "GET") {
        $query_string = $ENV{'QUERY_STRING'};
    } elsif ($request_method eq "POST") {
        read (STDIN, $query_string, $ENV{'CONTENT_LENGTH'});
    } else {
        &return_error (500, "Server Error",
                            "Server uses unsupported method");
    }

The request method is obtained. If it is a GET request, the query string is obtained from the environment variable and stored in query_string. However, if it is a POST request, the amount of data sent by the client is read from STDIN with the read command and stored in query_string. If the request protocol is not one of the two discussed earlier, an error is returned. Notice the return_error subroutine, which is used to return an error to the browser. The three parameters represent the status code, the status keyword, and the error message, respectively.

    @key_value_pairs = split (/&/, $query_string);
    foreach $key_value (@key_value_pairs) {
        ($key, $value) = split (/=/, $key_value);
        $value =~ tr/+/ /;
        $value =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg;

Since the client puts ampersands between key-value pairs, the split command specifies an ampersand as the delimiter. The result is to fill the array key_value_pairs with entries, where each key-value pair is stored in a separate array element. In the loop, each key-value pair is again split into a separate key and value, where an equal sign is the delimiter. The tr (for translate) operator replaces each "+" with the space character. The regular expression within the (for substitute) operator looks for an expression that starts with the "%" sign and is followed by two characters. These characters represent the hexadecimal value. The parentheses in the regexp instruct Perl to store these characters in a variable ($1). The pack and hex commands convert the value stored in $1 to an ASCII equivalent. Finally, the "e" option evaluates the second part of the substitute command--the replacement string--as an expression, and the "g" option replaces all occurrences of the hexadecimal string. If you had remained unconvinced up to now of Perl's power as a language for CGI, this display of text processing (similar to what thousands of CGI programmers do every day) should change your mind.

        if (defined($FORM_DATA{$key})) {
            $FORM_DATA{$key} = join ("\0", $FORM_DATA{$key}, $value);
        } else {
                    $FORM_DATA{$key} = $value;
        }
    }
}

When multiple values are selected in a scrolled list and submitted, each value will contain the same variable name. For example, if you choose "One" and "Two" in a scrolled list with the variable name "Numbers," the query string would look like:

Numbers=One&Numbers=Two

The conditional statement above is used in cases like these. If a variable name exists--indicating a scrolled list with multiple options--each value is concatenated with the "\0" separator. Now, here is the return_error subroutine:

sub return_error
{
    local ($status, $keyword, $message) = @_;
    print "Content-type: text/html", "\n";
    print "Status: ", $status, " ", $keyword, "\n\n";
    print <<End_of_Error;
<HTML>
<HEAD>
    <TITLE>CGI Program - Unexpected Error</TITLE>
</HEAD>
<BODY>
<H1>$keyword</H1>
<HR>$message<HR>
Please contact $webmaster for more information.
</BODY>
</HTML>
End_of_Error
    exit(1);
}

This subroutine can be used to return an error status. Since the program handles both GET and POST queries, you can send a query to it directly:

<A HREF="/cgi-bin/program.pl?user=John+Doe">Hello</A>

The program will display the same output as before.

Combining Graphics and Queries

It's simple to return graphical output when you process a form--in fact you can "bundle" the whole program up in an image, using the HTML tag IMG. Let's see how to do this. First, we'll start with a form that's just a little more complicated than the previous form:

<HTML>
<HEAD><TITLE>Color Text</TITLE></HEAD>
<BODY>
<H1>Color Text</H1>
<HR>
<FORM ACTION="/cgi-bin/gd_text.pl" METHOD="POST">
This form makes it possible to display color text and messages.<BR>
What message would you like to display: <BR>
<INPUT TYPE="text" NAME="message" SIZE=60><BR>
What is your favorite color: 
<SELECT NAME="color" SIZE=1>
<OPTION SELECTED>Red
<OPTION>Blue
<OPTION>Green
<OPTION>Yellow
<OPTION>Orange
<OPTION>Purple
<OPTION>Brown
<OPTION>Black
</SELECT>
<P>
<INPUT TYPE="submit" VALUE="Submit the form">
<INPUT TYPE="reset"  VALUE="Clear all fields">
</FORM>
<HR>
</BODY>
    </HTML>

This displays a form with one text field and a menu, along with the customary Submit and Reset buttons. The form and the program allow you to display color text in the browser's window. For example, if you want a red headline in your document, you can fill out the form or access the program directly:

<IMG SRC="/cgi-bin/gd_text.pl?message=Welcome+to+this+Web+server&color=Red>

This will place the GIF image with the message "Welcome to this Web server" in red into your HTML document. Now, here's the program:

#!/usr/local/bin/perl5
use GD;
$| = 1;
$webmaster = "shishir\@bu\.edu";
print "Content-type: image/gif", "\n\n";
&parse_form_data (*color_text);
$message = $color_text{'message'};
$color = $color_text{'color'};
if (!$message) {
    $message = "This is an example of " . $color . " text";
}

The form data is parsed and placed in the color_text associative array. The selected text and color are stored in $message, and $color, respectively. If the user did not enter any text, a default message is chosen.

This program uses the gd graphics library, which we discuss more fully in Chapter 6, Hypermedia Documents.

$font_length = 8;
$font_height = 16;
$length = length ($message);
$x = $length * $font_length;
$y = $font_height;
$image = new GD::Image ($x, $y);

The length of the user-specified string is determined. A new image is created based on this length.

$white = $image->colorAllocate (255, 255, 255);
if ($color eq "Red") {
    @color_index = (255, 0, 0);
} elsif ($color eq "Blue") {
    @color_index = (0, 0, 255);
} elsif ($color eq "Green") {
    @color_index = (0, 255, 0);
} elsif ($color eq "Yellow") {
    @color_index = (255, 255, 0);
} elsif ($color eq "Orange") {
    @color_index = (255, 165, 0);
} elsif ($color eq "Purple") {
    @color_index = (160, 32, 240);
} elsif ($color eq "Brown") {
    @color_index = (165, 42, 42);
} elsif ($color eq "Black") {
    @color_index = (0, 0, 0);
}
$selected_color = $image->colorAllocate (@color_index);
$image->transparent ($white);

Red, Green, and Blue (RGB) values for the user-selected color are stored in the color_index array. If no color is selected manually, the default is Red, as specified in the form. If you want to add more colors, look in /usr/local/X11/lib/rgb.txt for a list of the common colors. The transparent function makes the image background transparent.

$image->string (gdLargeFont, 0, 0, $message, $selected_color);
print $image->gif;
exit(0);

The text is displayed using the string operator, and the image is printed to standard output. As discussed in the previous example, you can also access this program with a GET request.