From the previous lab a useful mySQL command:

burrowww.cs.indiana.edu% mysql -ua348 -p 
Enter password: 
Welcome to the MySQL monitor.  Commands end with ; or \g.
Your MySQL connection id is 184 to server version: 3.23.27-beta

Type 'help;' or '\h' for help. Type '\c' to clear the buffer

mysql> use a348
Database changed
mysql> show tables like "dgerman%";
+---------------------------+
| Tables_in_a348 (dgerman%) |
+---------------------------+
| dgerman_0509              |
| dgerman_0516              |
| dgerman_CARTS             |
| dgerman_DETAIL            |
| dgerman_I                 |
| dgerman_ITEMS             |
| dgerman_ORDERS            |
| dgerman_SHOP              |
| dgerman_U                 |
| dgerman_USERS             |
| dgerman_game_0509         |
| dgerman_hangman           |
| dgerman_items             |
| dgerman_shopping          |
| dgerman_student           |
| dgerman_trans_0516        |
+---------------------------+
16 rows in set (0.01 sec)

mysql> exit
Bye
burrowww.cs.indiana.edu% 

We assume a loose A201 background.

What follows is a brief OOPerl summary:

Rule 1: To create a class, build a package.

frilled.cs.indiana.edu%pico BankAccount.pm
frilled.cs.indiana.edu%cat BankAccount.pm
package BankAccount; 

use strict;
use warnings; 

frilled.cs.indiana.edu%

package BankAccount; 

use strict;
use warnings; 

sub new {
    my $class = shift();   
    my $balance = shift(); 
    my $account = { balance => $balance };
    bless ($account); 
    return $account; 
} # that's a constructor, though...

sub getBalance {
    my $this = shift(); 
    return $this->{ balance }; 
}

sub deposit {
    my $this = shift(); 
    my $amount = shift(); 
    $this->{ balance } += $amount; 
}

sub withdraw {
    my $this = shift(); 
    my $amount = shift(); 
    $this->{ balance } -= $amount; 
}

return 1; # needed for modules imported with use
          # such modules are imported during the compilation phase
          # indicates that the module has been successfully imported

That's exactly what we did in the definition of the constructor, above.

Now, let's put this to use.

#!/usr/bin/perl

use BankAccount; 

$adrian = new BankAccount(30); 

print "account created, current balance is: ", $adrian->getBalance, "\n"; 

$adrian->deposit(20); 

print "deposit 20, current balance now: ", $adrian->getBalance, "\n"; 

$adrian->withdraw(10); 

print "withdraw 10, balance becomes: ", $adrian->getBalance, "\n"; 

frilled.cs.indiana.edu%ls -ld BankAccount.pm test
-rwx------   1 dgerman       507 Sep 25 13:56 BankAccount.pm
-rwx------   1 dgerman       335 Sep 25 13:53 test
frilled.cs.indiana.edu%./test
account created, current balance is: 30
deposit 20, current balance now: 50
withdraw 10, balance becomes: 40
frilled.cs.indiana.edu%

And now the actual lab, followed by the lab assignment.

Here are some examples with CGI.pm

First, the simplest possible program (equivalent to process, or readParse)

#!/usr/bin/perl

use CGI; 

$query = new CGI; 

print $query->header, 

      $query->start_html, 

      $query->Dump, 

      $query->end_html; 

Here's documentation for CGI.pm.

And more examples.

All forms elements with CGI.pm methods:

#!/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; 
}

#!/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; 
  exit; 
} 

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; 
}

Note that the image acts as a submit button so we could not make this part of the form from the example above (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;           

#!/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 qq{ Browse for a text file and push proceed to send it 
  to me. The file needs to be a plain ASCII (text) file. After 
  submission the file will be processed as follows: the vowels 
  will appear in red, the consonants in blue, and the rest of 
  the characters in light grey. The file will be returned to 
  your browser for display. Please use the Browse button below 
  to locate the file and send it to the processing script. <p> }; 
  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 ($line = <$file>) {
      # this is where you need to add code 
      print $line; 
    } print "</pre>"; 
  } else {
    print "No file specified"; 
  } 
} 
      
print $query->end_html;