Associative arrays (also called hashes)
help you remember things:
$DaysInMonth{'January'} = 31; $enrolled{'Joe College'} = 1;
$StudentName{654321} = 'Joe College';
$score{$studentno,$examno} = 89;
%whole_hash
Perl 5 allows combinations of these, such as lists of lists
and associative arrays of lists.
Name Conventions
Scalar variables start with '$', even when referring to an
array element. The variable name reference for a whole list
starts with '@', and the variable name reference for a whole
associative array starts with '%'.
Lists are indexed with square brackets enclosing a number,
normally starting with [0]. In Perl 5, negative subscripts
count from the end. Thus, $things[5]
is the 6th
element of array @things
, and
('Sun','Mon','Tue','Wed','Thu','Fri','Sat')[1]
equals 'Mon'
.
Associative arrays are indexed with curly brackets
enclosing a string. $whatever, @whatever, and %whatever are
three different variables.
@days = (31,28,31,30,31,30,31,31,30,31,30,31);
# A list with 12 elements.
$#days # Last index of @days; 11 for above list
$#days = 7; # shortens or lengthens list @days to 8 elements
@days # ($days[0], $days[1],... )
@days[3,4,5] # = (30,31,30)
@days{'a','c'} # same as ($days{'a'},$days{'c'})
%days # (key1, value1, key2, value2, ...)
Case is significant--"$FOO", "$Foo"
and "$foo" are all different variables. If a letter
or underscore is the first character after the $, @, or %, the
rest of the name may also contain digits and underscores. If
this character is a digit, the rest must be digits. Perl has
several dozen special variables whose second character is
non-alphanumeric. For example, $/ is the input record
separator, newline "\n" by default. An uninitialized
variable has a special "undefined" value which can
be detected by the function defined(). Undefined values
convert depending on context to 0, null, or false.
The variable "$_" Perl presumes
when needed variables are not specified. Thus:
<STDIN>; assigns a record from filehandle STDIN to $_
print; prints the curent value of $_
chop; removes the last character from $_
@things = split; parses $_ into white-space delimited
words, which become successive
elements of list @things.
$_, $1, $2, $3, and other implicit variables contribute to Perl
Paradox Number Two: What you don't see can help
you or hurt you. See Quick Reference Guide
Section 25, Special Variables.
Subroutines and functions
are referenced with an initial '&', which is optional if
reference is obviously a subroutine or function such as
following the sub, do, and sort directives:
sub square { return $_[0] ** 2; }
print "5 squared is ", &square(5);
Filehandles don't start with a special
character, and so as to not conflict with reserved words are
most reliably specified as uppercase names: INPUT, OUTPUT,
STDIN, STDOUT, STDERR, etc.
8. Literals and Operators
Example: Numbers and Characters
#!/usr/local/bin/perl
print '007',' has been portrayed by at least ', 004, ' actors. ';
print 7+3, ' ', 7*3, ' ', 7/3, ' ', 7%3, ' ', 7**3, ' ';
$x = 7;
print $x;
print ' Doesn\'t resolve variables like $x and backslashes \n. ';
print "Does resolve $x and backslash\n";
$y = "A line containing $x and ending with line feed.\n";
print $y;
$y = "Con" . "cat" . "enation!\n";
print $y;
This produces:
007 has been portrayed by at least 4 actors. 10 21
2.3333333333333335 1 343 7
Doesn't resolve variables like $x and backslashes \n. Does
resolve 7 and backslash
A line containing 7 and ending with line feed.
Concatenation!
Questions:
- Why does the output from the first few print statements
run together?
- Is it necessary to declare variables in Perl? Is it
possible?
Example: Comparisons
# The following "<<" variation of
# data input simplifies CGI forms.
$x = 'operator';
print <<THATSALL;
A common mistake: Confusing the assignment $x =
and the numeric comparison $x ==, and the character
comparison $x eq.
THATSALL
$x = 7;
if ($x == 7) { print "x is $x\n"; }
if ($x = 5) {
print "x is now $x,",
"the assignment is successful.\n";
}
$x = 'stuff';
if ($x eq 'stuff') {
print "Use eq, ne, lt, gt, etc for strings.\n";
}
This produces:
A common mistake: Confusing the assignment operator =
and the numeric comparison operator ==, and the character
comparison operator eq.
x is 7
x is now 5, the assignment is successful.
Use eq, ne, lt, gt, etc for strings.
Example: Ordinary Arrays
@stuff = ('This', 'is', 'a', 'list.');
print "Lists and strings are indexed from 0.\n";
print "So \$stuff[1] = $stuff[1], ",
"and \$#stuff = $#stuff.\n";
print @stuff,"\n";
print join('...',@stuff),"\n";
splice(@stuff, 3, 0, ('fine', 'little'));
print join('...',@stuff),"\n";
This produces:
Lists and strings are indexed from 0.
So $stuff[1] = is, and $#stuff = 3.
Thisisalist.
This...is...a...list.
This...is...a...fine...little...list.
Homework: Validate a date.
#!/usr/local/bin/perl
print "Enter numeric: month day year\n";
$_ = <STDIN>;
($month,$day,$year) = split;
Complete this program. Print an error message if the month is
not valid. Print an error message if the day is not valid for
the given month (31 is ok for January but not for February).
See if you can avoid using conditionals (if, unless, ?,...)
statements but instead use data structures.
Approach this incrementally. On the first draft, assume
that the user enters 3 numbers separated by spaces and that
February has 28 days. Subsequent refinements should account
for bad input and leap year. Finally, find a Perl builtin
function that converts a date to system time, and see how to
use that to validate time data generally.
Homework: Play with associative arrays.
Start with a few assignments like:
$name{12345} = 'John Doe';
$name{24680} = 'Jane Smith';
Print these scalars. What is the value of an associative array
element that has never been assigned? What happens if you
assign an associative array to a scalar? What happens if you
assign an associative array to a normal array?
$blunk = %name;
@persons = %name;
print '$blunk=',$blunk,', @persons=',
join(', ',@persons),"\n";
What happens if you assign a normal array to an associative
array?
9. Loops and I/O
Example: Command Line Values and Iterative Loops
print "$#ARGV is the subscript of the ",
"last command argument.\n";
# Iterate on numeric subscript 0 to $#ARGV:
for ($i=0; $i <= $#ARGV; $i++) {
print "Argument $i is $ARGV[$i].\n";
}
# A variation on the preceding loop:
foreach $item (@ARGV) {
print "The word is: $item.\n";
}
# A similar variation, using the
# "Default Scalar Variable" $_ :
foreach (@ARGV) {
print "Say: $_.\n";
}
Demonstration:
> perl example5.pl Gooood morning, Columbia!
2 is the subscript of the last command argument.
Argument 0 is Gooood.
Argument 1 is morning,.
Argument 2 is Columbia!.
The word is: Gooood.
The word is: morning,.
The word is: Columbia!.
Say: Gooood.
Say: morning,.
Say: Columbia!.
Example: Standard I/O
print STDOUT "Tell me something: ";
while ($input = <STDIN>) {
print STDOUT "You said, quote: $input endquote\n";
chop $input;
print STDOUT "Without the newline: $input endquote\n";
if ($input eq '') { print STDERR "Null input!\n"; }
print STDOUT "Tell me more, or ^D to end:\n";
}
print STDOUT "That's all!\n";
Note 1: The while
statement's condition is an
assignment statement: assign the next record from standard
input to the variable $input. On end of file, this will assign
not a null value but an "undefined" value. An
undefined value in the context of a condition evaluates to
"false". So the "while ($input = <STDIN>)
"
does three things: gets a record, assigns it to $input, and
tests whether $input is undefined. In other contexts, Perl
treats an undefined variable as null or zero. Thus, if $i
is not initialized, $i++
sets $i
to
1. Perl Paradox Number Three: Side effects can yield an
elegant face or a pain in the rear.
Note 2: Data records are by default terminated by a newline
character "\n" which in the above example is
included as the last character of variable $input. The
"chop" function removes the last character of its
argument. Perl 5 introduces a "chomp" function that
removes the last characters of a variable only if they are the
currently defined end-of-record sequence, which is defined in
the special variable $/.
Demonstration:
> perl example6.pl
Tell me something: I'm warm.
You said, quote: I'm warm.
endquote
Without the newline: I'm warm. endquote
Tell me more, or ^D to end:
Can I have some water?
You said, quote: Can I have some water?
endquote
Without the newline: Can I have some water? endquote
Tell me more, or ^D to end:
You said, quote:
endquote
Without the newline: endquote
Null input!
Tell me more, or ^D to end:
^D
That's all!
Example: Perls, A Perl Shell, Calculator, & Learning
Tool
#!/usr/local/bin/perl
for (;;) {
print '(',join(', ',@ReSuLt),') ?';
last unless $InPuT = <STDIN>;
$? = ''; $@ = ''; $! = '';
@ReSuLt = eval $InPuT;
if ($?) { print 'status=',$?,' ' }
if ($@) { print 'errmsg=',$@,' ' }
if ($!) { print 'errno=',$!+0,': ',$!,' ' }
}
This reads a line from the terminal and executes it as a Perl
program. The "for (;;) {...}" makes an endless loop.
The "last unless" line might be equivalently
specified:
$InPuT = <STDIN>; # Get line from standard input.
if (! defined($InPuT)) {last;} # If no line, leave the loop.
The "eval" function in Perl evaluates a string as a
Perl program. "$@" is the Perl error message from
the last "eval" or "do".
Demonstration:
perls
() ?Howdy
(Howdy) ?2+5
(7) ?sqrt(2)
(1.4142135623730951) ?$x
() ?$x = sqrt(2)
(1.4142135623730951) ?$x + 5
(6.4142135623730949) ?1/0
errmsg=Illegal division by constant zero in file (eval) at line 2, next 2 tokens "0;"
() ?system 'date'
Fri Sep 27 10:02:43 CDT 1996
(0) ?$x = `date`
(Fri Sep 27 10:02:52 CDT 1996
) ?chop $x
(
) ?$x
(Fri Sep 27 10:02:52 CDT 1996) ?@y = split(/ /,$x)
(Fri, Sep, 27, 10:02:52, CDT, 1996) ?@y[1,2,5]
(Sep, 27, 1996) ?localtime()
(37, 4, 10, 27, 8, 96, 5, 270, 1) ?
() ?foreach (1..10) {print sqrt(),' '}
1 1.4142135623730951 1.7320508075688772 2 2.2360679774997898
2.4494897427831779 2.6457513110645907 2.8284271247461903 3 3.1622776601683795
() ?exit
Example: File I/O
#!/usr/local/bin/perl
# Function: Reverse each line of a file
# 1: Get command line values:
if ($#ARGV !=1) {
die "Usage: $0 inputfile outputfile\n";
}
($infile,$outfile) = @ARGV;
if (! -r $infile) {
die "Can't read input $infile\n";
}
if (! -f $infile) {
die "Input $infile is not a plain file\n";
}
# 2: Validate files
# Or statements "||" short-circuit, so that if an early part
# evaluates as true, Perl doesn't bother to evaluate the rest.
# Here, if the file opens successfully, we don't abort:
open(INPUT,"<$infile") ||
die "Can't input $infile $!";
if ( -e $outfile) {
print STDERR "Output file $outfile exists!\n";
until ($ans eq 'r' || $ans eq 'a' || $ans eq 'e' ) {
print STDERR "replace, append, or exit? ";
$ans = getc(STDIN);
}
if ($ans eq 'e') {exit}
}
if ($ans eq 'a') {$mode='>>'}
else {$mode='>'}
open(OUTPUT,"$mode$outfile") ||
die "Can't output $outfile $!";
# 3: Read input, reverse each line, output it.
while (<INPUT>) {
chop $_;
$_ = reverse $_;
print OUTPUT $_,"\n";
}
# 4: Done!
close INPUT,OUTPUT;
exit;
10. Data-Processing: Grade Book Example
This example produces a score summary report by combining
data from a simple file of student info and a file of their
scores.
Input file "stufile" is delimited with
colons. Fields are Student ID, Name, Year:
123456:Washington,George:SR
246802:Lincoln,Abraham "Abe":SO
357913:Jefferson,Thomas:JR
212121:Roosevelt,Theodore "Teddy":SO
Input file "scorefile" is delimited with
blanks. Fields are Student ID, Exam number, Score on exam.
Note that Abe is missing exam 2:
123456 1 98
212121 1 86
246802 1 89
357913 1 90
123456 2 96
212121 2 88
357913 2 92
123456 3 97
212121 3 96
246802 3 95
357913 3 94
The desired report:
Stu-ID Name... 1 2 3 Totals:
357913 Jefferson,Thomas 90 92 94 276
246802 Lincoln,Abraham "Abe" 89 95 184
212121 Roosevelt,Theodore "Teddy" 86 88 96 270
123456 Washington,George 98 96 97 291
Totals: 363 276 382
The program that made this report:
#!/usr/local/bin/perl
# Gradebook - demonstrates I/O, associative
# arrays, sorting, and report formatting.
# This accommodates any number of exams and students
# and missing data. Input files are:
$stufile='stufile';
$scorefile='scorefile';
# If file opens successfully, this evaluates as "true", and Perl
# does not evaluate rest of the "or" "||"
open (NAMES,"<$stufile")
|| die "Can't open $stufile $!";
open (SCORES,"<$scorefile")
|| die "Can't open $scorefile $!";
# Build an associative array of student info
# keyed by student number
while (<NAMES>) {
($stuid,$name,$year) = split(':',$_);
$name{$stuid}=$name;
if (length($name)>$maxnamelength) {
$maxnamelength=length($name);
}
}
close NAMES;
# Build a table from the test scores:
while (<SCORES>) {
($stuid,$examno,$score) = split;
$score{$stuid,$examno} = $score;
if ($examno > $maxexamno) {
$maxexamno = $examno;
}
}
close SCORES;
# Print the report from accumulated data!
printf "%6s %-${maxnamelength}s ",
'Stu-ID','Name...';
foreach $examno (1..$maxexamno) {
printf "%4d",$examno;
}
printf "%10s\n\n",'Totals:';
# Subroutine "byname" is used to sort the %name array.
# The "sort" function gives variables $a and $b to
# subroutines it calls.
# "x cmp y" function returns -1 if x<y, 0 if x=y,
# +1 if x>y. See the Perl documentation for details.
sub byname { $name{$a} cmp $name{$b} }
# Order student IDs so the names appear alphabetically:
foreach $stuid ( sort byname keys(%name) ) {
# Print scores for a student, and a total:
printf "%6d %-${maxnamelength}s ",
$stuid,$name{$stuid};
$total = 0;
foreach $examno (1..$maxexamno) {
printf "%4s",$score{$stuid,$examno};
$total += $score{$stuid,$examno};
$examtot{$examno} += $score{$stuid,$examno};
}
printf "%10d\n",$total;
}
printf "\n%6s %${maxnamelength}s ",'',"Totals: ";
foreach $examno (1..$maxexamno) {
printf "%4d",$examtot{$examno};
}
print "\n";
exit(0);
Perl allows an associative array to be "tied" to
a genuine database, such that expressions like $record = $student{$key}
use the database. See the "dbm" and "tie"
functions.
11. Pipe I/O and System Calls
#!/usr/local/bin/perl
# Report on disk usage under specified files
# The Unix command "du -sk ..." (on BSD Unix, "du -s ...")
# produces a series of lines:
# 1942 bin
# 2981 etc
# ...
# listing the K bytes used under each file or directory.
# It doesn't show other information, such as the
# modification date or owner.
# This program gets du's kbytes and filename, and merges
# this info with other useful information for each file.
#
$files = join(' ',@ARGV);
# The trailing pipe "|" directs command output
# into our program:
if (! open (DUPIPE,"du -sk $files | sort -nr |")) {
die "Can't run du! $!\n";
}
printf "%8s %-8s %-16s %8s %s\n",
'K-bytes','Login','Name','Modified','File';
while (<DUPIPE>) {
# parse the du info:
($kbytes, $filename) = split;
# Call system to look up file info like "ls" does:
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,
$size,$atime,$mtime,$ctime)
= stat($filename);
# Call system to associate login & name with uid:
if ($uid != $previous_uid) {
($login,$passwd,$uid,$gid,$quota,$comment,
$realname,$dir,$shell) = getpwuid($uid);
($realname) = split(',',substr($realname,0,20));
$previous_uid = $uid;
}
# Convert the modification-time to readable form:
($sec,$min,$hour,$mday,$mon,$myear) = localtime($mtime);
$mmonth = $mon+1;
printf "%8s %-8s %-16s %02s-%02d-%02d %s\n",
$kbytes, $login, $realname,
$myear, $mmonth, $mday, $filename;
}
Demonstration Output
K-bytes Login Name Modified File
40788 c527100 Fred Flintstone 95-10-05 c527100
32685 c565060 Peter Parker 95-10-05 c565060
24932 c579818 Clark Kent 95-10-06 c579818
15388 c576657 Lois Lane 95-10-06 c576657
9462 c572038 Bruce Wayne 95-10-06 c572038
8381 c517401 Eric McGregor 95-10-05 c517401
7022 c594912 Asterisk de Gaul 95-10-05 c594912
12. Matching
Matching involves use of patterns called "regular
expressions". This, as you will see, leads to Perl
Paradox Number Four: Regular expressions aren't. See
sections 13 and 14 of the Quick Reference.
The =~ operator performs pattern matching
and substitution. For example, if:
$s = 'One if by land and two if by sea';
then:
if ($s =~ /if by la/) {print "YES"}
else {print "NO"}
prints "YES", because the string $s matches the
simple constant pattern "if by la".
if ($s =~ /one/) {print "YES"}
else {print "NO"}
prints "NO", because the string does not match the
pattern. However, by adding the "i" option to ignore
case, we would get a "YES" from the following:
if ($s =~ /one/i) {print "YES"}
else {print "NO"}
Patterns can contain a mind-boggling variety of special
directions that facilitate very general matching. See Perl
Reference Guide section 13, Regular Expressions. For
example, a period matches any character (except the "newline"
\n character).
if ($x =~ /l.mp/) {print "YES"}
would print "YES" for $x = "lamp",
"lump", "slumped", but not for $x = "lmp"
or "less amperes".
Parentheses () group pattern elements. An asterisk * means
that the preceding character, element, or group of elements
may occur zero times, one time, or many times. Similarly, a
plus + means that the preceding element or group of elements
must occur at least once. A question mark ? matches zero or
one times. So:
/fr.*nd/ matches "frnd", "friend", "front and back"
/fr.+nd/ matches "frond", "friend", "front and back"
but not "frnd".
/10*1/ matches "11", "101", "1001", "100000001".
/b(an)*a/ matches "ba", "bana", "banana", "banananana"
/flo?at/ matches "flat" and "float"
but not "flooat"
Square brackets [ ] match a class of single characters.
[0123456789] matches any single digit
[0-9] matches any single digit
[0-9]+ matches any sequence of one or more digits
[a-z]+ matches any lowercase word
[A-Z]+ matches any uppercase word
[ab n]* matches the null string "", "b",
any number of blanks, "nab a banana"
[^...] matches characters that are not
"...":
[^0-9] matches any non-digit character.
Curly braces allow more precise specification of repeated
fields. For example [0-9]{6}
matches any sequence
of 6 digits, and [0-9]{6,10}
matches any sequence
of 6 to 10 digits.
Patterns float, unless anchored. The caret ^ (outside [ ])
anchors a pattern to the beginning, and dollar-sign $ anchors
a pattern at the end, so:
/at/ matches "at", "attention", "flat", & "flatter"
/^at/ matches "at" & "attention" but not "flat"
/at$/ matches "at" & "flat", but not "attention"
/^at$/ matches "at" and nothing else.
/^at$/i matches "at", "At", "aT", and "AT".
/^[ \t]*$/ matches a "blank line", one that contains nothing
or any combination of blanks and tabs.
The Backslash. Other characters simply match
themselves, but the characters +?.*^$()[]{}|\
and
usually /
must be escaped with a backslash \
to be taken literally. Thus:
/10.2/ matches "10Q2", "1052", and "10.2"
/10\.2/ matches "10.2" but not "10Q2" or "1052"
/\*+/ matches one or more asterisks
/A:\\DIR/ matches "A:\DIR"
/\/usr\/bin/ matches "/usr/bin"
If a backslash preceeds an alphanumeric character, this
sequence takes a special meaning, typically a short form of a
[ ] character class. For example, \d is the same as the [0-9]
digits character class.
/[-+]?\d*\.?\d*/ is the same as
/[-+]?[0-9]*\.?\d*/
Either of the above matches decimal numbers: "-150",
"-4.13", "3.1415", "+0000.00",
etc.
A simple \s
specifies "white space",
the same as the character class [ \t\n\r\f]
(blank, tab, newline, carriage return,form-feed). A character
may be specified in hexadecimal as a \x
followed
by two hexadecimal digits; \x1b is the ESC character.
A vertical bar | specifies "or".
if ($answer =~ /^y|^yes|^yeah/i ) {
print "Affirmative!";
}
prints "Affirmative!" for $answer equal to
"y" or "yes" or "yeah" (or
"Y", "YeS", or "yessireebob, that's
right").
13. Parsing
See the Perl Reference Guide section 14,
Search and replace functions. When you include parenthesis ( )
in a matched string, the matching text in the parenthesis may
subsequently be referenced via variables $1, $2, $3, ... for
each left parenthesis encountered. These matches can also be
assigned as sequential values of an array.
#!/usr/local/bin/perl -w
$s = 'There is 1 date 10/25/95 in here somewhere.';
print "\$s=$s\n";
$s =~ /(\d{1,2})\/(\d{1,2})\/(\d{2,4})/;
print "Trick 1: \$1=$1, \$2=$2, \$3=$3,\n",
" \$\`=",$`," \$\'=",$',"\n";
($mo, $day, $year) =
( $s =~ /(\d{1,2})\/(\d{1,2})\/(\d{2,4})/ );
print "Trick 2: \$mo=$mo, \$day=$day, \$year=$year.\n";
($wholedate,$mo, $day, $year) =
( $s =~ /((\d{1,2})\/(\d{1,2})\/(\d{2,4}))/ );
print "Trick 3: \$wholedate=$wholedate, \$mo=$mo, ",
"\$day=$day, \$year=$year.\n";
Results of above:
$s=There is 1 date 10/25/95 in here somewhere.
Trick 1: $1=10, $2=25, $3=95,
$`=There is 1 date $'= in here somewhere.
Trick 2: $mo=10, $day=25, $year=95.
Trick 3: $wholedate=10/25/95, $mo=10, $day=25, $year=95.
Note that when patterns are matched in an array context as in
Tricks 2 and 3, $1, $2, ..., and $`, $', and $& are not
set.
Regular expressions are greedy. In the following
example we try to match whatever is between "<"
and ">" :
#!/usr/local/bin/perl -w
$s = 'Beware of <STRONG>greedy</strong> regular expressions.';
print "\$s=$s\n";
($m) = ( $s =~ /<(.*)>/ );
print "Try 1: \$m=$m\n";
($m) = ( $s =~ /<([^>]*)>/ );
print "Try 2: \$m=$m\n";
This results in:
$s=Beware of <STRONG>greedy</strong> regular expressions.
Try 1: $m=STRONG>greedy</strong
Try 2: $m=STRONG
Homework: Parsing and Reporting
1. See preceding "Grade Book" example. Using the
same "stufile" input, print a list of students
ordered by family name, with any quoted nickname listed in
place of the given name, and family name last. Produce output
like this:
Student-ID Year Name
357913 JR Thomas Jefferson
246802 SO Abe Lincoln
212121 SO Teddy Roosevelt
123456 SR George Washington
14. Simple CGI
For an introduction to Common Gateway Interface, see http://hoohoo.ncsa.uiuc.edu/cgi/
and http://www.ncsa.uiuc.edu/SDG/Software/Mosaic/Docs/fill-out-forms/overview.html.
Example: Server Status Report
Let's start with a CGI program that takes no input but
produces output. The following Perl program reports the load
on the Web server, using the standard Unix commands
"hostname", "uptime", and "w".
The output would look something like this:
What's Happening at sgi1
7:09pm up 1 day, 18:38, 4 users, load average: 0.08,
0.21, 0.53
c676828 q0 128.206.58.85 3 pico
c676828 ftp UNKNOWN@128.20 -
ccgreg q1 monad.missouri tcsh
c552997 q5 mizzou-ts2.mis telnet
|
Here's the program that produced it:
#!/usr/local/bin/perl
# Send error messages to the user, not system log
open(STDERR,'<&STDOUT'); $| = 1;
# Headers terminate by a null line:
print "Content-type: text/html\n\n";
$host = `hostname`;
chop $host;
$uptime = `uptime`;
$w = `w -s -h`;
print <<BUNCHASTUFF;
<HTML><HEAD>
<TITLE>$host Status</TITLE>
</HEAD><BODY>
<H1>What's Happening at $host</H1>
$uptime
<PRE>$w</PRE>
<HR>
</BODY></HTML>
BUNCHASTUFF
exit;
Suppose user "bitman" wants to store this program
on MU's SHOWME and SGI webservers, which use the
"Apache" server software, configured for "CGI
anywhere". If bitman doesn't already have a web
directory, he should create one with these Unix commands:
mkdir ~/www; chmod a+x ~ ~/www
Then the above program could be put in a file ~/www/status.cgi
,
and that file made readable and executable:
chmod a+rx ~/www/status.cgi
On the SHOWME server, the program would then be referenced
as: http://www.missouri.edu/~bitman/status.cgi
Example: Web Form
Here is the image of a World Wide Web Electronic Form:
Web Form Example
(From http://some.webserver.missouri.edu/~user/myform.cgi)
|
When something is entered and the submit button pressed,
here is a resulting screen:
Results of Form
(From http://some.webserver.missouri.edu/cgi-bin/myform)
Your ID Number is 196965, your name is G. K.
Johnson, and your favorite color is green.
_____________________________________________________
[Try
again]
|
Perl Program to Generate and Process Form
Here is the Perl program that generates both the form and the
response. It uses an external module called "cgi-lib.pl"
that is available from network Perl archives such as http://cgi-lib.stanford.edu/
or a local
copy.
#!/usr/local/bin/perl
# Send error messages to the user, not system log
open(STDERR,'<&STDOUT'); $| = 1
require "cgi-lib.pl"; # Get external subroutines
print &PrintHeader;
$script = $ENV{'SCRIPT_NAME'};
$webserver = $ENV{'SERVER_NAME'};
if (! &ReadParse(*input)) { &showform }
else { &readentries }
exit;
sub showform {
# If there is no input data, show the blank form
print <<EOF;
<HTML><HEAD>
<TITLE>Form Example, Part 1</TITLE>
</HEAD><BODY>
<H1>Web Form Example</H1>
<P>(From http://$webserver$script)
<FORM METHOD="POST"
ACTION=$script>
<PRE>
Enter your ID Number: <INPUT NAME=idnum>
Enter your Name: <INPUT NAME=name>
Select favorite Color: <SELECT NAME=color>
<OPTION>red<OPTION>green<OPTION>blue
</SELECT>
</PRE>
To submit the query, press this button:
<INPUT TYPE=submit VALUE="Submit Request">
</FORM>
</BODY></HTML>
EOF
} # End of sub showform #
sub readentries {
# Input data was detected. Echo back to form user.
print <<EOF;
<HTML><HEAD>
<TITLE>Form Example, Part 2</TITLE>
</HEAD><BODY>
<H1>Results of Form</H1>
<P>(From http://$webserver$script)
<P>Your ID Number is $input{'idnum'}, your name is $input{'name'},
and your favorite color is $input{'color'}.
<HR>
[<A HREF=$script>Try again</A>]
EOF
} # end of sub readentries #
15. Testing Perl Programs
Use the compiler -w
switch to warn about
identifiers that are referenced only once, uninitialized
scalars, redefined subroutines, undefined file handles,
probable confusion of "==" and "eq", and
other things. This can be coded in the magic cookie first
line:
#!/usr/local/bin/perl -w
As you write your program, put in print
statements to display variables as you proceed. Comment
"#" them out when you feel you don't need to see
their output.
CGI scripts require some special attention in testing.
MU's "showme" and "SGI" Web servers (www.missouri.edu
and www.cclabs.missouri.edu) use the Apache "sucgi"
facility. This causes CGI programs stored under your directory
~/www/ with file name ending ".cgi" to execute as
your own ID. On some other Web server the script does not
execute under your login ID! It executes under the ID of the
Web server, typically as user "nobody".
Thus a script that works at the command line may fail under
the Web server because: