Lincoln Stein's CGI.pm

1. Reading and writing HTML form elements with CGI.pm

We will first look at this purposely contrived program that requests input in a variety of ways and echoes it back to the user.

The purpose is to identify the kind of widgets we can produce and how we can read their values back.

Contrast this to our approach with the recursive menu and the CGI POST calculator.

This serves as an introduction to CGI.pm.


#!/usr/bin/perl

use CGI;
$query = new CGI;

print $query->header, 
      $query->start_html (-bgcolor=>'white', 
                          -title=>'HTML Forms Widgets'); 
if ($query->request_method eq 'GET') {
  &show_form; 
} else {
  print $query->dump, $query->hr; 
  &process_query;   
} 
print $query->end_html; 

sub show_form { print 
  "\n", $query->start_form(-method=>'POST', 
                           -action=>$query->url),
  "\n", qq{This is a text field called fieldT1: <p>}, 
  "\n", $query->textfield(-name=>'fieldT1', 
                          -size=>20, 
                          -maxlength=>40),
  "\n", qq{<hr>Textarea called fieldT2: <p>},
  "\n", $query->textarea(-name=>'fieldT2', 
                         -default=>'Replace me with your answer', 
                         -rows=>5, 
                         -columns=>60),
  "\n", qq{<hr>Password field called fieldPw: <p>}, 
  "\n", $query->password_field(-name=>'fieldPw', 
                               -size=>20,
                               -maxlength=>20),
  "\n", qq{<hr>Popup menu field called fieldM: <p>},
  "\n", $query->popup_menu(-name=>'fieldM',
                           -values=> [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10],
                           -labels=> { 1 => 'one', 2 => 'two',
                                       3 => 'three', 4 => 'four', 
                                       5 => 'five', 6 => 'six', 
                                       7 => 'seven', 8 => 'eight',
                                       9 => 'nine', 10 => 'ten'}), 
  "\n", qq{<hr>Scrolling list field called fieldSc: <p>}, 
  "\n", $query->scrolling_list(-name=>'fieldSc', 
                               -values=> [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10],
                               -size=>5, -multiple=>'true', 
                               -labels=> { 1 => 'one', 2 => 'two',
                                           3 => 'three', 4 => 'four', 
                                           5 => 'five', 6 => 'six', 
                                           7 => 'seven', 8 => 'eight',
                                           9 => 'nine', 10 => 'ten'}), 
  "\n", qq{<hr>Group of checkboxes called fieldChk: <p>}, 
  "\n", $query->checkbox_group(-name=>'fieldChk', 
                               -linebreak=>'true', 
                               -values=> [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10],
                               -labels=> { 1 => 'one', 2 => 'two',
                                           3 => 'three', 4 => 'four', 
                                           5 => 'five', 6 => 'six', 
                                           7 => 'seven', 8 => 'eight',
                                           9 => 'nine', 10 => 'ten'}),
  "\n", qq{<hr>Group of radio buttons called fieldR: <p>},
  "\n", $query->radio_group(-name=>'fieldR', -default=>'--', 
                            -linebreak=>'true', 
                            -values=> [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10],
                            -labels=> { 1 => 'one', 2 => 'two',
                                        3 => 'three', 4 => 'four', 
                                        5 => 'five', 6 => 'six', 
                                        7 => 'seven', 8 => 'eight',
                                        9 => 'nine', 10 => 'ten'}),
  "\n", qq{<hr>A hidden field with name fieldH and value <em>discreet</em>: <p> }, 
  "\n", $query->hidden(-name=>'fieldH', -default=>'discreet'), 
  "\n", qq{<hr> Submit button to send the contents of this form to the server: <p> }, 
  "\n", qq{ Click here to}, $query->submit(-name=>'proceed'), 
  "\n", qq{<hr> Reset button to start again: <p> }, 
  "\n", qq{ To reset the form to the original values: }, $query->reset, 
  $query->end_form;  
} 

sub process_query {
  foreach $name ('fieldT1', 'fieldT2', 'fieldPw', 
    'fieldM', 'fieldSc', 'fieldChk', 'fieldR', 'fieldH') { 
    &process_param($name); 
  } 
} 

