}

Still More Perl


Functions

 sub header {
  my $title = shift @_;
  print << END_OF_HEADER;
 Content-Type: text/html

<html> <head> <title>$title</title> </head> <body> END_OF_HEADER; }


Function Parameters

 my ($x, $y, ...) = @_;

 my $title = shift @_;
 my $title = shift;	# @_ is the implied default


Return Value

 sub square {
  my $x = shift @_;
  $x * $x; 
 }

 sub grade {
  my $marks = shift @_;
  if ($marks >= 90) {
	return "A+";
  } elsif ($marks >= 85) {
	return "A";
  } elsif ($marks >= 80) {
	return "A-";
  } elsif ...
	# other cases
  }
 }

 $result = square($value);
 print "Square of $value is $result\n";

$grade = &grade(95); print "Final grade: $grade\n";


Functions and Libraries

 1;


Function Libraries (Example)

 sub Header {
	my $title = shift(@_);
	print "Content-Type: text/html\n\n";
	print "<html><head><title>";
	print "$title";
	print "</title></head><body>\n";
 }

sub Footer { print "\n</body></html>"; }

1; # OK


Importing a Library

 require "header_footer.lib";

 Header();
 print << END_OF_BODY;
 <h1 align="center">Order confirmation</h1>
 Thank you for your order.
 Your confirmation number is $orderId.
 END_OF_BODY
 Footer();


Files and Directories

 FILE

 open(FILE, "/home/4user3/~bob/orders.log"); # read
 open(FILE, "</home/4user3/~bob/orders.log"); # read (< is optional)
 open(FILE, ">/home/4user3/~bob/orders.log"); # write
 open(FILE, ">>/home/4user3/~bob/orders.log"); # append

 close(FILE);


Error Handlers

 open(FILE, ">>/home/4user3/~bob/orders.log")
  || &errorMessage("cannot open file orders.log");

sub errorMessage { my $message = shift @_; print "Content-Type: text/html\n\n"; print $message; exit; # exit from the script }


Writing to a File

 open(FILE, ">/home/4user3/~bob/orders.log");
 print FILE "Order $oid was shipped $date.\n";  # writes to FILE
 print "Your order was shipped today.\n"; 


Gaining Exclusive Access

 $LOCK = 2;
 $UNLOCK = 8;

open(FILE, ">>/home/4user3/~bob/orders.log"); flock(FILE, $LOCK); print FILE"Order 123 shipped 02/18/2002."; flock(FILE, $UNLOCK);


Reading from a File

 open(FILE, "/home/4user3/~bob/orders.log");
 while (<FILE>) {
	# process the line
	# each line will be stored in the variable $_
 }
 close(FILE);

 open(FILE, "/home/4user3/~bob/orders.log");
 @messages = <FILE>;
 close(FILE);

 undef $/;	# special variable that defines end-of-line character
 open(FILE, "/home/4user3/~bob/orders.log");
 $log = <FILE>;
 close(FILE);


Renaming and Removing a File

 $oldName = "orders.log";
 $newName = "messages.log";
 rename($oldName, $newName);

 $fileName = "orders.log";
 unlink($fileName);



Checking the Status of a File

 if (-option fileName) {
  ...
 }

 if (-d "some/directory")


More CGI


Decoding Form Data

  1. Read the query string from $ENV{QUERY_STRING}
  2. If $ENV{REQUEST_METHOD} is POST, determine length of request body and read from STDIN
  3. Append data to data read from query string, if present
  4. Split the result on the "&" character
  5. Split each resulting name-value pair on the "=" character
  6. Decode the URL-encoded characters in name and value
  7. Associate each name with its value(s)


Rolling Your Own

 my $query;

# Read data from GET if ($ENV{'REQUEST_METHOD'} eq 'GET') { $query = $ENV{'QUERY_STRING'}; }

# Read data from POST elsif ($ENV{'REQUEST_METHOD'} eq 'POST') { read(STDIN, $query, $ENV{'CONTENT_LENGTH'}); $query = $ENV{'QUERY_STRING'} . "&" . $query if ($ENV{'QUERY_STRING'}); }

# Parse the query foreach $_ (split(/&/, $query)) { tr/+/ /; # we haven't met yet (see pattern matching) s/\%(..)/pack(C, hex($1))/ge; ($_, $param) = split (/=/, $_); if ($param{$_}) { $param{$_} .= ",$param"; } else { $param{$_} = $param; } }

1;


Using Our Library



 require "ParseInput.lib";

# Print mime header print "Content-type: text/html\n\n";

# Check input parameters unless ($param{'user'} && $param{'email'}) { print "Must fill out user and email"; exit; }

# Process form print <<END_OF_UPDATE; <h1>Success</h1> Thanks for your input. The following update has been made: <p> <table border> <tr> <td>User: <td>$param{'user'} <tr> <td>Email: <td>$param{'email'} </table> END_OF_UPDATE


CGI.pm and its Uses


Standard and Object-Oriented Syntax

 use CGI;

my $q = new CGI; my $name = $q->param("name"); print $q->header("text/html"), $q->start_html("Welcome"), $q->p("Welcome back, $name!"), $q->end_html;

 use CGI qw( :standard );

my $name = param("name"); print header("text/html"), start_html("Welcome"), p("Welcome back, $name!"), end_html;



Getting Information About the Environment

 content_type		CONTENT_TYPE
 path_info		PATH_INFO
 query_string		QUERY_STRING
 request_method  	REQUEST_METHOD
 script_name		SCRIPT_NAME
 Accept	  	HTTP_ACCEPT		# actually uppercase

 my $path = $q->path_info;


Accessing Form Parameters

 foreach $name ($q->param) {
	print "$name";
 }

 $email = $q->param("email");
 print "Email: $email";

 $color  = $q->param("color");	# just the first one
 @colors = $q->param("color");	# list of all colors



Modifying Parameters

 $q->param(sku => "102030");
 $q->param(interests => 
	"music", "dining", "sport");
 $q->delete("age");
 $q->delete_all;



Modifying Parameters (Example)

 foreach ($q->param) {
	$q->param($1 => 1) if /(.*)\.x/;	# see pattern matching
 }