Spring Semester 2004


Lecture Notes Nine: Object-oriented perl and CGI.pm.
Let's take a look at Object-Oriented Programming with Perl.

We assume a loose A201 background, so let's describe what we want to do in those terms.

  1. To create a class we do this:
    burrowww.cs.indiana.edu% pico BankAccount.java
    burrowww.cs.indiana.edu% ls -ld Bank*.java
    -rw-r--r--   1 dgerman  faculty        25 Feb  5 10:46 BankAccount.java
    burrowww.cs.indiana.edu% cat BankAccount.java
    class BankAccount {
      
    }
    burrowww.cs.indiana.edu% javac Bank*.java
    burrowww.cs.indiana.edu% ls -ld Bank*
    -rw-r--r--   1 dgerman  faculty       196 Feb  5 10:47 BankAccount.class
    -rw-r--r--   1 dgerman  faculty        25 Feb  5 10:46 BankAccount.java
    burrowww.cs.indiana.edu%
    Note: When we do this we are working with the default package. Let's say you don't like packages, and want to avoid creating any, well, even then a default one will be created for you, and you won't be able to go around that as the package is the fundamental compilation unit in Java. (To create your own package you use package at the top of the file. )

  2. To define instance methods (and variables) we do this:
    burrowww.cs.indiana.edu% pico BankAccount.java
    burrowww.cs.indiana.edu% cat BankAccount.java
    class BankAccount {
      double balance; 
      double getBalance() { return balance; } 
      void deposit(double amount) { balance += amount; } 
      void withdraw(double amount) { balance -= amount; } 
    }
    burrowww.cs.indiana.edu% javac BankAccount.java
    burrowww.cs.indiana.edu% 
  3. To define a constructor we do this:
    burrowww.cs.indiana.edu% pico BankAccount.java
    burrowww.cs.indiana.edu% cat BankAccount.java
    class BankAccount {
      double balance; 
      double getBalance() { return balance; }   
      void deposit(double amount) { balance += amount; } 
      void withdraw(double amount) { balance -= amount; } 
      BankAccount (double balance) { this.balance = balance; }
    }
    burrowww.cs.indiana.edu% javac BankAccount.java
    burrowww.cs.indiana.edu% 
  4. To test the class we do this:
    burrowww.cs.indiana.edu% pico Test.java
    burrowww.cs.indiana.edu% cat Test.java
    import BankAccount; // no need to, really, if the two  
                        // classes are in the same folder 
    class Test {
      public static void main(String[] args) {
        BankAccount adrian = new BankAccount(30); 
        System.out.println("Account created, current balance is: " +  
                           adrian.getBalance());  
        adrian.deposit(20);  
        System.out.println("Deposit 20, current balance now: " + 
                           adrian.getBalance());
        adrian.withdraw(10);  
        System.out.println("Withdraw 10, balance becomes: " + 
                           adrian.getBalance()); 
    
      }
    }
    burrowww.cs.indiana.edu% 
    burrowww.cs.indiana.edu% javac Test.java
    burrowww.cs.indiana.edu% java Test
    Account created, current balance is: 30.0
    Deposit 20, current balance now: 50.0
    Withdraw 10, balance becomes: 40.0
    burrowww.cs.indiana.edu% 
    Another Note: We don't need a separate class for the testing, but it's somewhat clearer that way, I hope. We could have just as well put the main method in BankAccount and work with just one class. You can define as many main methods as classes, and run any of them.

Suggested exercises and review.

What follows is a brief OOPerl summary, done in the exact same way:

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; # restrict unsafe constructs 
use warnings; 

frilled.cs.indiana.edu%
Note: If no import list is given to use strict, all possible restrictions upon unsafe Perl constructs are imposed. This is the safest mode to operate in, but is sometimes too strict for casual programming. Currently there are three possible things to be strict about: refs, vars, and subs (this FYI only).

Rule 2: To create a method, write a subroutine.

package BankAccount; 

use strict;
use warnings; 

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
Questions: The answer to the last question is included below.

Rule 3: To create an object bless a referent (see the hashtable?)

package BankAccount; 

use strict;
use warnings; 

sub new {
    my $class = shift;   
    my $balance = shift; 
    my $account = {  # my instance variable (a hashtable of one)
      balance => $balance 
    }; 
    bless $account, $class; # let the hashtable become an object of this class
    return $account;  # we never do this in Java
}# this is the constructor... 

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
          # it 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"; 
Let's see it running.

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.

Our CGI scripts now follow this template:

#!/usr/bin/perl
&printHeader; 
$me = $ENV{"SCRIPT_NAME"}; 
print qq{ 
  <form method="POST" action="$me">
     Please enter a username <input type="text" name="uname" size=8> 
     and a password <input type="password" name="pword" size=14> then 
     push <input type="submit" value="Proceed"> 
  </form>
}; 
&readParse; 
print "<table border cellpadding=3>"; 
foreach $key (keys %in) {
  print "<tr><td>", $key, "<td>", $in{$key}; 
}
print "</table>"; 
&printTrailer; 
                     
sub printHeader  { print "Content-type: text/html\n\n<html><body>"; } 

sub printTrailer { print "</body></html>"; }

sub readParse {
  if      ($ENV{"REQUEST_METHOD"} eq 'GET' ) {
    $input = $ENV{"QUERY_STRING"}; 
  } elsif ($ENV{"REQUEST_METHOD"} eq 'POST') {
    read (STDIN, $input, $ENV{"CONTENT_LENGTH"}); 
  } else {
    print "Unsupported method."; 
    &printTrailer; 
    exit; 
  } 
  @input = split(/\&/, $input); 
  foreach $elem (@input) {
    $elem =~ s/%(..)/chr(hex($1))/ge;
    $elem =~ s/\+/ /g; 
    ($key, $value) = split(/\=/, $elem); 
    $in{$key} = $value; 
  } 
} 
Try it from here (with POST) or from here (with GET).

(Make sure you check the code behind the second link, please).

We can do better than our simple module, and here's CGI.pm, the standard.

Brief overview of CGI.pm and CGI.

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; 
Notice the object notation. Here's documentation for CGI.pm.

Here are four more examples with CGI.pm.

(The document indexed above contains many more).

EXAMPLE ONE: 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; 
}
Please run code above (and the next three) and experiment with them.

(You can test my code, above, here.)

EXAMPLE TWO: Feedback form with CGI.pm (comments mailed to you by script):

#!/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, "| mailx $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; 
}

(You can try my code here. It sends me and you a copy of the message).

EXAMPLE THREE: Working with clickable images using CGI.pm (is easy, see below).

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;           

Try my code here.

Before we go into the last example let's examine a simple program:

#!/usr/bin/perl
use CGI;
$m = new CGI; 

$da = $m->param('day'); 
$mo = $m->param('month'); 

print $m->header; 
print $m->start_html(-bgcolor=>'navyblue'); 
print "<hr>Hello! ($da) ($mo) <hr>"; 
open (MYLOG, "/u/dgerman/apache/apache_1.3.22/logs/access_log"); 
while ($line = <MYLOG>) { 

  $line =~ s/\[([^\]]+)\]//;

  $line = $1;  
  $line =~ s/2002.+//g; 
  # print $line, "<br>"; 

  if ($line =~ /$da\//) {
    $freq{$line} += 1; 
  } elsif ($line =~ /\/$mo\//) {
    $freq{$line} += 1;
  }
}
close(MYLOG);  

foreach $key (sort { $freq{$b} <=> $freq{$a} } keys %freq) {

  print $key, " : ", $freq{$key}, " <br>"; 

}

print $m->end_html;
Try my code here. (What's the program doing?)

And another example (let's call this program labFive):

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

You can try it here. (It uploads a file, and uses the same interface for file access as for regular files).

What follows used to be a lab assignment.

Just think about it. It should be easy.

Another question is: can you summarize your access_log on-line?


Last updated: Jan 26, 2004 by Adrian German for A348/A548