sub process_param {
  my ($name) = @_; 
  if      ($name eq 'fieldT1') {
    $value = $query->param($name); 
    print $query->ul(
            $query->li("Name: $name"),
            $query->li("Value: " . 
                        $query->escapeHTML($value)));
    print $query->hr;  
  } elsif ($name eq 'fieldT2') {
    $value = $query->param($name); 
    $value = $query->param($name); 
    print $query->ul(
            $query->li("Name: $name"),
            $query->li("Value: " . 
                        $query->escapeHTML($value)));
    print $query->hr;  
  } elsif ($name eq 'fieldPw') {
    $value = $query->param($name); 
    $value = $query->param($name); 
    print $query->ul(
            $query->li("Name: $name"),
            $query->li("Value: " . 
                        $query->escapeHTML($value)));
    print $query->hr;  
  } elsif ($name eq 'fieldM') {
    $value = $query->param($name); 
    $value = $query->param($name); 
    print $query->ul(
            $query->li("Name: $name"),
            $query->li("Value: " . 
                        $query->escapeHTML($value)));
    print $query->hr;  
  } elsif ($name eq 'fieldSc') {
    @values = $query->param($name);
    foreach $value (@values) { 
	$value = $query->escapeHTML($value); 
    } 
    print $query->ul(
            $query->li("Name: $name"),
            $query->li("Values: " . 
		       $query->blockquote(join('<br>', @values)))); 
    print $query->hr;  
  } elsif ($name eq 'fieldChk') { 
    @values = $query->param($name);  
    foreach $value (@values) { 
	$value = $query->escapeHTML($value); 
    } 
    print $query->ul(
            $query->li("Name: $name"),
            $query->li("Values: " . 
		       $query->blockquote(join('<br>', @values)))); 
    print $query->hr;  
  } elsif ($name eq 'fieldR') {
    $value = $query->param($name); 
    $value = $query->param($name); 
    print $query->ul(
            $query->li("Name: $name"),
            $query->li("Value: " . 
                        $query->escapeHTML($value)));
    print $query->hr;  
  } elsif ($name eq 'fieldH') {
    $value = $query->param($name); 
    $value = $query->param($name); 
    print $query->ul(
            $query->li("Name: $name"),
            $query->li("Value: " . 
                        $query->escapeHTML($value)));
    print $query->hr;  
  } else {

  } 
} 

sub escapeHTML {
  my ($string) = @_; 
  # 
  return $string; 
} 

(Available at tucotuco:19800/cgi-bin/formelms).
2. State machines with CGI (generic framework).

We will then discuss this program that implements a framework that you can later use with any state diagram that you need to implement.

The state diagram implemented by the program below is:


  A 
  A -> B, C
  B -> B, D
  C -> D, A

It looks much nicer as a FA rather than as a set of productions but here's the program that implements it.

#!/usr/bin/perl

use CGI;
$query = new CGI;

if ($query->request_method eq 'GET') {
  &in('A'); 
} elsif ($query->request_method eq 'POST') {
  &in(&out($query->param('source'))); 
} else { &error('Unsupported request method'); } 

sub error { my ($message) = @_; 
  print $query->header, 
        $query->start_html(-bgcolor=>'white'), 
        qq{ $message }, $query->end_html; 
} 

sub in { my ($target) = @_; print 
  $query->header, $query->start_html(-bgcolor=>'white', -title=>'Template'), 
  $query->start_form(-method=>'POST', -action=>$query->url);
  if      ($target eq 'A') { $query->param('source', 'A'); 
    # read about sticky vs. default behaviour of hidden fields 
    print qq{This is screen A.<hr>}; 
    print $query->radio_group(-name=>'action', -linebreak=>'true',
          -values=>['gotoB', 'gotoC'], -default=> '--', 
          -labels=>{'gotoB' => 'Go to screen B', 
                    'gotoC' => 'Go to screen C'},
          ), $query->hr, $query->hidden('source'),
          $query->submit(-name=>'Proceed'); 
  } elsif ($target eq 'B') { $query->param('source', 'A'); 
    print qq{This is screen B.<hr>}; 
    print $query->radio_group(-name=>'action', -linebreak=>'true',
          -values=>['gotoB', 'gotoD'], -default=> '--', 
          -labels=>{'gotoB' => 'Go to screen B', 
                    'gotoD' => 'Go to screen D' },
          ), $query->hr,
          qq{\n<input type="hidden" name="source" value="B">\n},   
          $query->hidden(-name=>'source', -value=>'B'), 
                                        # -default=>'A'),
          $query->submit(-name=>'Proceed'); 
  } elsif ($target eq 'C') { $query->param('source', 'C'); 
    print qq{This is screen C.<hr>}; 
    print $query->radio_group(-name=>'action', -linebreak=>'true',
          -values=>['gotoA', 'gotoD'], -default=> '--', 
          -labels=>{'gotoA' => 'Go to screen A', 
                    'gotoD' => 'Go to screen D'},
          ), $query->hr, 
          $query->hidden(-name=>'source', -default=>'C'),
          $query->submit(-name=>'Proceed'); 
  } elsif ($target eq 'D') { 
    print qq{This is screen D.<hr>}; 

  } else {
    print "Unknown or incompatible target."; 
  } 
  print $query->end_form, $query->end_html; 
}

sub out { my ($source) = @_, $action = $query->param('action'); 
  if ($source eq 'A') {
    return 'B' if ($action eq 'gotoB'); 
    return 'C' if ($action eq 'gotoC'); 
  } elsif ($source eq 'B') { 
    return 'B' if ($action eq 'gotoB'); 
    return 'D' if ($action eq 'gotoD'); 
  } elsif ($source eq 'C') { 
    return 'A' if ($action eq 'gotoA'); 
    return 'D' if ($action eq 'gotoD'); 
  } else {
    &error('Unknown source screen name.'); 
  } 
} 

(Available at tucotuco:19800/cgi-bin/template).
3. Feedback form

#!/usr/bin/perl

use CGI;

$query = new CGI;

if ($query->request_method eq 'GET') {
  &show_form; 
} elsif ($query->request_method eq 'POST') {
  &process_form; 
} else {
  &error('Unsupported request method.'); 
} 

sub error { my ($message) = @_; 
  print $query->header, 
        $query->start_html(-bgcolor=>'white'), 
        qq{ $message }, $query->end_html; 
} 

sub process_form {
  my $email, $message; 
  $message = $query->param('message'); 
  $email = $query->param('email'); 
  $email =~ s/\s//g; 
  if ($email =~ /^[a-zA-Z]+\@indiana.edu$/i) { 
  } elsif ($email =~ /^[a-zA-Z]+$/i) {
    $email .= "\@indiana.edu"; 
  } else { &error('Unsuported e-mail address format.'); } 
  open MAIL, "| mail $email dgerman\@indiana.edu "; 
  print MAIL $message; 
  close MAIL; 
  print $query->header,
        $query->start_html(-bgcolor=>'white'),
        qq{ Your message<blockquote>$message</blockquote> has 
            been sent to the webmaster. A copy has been sent  
            to the e-mail address that you indicated. }, 
        $query->end_html;
} 

sub show_form { print 
  $query->header, 
  $query->start_html(-bgcolor=>'white', 
                     -title=>'feedback'),
  $query->start_form(-method=>'POST', 
                     -action=>$query->url),
  qq{ Email address: }, 
  $query->textfield(-name=>'email', 
                    -size=>20,
                    -maxlength=>40),
  $query->p, qq{Message: },
  $query->textarea(-name=>'message', 
                   -rows=>5, 
                   -columns=>60,
                   -default=>'Replace me with your comments...'),
  $query->p, $query->submit(-name=>'Proceed'), $query->end_form, 
  $query->end_html; 
} 

(Available at tucotuco:19800/cgi-bin/feedback).
4. Clickable Images

Working with clickable images using CGI.pm.

Note that the image acts as a submit button so we could not make this part of the form from example 1 (that exemplifies the managing of HTML form widgets using CGI.pm).

However we will show later how Java and Javascript can cooperate to make a clickable image behave as a two-dimensional (graphical) radio button.

#!/usr/bin/perl

use CGI;
# use CGI::Carp 'fatalsToBrowser'; 
$query = new CGI;

print $query->header, 
      $query->start_html(-bgcolor=>'white', -title=>'Clickable Image');

if ($query->request_method eq 'GET') { 
  print $query->startform(-method=>'POST', 
                          -action=>$query->url), 
  qq{ Please click on the image below and the server will return the X 
      and Y coordinates of that pixel within the image to you. <p> }, 
  $query->image_button(-name=>'picture',
                       -src=>'http://www.cc.columbia.edu/low3.gif'),
  $query->p, $query->endform;
} else { print $query->dump, 
  qq{ X coordinate: }, $query->param('picture.x'), $query->p, 
  qq{ Y coordinate: }, $query->param('picture.y'), $query->p; 
} 

print $query->end_html;           
(Available at tucotuco:19800/cgi-bin/image).
5. File upload

#!/usr/bin/perl

use CGI;
$query = new CGI;

print $query->header, 
      $query->start_html(-title=>'File Upload', 
                         -bgcolor=>'white'); 
if ($query->request_method eq 'GET') {
  print $query->start_multipart_form(
            -method=>'POST',
            -action=>$query->url),
        "Filename: ", 
        $query->filefield(-name=>'filename', 
                          -size=>40), 
        $query->p, 
        $query->submit(-value=>'Proceed'),
        $query->end_form; 
} else {
  if ($file = $query->param('filename')) {
    print "This file sent for upload: <p> <pre>"; 
    while (<$file>) {
      print $_; 
    } print "</pre>"; 
  } else {
    print "No file specified"; 
  } 
} 

print $query->end_html; 

(Available at tucotuco:19800/cgi-bin/fileupload).