Chapter 13
Web Sites and Perl
CONTENTS
Throughout this book we have described Perl so that you can use
it to create a dynamic interactive Web site. In this chapter we'll
combine what we've learned about Perl. Drawn from the snippets
of code and subroutines used in the previous chapters of this
book, this chapter examines a fully operational site. With this
example site you can see exactly where Perl fits into your Web
server. This information may seem more like review to some of
you, but the best way to see how Perl can be applied to your site
is to demonstrate it on a full Web site, with CGI Perl scripts
included.
To demonstrate applying Perl to a Web site, the first thing to
establish is the site itself. For the purposes of this book, we
will use a mythical music recording label company, Goo Goo Records.
Goo Goo Records markets and sells popular music, and has expanded
its business to include the WWW. Their site provides marketing
and sales information to its Web site's users, develops a mailing
list from these users, and makes special sneak previews available
to its members, among many other features.
To create the site, the company bought a computer to use as the
Web server. After installing Windows NT, Perl for Windows NT,
and the EMWAC server software, the Web Master created the root
directory for the site on the C drive, naming it "googoo."
All of the files for the site, including the Perl scripts, are
housed in this directory. The Perl scripts are kept in the directory
path "C:\googoo\" with the CGI scripts having the path
"C:\googoo\cgi-bin\." The database that runs off the
site is housed in the directory under the same root "/googoo/,"
named "ggdata." It is important that the database data
also be under a directory of the document root. It won't make
any difference for searching if it isn't (Perl will be able to
search anywhere in the directory structure), but if you want to
access anything (like to view an image, or to download a file)
it has to be accessable to the browser, meaning it has to be under
the document root. The browser would have to access the files
with this URL - http://www.googoo.com/data/files/image.zip.
When users open this location, http://www.googoo.com, they arrive
at Goo Goo Records' Home Page, which resembles Figure 13.1. The
file is kept in the "googoo" directory, with the file
name index.htm. The HTML itself looks like this:
Figure 13.1 : The Goo Goo Records home Page.
<HTML>
<HEAD>
<TITLE>
Goo Goo Records Home Page
</TITLE>
<HEAD>
<BODY bgcolor="#40E0D0" Text="#191970" >
<META Name="keywords" Content="music, sound clips, video clips, avi, wav, alternative,
underground, punk, pop music, funk, contests, prizes">
<CENTER>
<H1>Welcome To Goo Goo Records!</H1>
<IMG Src="http://www.googoo.com/cgi-bin/dino.pl">
<HR>
<FORM METHOD=POST ACTION="http://www.googoo.com/cgi-bin/immap.pl">
<INPUT TYPE=IMAGE NAME="mapfile" IMG SRC="http://www.googoo.com/images/menubar.gif"
alt=" For site areas, please see below ">
</FORM>
</CENTER>
<P>
<B>To get started choose one of the following:
<UL>
<LI>Join the Goo Goo Site! Click <A HREF="join.htm">here</A> to become a member.
<LI>Get A Free Catalogue!Go<A HREF="request.htm"> here</A> and order one!
<LI>Jump Right In! Try <A HREF="access.htm"> this</A> link to access the Goo Goo site.
<LI>Scared? Then escape using <A HREF="escape.htm">piece of hypertext </A> to find a safe place to hide.
</UL>
</BODY>
</HTML>
You may notice the Goo Goo Records' Web site makes use of many
customizing elements in the HTML, like the designation of the
background color, and the imbedded <META> tag to help search
engines find the site.
The design of this site calls for the use of Perl right from the
start. There are three main features to the home page requiring
Perl: the image map, an animated logo, and access to a Members
Only area of the site.
The Logo
The Goo Goo Records logo has been animated so that the dinosaur
bursts out of the egg. In Figure 13.2, the logo is frozen with
the dinosaur just breaking out of the shell. This is accomplished
with the logo animating script "dino.pl" which is kept
in the CGI bin. You might recognize this script as being adapted
from the animated logo script anim.pl found in Chapter 7 The
images for the animation are kept in the "logo" directory
in the main site directory, giving it the directory path name
C:/googoo/logo. Each progessive image for the animation is labeled
with the file name "dino1.gif," "dino2.gif,"
and so forth.
Figure 13.2 : The Goo Goo Records animated logo.
To create this animation, the following Perl script is used:
#!/usr/bin/perl
# dino.pl
@files = ("dino1.gif","dino2.gif","dino3.gif","dino4.gif","dino5.gif","
dino6.gif","dino7.gif,"dino8.gif","dino-9.gif");
print "Content-Type: multipart/x-mixed-replace;boundary=myboundary\n\n";
print "--myboundary\n";
foreach $file (@files) {
print "Content-Type: image/gif\n\n";
open(LOGO,"$file");
print <LOGO>;
close(LOGO);
print "\n--myboundary\n";
sleep(1);
}
This simple script is quite similar to the animation script that
can be found in Chapter 6
The Image Map
At the top of the page, and as seen in Figure 13.3 as well, the
Image map script creates an image map of the different areas of
the Goo Goo Records site: the Membership Application, Escape Route,
and Catalogue Request, for example.
Figure 13.3 : The Goo Goo Records home page image map.
You may notice that the way an image map is created and used on
the Goo Goo Records' site is a little different from the way it
was demonstrated in Chapter 6 Previously we used an <A HREF>
call to the image map file. Instead, the Web Master has designed
a Perl script to define the image map. The Goo Goo Records' site
makes a call to a Perl program which defines the image map.
The scripts for the image map are as follows:
#!/usr/bin/perl
# immap.pl #############################################################
# This is the Image Map script
#Remember to create a file called mapfile.map (this must be put in your
# CGI-BIN directory) which lists your map file co-ordinates.
# Note that there will display a default page if the click was not within the
#specified area. The pages are just HTML pages associated with the hot-area
# and, the numbers are the co-ordinates. For the rectangle, the coordinartes
# are the upper left, and lower right (x,y) coordinates of the rectangle. For
# the circle, the first (x,y) co-ordinate is the centre of the circle, and the
# second is the (x,y) coordinate of any point on the edge of the circle.
# NOTE: The image pixel co-ordinates are in the negative direction, so pixel
# (0,0) is the at the upper left of the image.
#
###############################################################
if ($ENV{'REQUEST_METHOD'} EQ 'POST') {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs=split(/&/, $buffer); # This is the Name-Value pair splitter.. Put into $FORM array
foreach $pair (@pairs) {
($name,$value)=split(/=/,$pair);
$value=~tr/+/ /;
$value=~s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
$FORM{$name}=$value;
}
$url="http://www.googoo.com/"; # This is the URL for your site.
$name=(keys(%FORM))[1]; # Get the NAME field
# the coordinates come in as mapfile.x and mapfile.y
chop($name); # remove the x from "mapfile.x
$mapfile=$name."map"; # create the image map filename by adding .map
chop($name); # remove the '.' to get the bare name
$x=$FORM{"$name.x"}; # get the x
$y=$FORM{"$name.y"}; # and y co-ordinates
open(MAP,$mapfile); # open the map file and read line by line
while ($line=<MAP>) {
$dest=&circle($line) if $line=~/circ/i; # go
# to the circle or rectangle routine
$dest=&rect($line) if $line=~/rect/i;
# depending on which directive
if ($line=~/default/i) { # if it is the default,
$default=(split(/\s/,$line))[1]; # split the line and
# populate $default
}
break if $dest; # if we have found a destination page,
# break the loop
}
close(MAP); # close the map file
if ($dest) { # if we found a destination
print "Location: $url$dest\n\n"; # send them there.
}
elsif ($default) { # if we didn't, but we have a default page....
print "Location: $url$default\n\n";
# send them to the default
}
else { # Otherwise print the error message
print "Content-type: text/html\n\n";
print "<HTML>\n";
print "<title>Error - Image Map Error</title>\n";
print "<h1>Error: Image Map Error</h1>\n";
print "<P><hr><P>\n";
print "There was an error with the Image Map. Please\n";
print "contact GooGoo Records at <address><a
href=\"mailto:support@googoo.com\">support@googoo.com</a></address>\n";
print "</HTML>\n";
exit;
}
}
else { # if there were problems with the form, print an error.
print "Content-type: text/html\n\n";
print "<HTML>\n";
print "<title>Error - Image Map Error</title>\n";
print "<h1>Error: Image Map Error</h1>\n";
print "<P><hr><P>\n";
print "There was an error with the Image Map. Please\n";
print "contact GooGoo Records at <address><a
href=\"mailto:web@googoo.com\">web@googoo.com</a></address>\n";
print "</HTML>\n"; exit;
}
sub circle {
local($line)=@_;
local($dummy,$c1,$c2,$c1x,$c1y,$c2x,$c2y,$page,$r1,$r2);
($dummy,$page,$c1,$c2)=split(/\s/,$line);
#Split the line on spaces
($c1x,$c1y)=split(/,/,$c1); # Split the
# coordinates into x and y
($c2x,$c2y)=split(/,/,$c2);
$r1=sqrt((($c1x-$c2x)**2)+(($c1y-$c2y)**2));
# calculate the radius
$r2=sqrt((($c1x-$x)**2)+(($c1y-$y)**2));
# calculate the distance from($x,$y)
if ($r2<=$r1) { # if ($x,$y) is in the circle,
# return the page
return $page;
}
else {
# otherwise, return undef.
return undef;
}
}
Sensitive to those Web surfers who may have their browser's graphics
capabilities turned off, each of the pages indicated on the image
map is given a hypertext link right below. The text alternate
for the image map is "For site areas, please see below"
which is designated in the HTML for the page, and seen in Figure
13.4.
Figure 13.4 : Image map text alternate.
In the script there are provisions made for the use of circle
definitions on an image map. This is included in case the Goo
Goo Records' site requires an image map with circular definitions
instead of, or in addition to, the rectangular definitions already
being used with the current image map. This would save having
to rewrite the entire script in the future just to add the circle
to an image map.
The x and y coordinates for the image map and map
file refered to in this script, mapfile.map, are listed here:
default index.htm
rect join.htm 0,0 102,50
rect request.htm 102,0 213,50
rect access.htm 213,0 312,50
rect escape.htm 312,0 384,75
where a default page is included in the file. Each section of
the image map is assigned its own destination, or HTML document,
to link to.
When new users first find the Goo Goo Records site, and are unsure
whether they want to join, they may enter the site with limited
guest privileges. To set up guest access to the site, the member
name "guest" with password "guest" is added
to the site's membership database. The HTML for gaining access
to the site is found in the file "access.htm" and looks
like this:
<HTML>
<TITLE> Goo Goo Records Member Access</TITLE>
<BODY>
<H3>Goo Goo Records Web Site Member Access</H3>
<HR><P>
Please enter your username and password to access the great user stuff....<P>
<FORM METHOD=POST ACTION="http://www.googoo.com/cgi-bin/pass.pl">
UserName: <INPUT TYPE="TEXT" NAME="name" size=25><P>
Password: <INPUT TYPE="PASSWORD" NAME="password" size=25><P>
<INPUT TYPE=SUBMIT VALUE="Enter">
</FORM>
If you want to sample our site, enter "guest" as the member name, and "guest" as the
password for a limited tour of our many delights. If you want to apply for your own membership
to the Goo Goo Records site, please submit this <A HREF="new_member.htm">form.</A>
<HR>
<H3><A HREF"index.htm"><IMG SRC="logo.gif">Back to the Home Page!</A></H3>
</BODY>
</HTML>
This creates a page that resembles Figure 13.5, where the new
user is asked to enter his or her member name and password.
Figure 13.5 : Entering the user name and password.
The information given in this form is sent to the Perl script
"pass.pl," which is listed in the next section. If the
new user tries out the guest membership, they will be limited
to some areas of the site. An example of a restriction applying
to guest access is an inability to enter the Goo Goo Records'
Trivia Quiz for the chance to win prizes.
Users who have already registered by visiting "join.htm"
can gain full access to the Goo Goo Records Web site by entering
their member ID and password. When this data is sent to the Goo
Goo Records' Web server, a CGI script checks the membership database
to see if they are indeed registered, and provides them with the
access granted to a member, which is almost the entire site. The
script that checks for membership runs like this:
#!/usr/bin/perl
# pass.pl
# The user.db file has entries such as:
# guest:guest
# jonathan:mypassword
# joe:birthday
# This is not really security, this only makes
# the site more
# difficult to get the pages. It is much more complex to have authentication
# on every page without having to enter the password everytime
######################################################
if ($ENV{'REQUEST_METHOD'} EQ 'POST') {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs=split(/&/, $buffer);
# This is the Name-Value pair splitter.. Put into $FORM array
foreach $pair (@pairs) {
($name,$value)=split(/=/,$pair);
$value=~tr/+/ /;
$value=~s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
$FORM{$name}=$value;
}
$found=0;
open(PW,"c:\\googoo\\user.db");
while ($line=<PW>) {
($name,$pw)=split(/:/,$line);
if (($name eq $FORM{name}) && ($pw eq $FORM{password})) {
$found=1;
}
}
close(PW);
if (($found) && ($FORM{name}=~/guest/i)) {
print "Content-type: text/html\n\n";
print <<EOF;
<HTML>
<TITLE>Goo Goo Guest Access</TITLE>
<BODY>
<H1>Goo Goo Guest Access</H1>
<HR>
<P>
<B>
As a Guest to Goo Goo Records Site you can sample new releases, join our mailing list,
and order compact disks!
<UL>
<LI>Listen to New Sounds
<LI>Check out New Videos
<LI>View the Latest Hype
<LI>Join the Mailing List
<LI>Order Music
</UL>
</BODY>
</HTML>
EOF
exit;
}
elsif ($found) {
print "Location:
http://www.googoo.com/users/userspage.htm\n\n";
exit;
}
else {
print "Content-type: text/html\n\n";
print <<EOF;
<HTML>
<TITLE>Access Denied</TITLE>
<BODY>
<H1>Access Denied</H1>
<HR><P>
You entered an invalid userid or password. Please register, or click "back"
and try again.
</BODY>
</HTML>
EOF
exit;
}
}
else { # if there were problems with the form, print an error.
print "Content-type: text/html\n\n";
print "<HTML>\n";
print "<title>Error - Image Map Error</title>\n";
print "<h1>Error: Image Map Error</h1>\n";
print "<P><hr><P>\n";
print "There was an error with the Image Map. Please\n";
print "contact GooGoo Records at <address><a
href=\"mailto: support@googoo.com\">support@googoo.com</a></address>\n";
print "</HTML>\n"
exit;
}
The staff at Goo Goo Records realized that they wanted to develop
a specific mailing list for each of their bands by requiring users
to become registered members of their site. Membership is free
of charge, and the information garnered from the membership application
form, shown in Figure 13.6, goes straight to the marketing and
publicity databases.
Figure 13.6 : Membership application form.
The HTML for this form is as listed:
<HTML>
<HEAD>
<TITLE>
Membership Form
</TITLE>
</HEAD>
<BODY Bgcolor="#40E0D0" Text="#191970">
<CENTER>
<H1>Welcome to Goo Goo Records!</H1>
<BR>
</CENTER>
<HR>
<P><B>
So you want to join up, eh? move to the head of the class and please enter this short
form and send it in. Your choice of member name and password will be checked, and then
okayed. As soon as you receive confirmation of your id and password, your membership
is active!
<P>
<FORM METHOD="POST" ACTION="http://www.googoo.com/cgi-bin/member.pl">
<STRONG>
User Id: <INPUT TYPE="TEXT" NAME="id" SIZE="25"><BR>
Password : <INPUT TYPE="PASSWORD" NAME="pass" SIZE="25"><BR>
Favorite Color: <SELECT NAME="color">
<OPTION>Red
<OPTION>Yellow
<OPTION>Blue
<OPTION>Green
<OPTION>Magenta
</SELECT>
<P>
<INPUT TYPE="SUBMIT" NAME="Submit">
</FORM>
</BODY>
</HTML>
This information goes to the script "member.pl," which
is listed here:
#! usr/bin/perl
# member.pl
print "What is your ID? ";
$id=<STDIN>;
print "What is your Password? ";
$pass=<STDIN>;
open (MEMBER, ">>member.pl");
# open a file with filehandle MEMBER
print MEMBER "$id","$pass";
chop($id);
print "Thank you, $id! Your name has been added to the Member ship Database.\n";
close(MEMBER);
print "What is your ID?";
$id=<STDIN>;
open (MEMBER, "member.pl");
while ($line=<MEMBER>) {
if ($line eq $id) {
print "You are already a member!\n";
close(MEMBER);
exit;
}
}
close (MEMBER);
print "What is your Member ID? ";
$id=<STDIN>;
chop($id);
print "What is your password? ";
$pass=<STDIN>;
chop($pass);
while ($line=<MEMBER>) {
($mid, $mpass, $gbcolor)=split(':', $line);
if (($mid=~/^$id/i) && ($mpass=~/^$pass/i)) {
print "You are already a Member, $id!\n";
close (MEMBER);
if ($gbcolor!~/$color/i) {
print "You have a different favorite color!\n";
print "Your old favorite color is: $gbcolor\n";
print "Your new favorite color is: $color\n";
print "Would you like to change it? ";
$input=<STDIN>;
if ($input=~/^y/i) {
open(MEMBER, "member.pl");
undef $/;
$body=<MEMBER>;
$/="\n";
open (MEMBER, "member.pl");
while ($line=<MEMBER>) {
($mid, $mpass, $gbcolor)=split(':', $line);
if ($mid=~/^$id/i) {
print "You are already a Member, $id!\n";
close (MEMBER);
open (MEMBER, ">>member.pl");
print MEMBER "$newline";
print "Thank you, $id! Your name has been added to the Membership Database.\n";
close(MEMBER);
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs=split(/&/, $buffer);
foreach $pair (@pairs) {
($id,$value)=split(/=/,$pair);
$value=~tr/+//;
$value=~s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
$FORM{$id}=$value;
}
$id=$FORM{id};
$pass=$FORM{pass};
$color=$FORM{color};
print "Content-type: text/html\n\n";
print "<HTML>\n<BODY>\n<H3>\n\n";
$newline=$id.':'.$pass.':'.$color."\n";
open (MEMBER, "member.pl");
while ($line=<MEMBER>) {
($mid, $mpass, $gbcolor)=split(':', $line);
if (($mid=~/^$id/i) && ($mpass=~/^$pass/i)) {
print "You are already in the guestbook, $id!\n";
close (MEMBER);
if ($gbcolor!~/$color/i) {
print "You have a different favorite color!\n";
print "Your old favorite color is: $gbcolor\n";
print "Your new favorite color is: $color\n";
}
print "</H3>\n</BODY>\n</HTML>\n";
exit;
}
}
close (MEMBER);
open (MEMBER, ">>member.pl");
print MEMBER "$newline";
print "Thank you, $id! Your name has been added to the Membership Database.\n";
print "</H3>\n</BODY>\n</HTML>\n";
close(MEMBER);
The most powerful aspect to the Goo Goo Records Web site is the
ability for the user to search through the Goo Goo Records databases
and find all the information available concerning a particular
artist or band that records on the Goo Goo Records label. This
information could be images, sounds, or even video clips. The
HTML for this page looks like this:
<HTML>
<TITLE>Goo Goo Artist's Search</TITLE>
<BODY bgcolor="#40E0D0" Text="#191970" >
<CENTER>
<H1>The Goo Goo Site Search</H1>
</CENTER>
<HR>
<P>
<B>Search the Goo Goo site instantly for your favourite band. Just select the band you
want to see, and a complete list of pictures, videos, and sound clips for that band will appear.
<P>
<FORM METHOD=POST ACTION="http://www.googoo.com/cgi-bin/findstuf.pl">
<INPUT TYPE=RADIO NAME="band" VALUE="TPF">The Petite Fauves
<BR>
<INPUT TYPE=RADIO NAME="band" VALUE="PU">Push Up
<BR>
<INPUT TYPE=RADIO NAME="band" VALUE="TDL">Ten Days Late
<BR>
<INPUT TYPE=RADIO NAME="band" VALUE="ST">Seoul Train
<BR>
<INPUT TYPE=RADIO NAME="band" VALUE="AL">Angry Lemon
<BR>
<HR>
<INPUT TYPE=SUBMIT VALUE="Select">
</FORM>
<P>
</BODY>
</HTML>
When the name of the band in question is entered by the user,
this script searches the databases and presents a Web page of
the results, generated on the fly by the script. The result is
a list of different "galleries" that are created from
the existing files in each band's directory. An example of a successful
search is found in Figure 13.7.
Figure 13.7 : Results of an artist search.
By creating new galleries each time, they are always current,
and to maintain them all the Web Master has to do is keep up-to-date
files in each band's directory.
The script to do this is written as follows:
#!/usr/bin/perl
#findstuf.pl
# This is the script to find audio, video, and picture files of a band
# It will search for *.wav, *.mpg, and *.jpg in the appropriate directory under
# the selected band name and print them in a generated page.
#
#####################################################################
if ($ENV{'REQUEST_METHOD'} EQ 'POST') {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs=split(/&/, $buffer);
# This is the Name-Value pair splitter.. Put into $FORM array
foreach $pair (@pairs) {
($name,$value)=split(/=/,$pair);
$value=~tr/+/ /;
$value=~s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
$FORM{$name}=$value;
}
print "Content-type: text/html\n\n";
print <<"EOF";
<HTML>
<TITLE>Gallery for $FORM{band}</TITLE>
<BODY>
<H1> Seasrch Results for $FORM{band}</H1>
<HR><P>
<H3>Video Clips</H3>
<UL>
EOF
foreach $file (<"c:\\googoo\\bands\\$FORM{band}\\video\\*.mpg">) {
print "<LI><A
HREF=\"bands/$FORM{band}/video/$file\">$file</a><BR>";
}
print "</UL>\n";
print "<P><H3>Sound Bites</H3>\n<UL>\n";
foreach $file (<"c:\\googoo\\bands\\$FORM{band}\\audio\\*.wav">) {
print "<LI><A
HREF=\"bands/$FORM{band}/audio/$file\">$file</a><BR>";
}
print "</UL>\n";
print "<P><H3>Pictures</H3>\n<UL>\n";
foreach $file (<"c:\\googoo\\bands\\$FORM{band}\\images\\*.jpg">) {
print "<LI><A
HREF=\"bands/$FORM{band}/images/$file\">$file</a><BR>";
}
print "</UL>\n";
print "</BODY>\n</HTML>\n";
}
else { # if there were problems with the form, print an error.
print "Content-type: text/html\n\n";
print "<HTML>\n";
print "<title>Error - Form Error</title>\n";
print "<h1>Error: Form Error</h1>\n";
print "<P><hr><P>\n";
print "There was an error with the Form. Please\n";
print "contact GooGoo Records at <address><a
href=\"mailto:support@www.googoo.com\">support@googoo.com</a></address>\n";
print "</HTML>\n"; exit;
}
The program basically scans the directory of the band selected
and looks for file extensions for any image files (".jpg"),
sound files (".wav"), and video files (".mpg").
The files listed on the HTML document returned are based on what
the script finds in each band's directory. This script can be
easily modified to accommodate other formats of these files.
From these results a user can select a particular result and be
taken straight to the file. Each of these galleries (Image, Sound,
and Video) can now be used by the member.
The Image Gallery
When a member user enters the image gallery, they are requested
to select the band of their choice. This request is used to make
an on-the-fly gallery page(s) that is created from all images
from a single directory of that band. As each directory is updated,
the Gallery pages for that directory are updated as well.
The search and Web page creation is done by this script, which
first finds the directory necessary, then makes the Web page using
all the .jpg files found in that directory.
The Sound Gallery
Along the same lines as the Image Gallery, the Sound Gallery is
also created by a script that first checks for the selected band's
directory, then scans for any .wav files that might be in there.
The result for the member user is a freshly generated HTML document
that would resemble in format the image gallery, because basically
it is the image gallery, only with sound files this time.
The Video Gallery
As you might have already guessed, the Video Gallery is similar
to the last two galleries. It uses a script which finds the specified
directory, then returns an HTML document based on the .mpg files
it finds.
To make the site operate more efficiently, the Goo Goo Records
Web Master has included compressed files in all the different
bands' directories to make the image, sound, and video files download
faster.
To create a list of zipped files available for download, this
HTML document is used:
<HTML>
<HEAD>
<TITLE>Goo Goo Downloads</TITLE>
</HEAD>
<BODY bgcolor="#40E0D0" Text="#191970">
<H1>Goo Goo Instant Download Page!</H1><BR>
<HR>
<B>
Select the band for whom you want to see the selection of pictures, videos,
and sound clips.
<P>
<FORM METHOD=POST ACTION="http://www.googoo.com/cgi-bin/findzips.pl">
<INPUT TYPE=RADIO NAME="band" VALUE="TPF">The Petite Fauves
<BR>
<INPUT TYPE=RADIO NAME="band" VALUE="PU">Push Up
<BR>
<INPUT TYPE=RADIO NAME="band" VALUE="TDL">Ten Days Late
<BR>
<INPUT TYPE=RADIO NAME="band" VALUE="ST">Seoul Train
<BR>
<INPUT TYPE=RADIO NAME="band" VALUE="AL">Angry Lemon
<BR>
</FORM>
<P>
</BODY>
</HTML>
which creates a page that looks just like Figure 13.8.
Figure 13.8 : The download generation page.
The script to facilitate this download list, which is generated
based on a search through a selected band's directory, goes like
this:
#!/usr/bin/perl
# findzips.pl
###################################################
#
# This is the script to find audio, video, and picture files of a band to
# download.
# It will search for *.zip in the appropriate directory under
# the selected band name and print them in a generated page with links to the
# zip files to be downloaded.
#
#########################################################
if ($ENV{'REQUEST_METHOD'} EQ 'POST') {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs=split(/&/, $buffer);
# This is the Name-Value pair splitter.. Put into $FORM array
foreach $pair (@pairs) {
($name,$value)=split(/=/,$pair);
$value=~tr/+/ /;
$value=~s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
$FORM{$name}=$value;
}
print "Content-type: text/html\n\n";
print <<"EOF";
<HTML>
<TITLE> Selections for $FORM{band}</TITLE>
<BODY>
<H1> Selections for $FORM{band}</H1>
<HR><P>
<H3>Video</H3>
<UL>
EOF
foreach $file (<"c:\\googoo\\bands\\$FORM{band}\\video\\*.zip">) {
print "<LI><A
HREF=\"bands/$FORM{band}/video/$file\">$file</a><BR>";
}
print "</UL>\n";
print "<P><H3>Audio</H3>\n<UL>\n";
foreach $file (<"c:\\googoo\\bands\\$FORM{band}\\audio\\*.zip">) {
print "<LI><A
HREF=\"bands/$FORM{band}/audio/$file\">$file</a><BR>";
}
print "</UL>\n";
print "<P><H3>Pictures</H3>\n<UL>\n";
foreach $file (<"c:\\googoo\\bands\\$FORM{band}\\pics\\*.zip">) {
print "<LI><A
HREF=\"bands/$FORM{band}/pics/$file\">$file</a><BR>";
}
print "</UL>\n";
print "</BODY>\n</HTML>\n";
}
else { # if there were problems with the form, print an error.
print "Content-type: text/html\n\n";
print "<HTML>\n";
print "<title>Error - Form Error</title>\n";
print "<h1>Error: Form Error</h1>\n";
print "<P><hr><P>\n";
print "There was an error with the Form. Please\n";
print "contact GooGoo Records at <address><a
href=\"mailto:support@www.googoo.com\">support@googoo.com</a></address>\n";
print "</HTML>\n"
exit;
}
From this script the result is sent to the user, and the result
resembles Figure 13.9.
Figure 13.9 : A download request page result.
With all of this information about Goo Goo Records' musical artists
available free of charge to the site's members, registered users
will be given the opportunity to purchase Goo Goo Records merchandise,
CD's, and t-shirts. To do this they would fill out and send in
the online form created with HTML,which produces an HTML document
that looks like Figure 13.10.
Figure 13.10: The Goo Goo Records sales form.
The programming for this sales page is as follows:
<HTML>
<HEAD>
<title>The Goo Goo Records Shop - Come On In!</title>
</HEAD>
<BODY bgcolor="#40E0D0" Text="#191970" >
<META Name="keywords" Content="music, sound clips, video clips, avi, wav, alternative,
underground, punk, pop music, funk, contests, prizes"><p>
<center>
<img src="shop.gif">
<p>
<FORM METHOD="POST" ACTION="sales.cgi">
<b>The Gear
<p>
<table border=0>
<tr><td>Item</td><td>U.S. Price</td>
<td>Europe</td><td>RoW</td><td>Quantity Required</td><tr>
<tr><td>Googoo Ski Hat</td>
<td>$14.50</td><td>$15.50</td><td>$16.50</td>
<td><INPUT TYPE="text" NAME="hats" SIZE="2"></td>
</tr>
<tr><td>Googoo Dispatch Bag</td>
<td>$24.00</td><td>$25.00</td><td>$27.50</td>
<td><INPUT TYPE="text" NAME="dispbag" SIZE="2"></td>
</tr>
<tr><td>Googoo Record Bag</td>
<td>$20.00</td><td>$21.00</td><td>$24.50</td>
<td><INPUT TYPE="text" NAME="recbag" SIZE="2"></td>
</tr>
<tr><td>Googoo T-Shirt: Grey on white</td>
<td>$16.00</td><td>$17.00</td><td>$19.00</td>
<td><INPUT TYPE="text" NAME="tsgow" SIZE="2"></td>
</tr>
<tr><td>Googoo T-Shirt: Grey on black</td>
<td>$16.00</td><td>$17.00</td><td>$19.00</td>
<td><INPUT TYPE="text" NAME="tsgob" SIZE="2"></td>
</tr>
<tr><td>Googoo T-Shirt: Black on grey</td>
<td>$16.00</td><td>$17.00</td><td>$19.00</td>
<td><INPUT TYPE="text" NAME="tsbog" SIZE="2"></td>
</tr>
<tr><td>Single Googoo Slipmat</td>
<td>$6.00</td><td>$7.00</td><td>$7.50</td>
<td><INPUT TYPE="text" NAME="oneslip" SIZE="2"></td>
</tr>
<tr><td>Pair Of Googoo Slipmats</td>
<td>$10.00</td><td>$11.00</td><td>$11.50</td>
<td><INPUT TYPE="text" NAME="pairslip" SIZE="2"></td>
</tr>
</table>
<p>
<img src="record.gif">
<p>
The Records
<p>
<table border=0>
<tr><td>Artist/Title</td><td>Cat.</td><td>U.S. Price</td>
<td>Europe</td><td>RoW</td><td>Quantity Required</td><tr>
<tr><td>Petite Fauves/First Bite Vol 1</td>
<td>Loo 2</td>
<td>$5.00</td><td>$6.50</td><td>$7.00</td>
<td><INPUT TYPE="text" NAME="xx1" SIZE="2"></td>
</tr>
<tr><td>Ten Days Late/Maiden Voyage EP</td>
<td>Load 4</td>
<td>$5.00</td><td>$6.50</td><td>$7.00</td>
<td><INPUT TYPE="text" NAME="xx2" SIZE="2"></td>
</tr>
<tr><td>Suggestive/Advances</td>
<td>Load 6</td>
<td>$5.00</td><td>$6.50</td><td>$7.00</td>
<td><INPUT TYPE="text" NAME="xx3" SIZE="2"></td>
</tr>
<tr><td>Push Up/Heartbreaker</td>
<td>Load 9</td>
<td>$5.00</td><td>$6.50</td><td>$7.00</td>
<td><INPUT TYPE="text" NAME="xx4" SIZE="2"></td>
</tr>
<tr><td>Petite Fauves/First Bite Vol 3 pt 1</td>
<td>Load 10</td>
<td>$5.00</td><td>$6.50</td><td>$7.00</td>
<td><INPUT TYPE="text" NAME="xx5" SIZE="2"></td>
</tr>
<tr><td>Petite Fauves/First Bite Vol 3 pt 2</td>
<td>Load 11</td>
<td>$5.00</td><td>$6.50</td><td>$7.00</td>
<td><INPUT TYPE="text" NAME="xx6" SIZE="2"></td>
</tr>
<tr><td>Seoul Train/Viper Room EP</td>
<td>Load 13</td>
<td>$5.00</td><td>$6.50</td><td>$7.00</td>
<td><INPUT TYPE="text" NAME="xx7" SIZE="2"></td>
</tr>
<tr><td>Petite Fauves/First Bite Vol 4</td>
<td>Load 14</td>
<td>$5.00</td><td>$6.50</td><td>$7.00</td>
<td><INPUT TYPE="text" NAME="xx8" SIZE="2"></td>
</tr>
<tr><td>Jism/Gravity</td>
<td>Load 18</td>
<td>$5.00</td><td>$6.50</td><td>$7.00</td>
<td><INPUT TYPE="text" NAME="xx9" SIZE="2"></td>
</tr>
<tr><td>Doodle Tool/Let It Be</td>
<td>Load 19</td>
<td>$5.00</td><td>$6.50</td><td>$7.00</td>
<td><INPUT TYPE="text" NAME="xx10" SIZE="2"></td>
</tr>
<tr><td>Tired Eyes/Eat Muff</td>
<td>Load 22</td>
<td>$5.00</td><td>$6.50</td><td>$7.00</td>
<td><INPUT TYPE="text" NAME="xx11" SIZE="2"></td>
</tr>
<tr><td>Jism/Blue Fish/Who Are Them? </td>
<td>Load 23 </td>
<td>$5.00</td><td>$6.50</td><td>$7.00</td>
<td><INPUT TYPE="text" NAME="xx12" SIZE="2"></td>
</tr>
<tr><td>Henson's Nuts/Feel Space</td>
<td>Load 25</td>
<td>$5.00</td><td>$6.50</td><td>$7.00</td>
<td><INPUT TYPE="text" NAME="xx13" SIZE="2"></td>
</tr>
<tr><td>Needle Nose/Angry Lemon/BBQ Babies</td>
<td>Load 28</td>
<td>$5.00</td><td>$6.50</td><td>$7.00</td>
<td><INPUT TYPE="text" NAME="xx14" SIZE="2"></td>
</tr>
</table>
<h5>RoW = Rest of the World</h5>
<p>
All prices include postage, packing and handling. Please allow 28 days for delivery in
the U.S. and 40 days for Europe and the rest of the world.
</center>
<p>
<hr>
</center>
<b>Ordering via email</b>
<pre>
Name : <INPUT NAME="name" TYPE="TEXT" SIZE="50">
Number/Street: <INPUT NAME="numberstreet" TYPE="TEXT" SIZE="50">
Town/City : <INPUT NAME="towncity" TYPE="TEXT" SIZE="40">
Post/Zipcode : <INPUT NAME="postcode" TYPE="TEXT" SIZE="12">
Country : <INPUT NAME="country" TYPE="TEXT" SIZE="25">
Phone (optional, U.S. only): <INPUT NAME="phone" TYPE="TEXT" SIZE="15">
e-mail address: <INPUT NAME="email" TYPE="TEXT" SIZE="40">
</pre>
<p>
Once we receive your order, we will contact you by phone, or email, to determine your
payment method. To spped you order along, you can call our toll free 800 number:
<p>
<center>1-800-555-5428</center>
<p>
and we will match your online order with your method of payment.
<hr>
To submit your order electronically, press: <INPUT TYPE="submit" VALUE="Send order now"> -
or to clear everything <INPUT TYPE="reset" VALUE="Press this">
<p>
<hr>
<b>Ordering via fax</b>
<p><br>
Fill in this page as for an email order, print it out from your WWW
software (or just write out the relevant details on a piece of paper) and fax it to:
<p>
(212) 555-7649
<p>
<hr>
<b>Ordering via normal (postal) (snail) (slow) (boring) mail.</b>
<p><br>
Write your order, remebering all the important details (your address is
quite useful!) and mail it to us at:
<p>
5423 Irvine Drive<br>
PO Box 10010, Emeryville, CA,<br>
90543<br>
United States<br>
<p>
You can send us a cheque or postal order, crossed in pounds sterling (only),
made payable to GOO GOO RECORDS. Please do not send cash.
<center>
<hr>
</center>
</BODY>
</HTML>
To help with the speedy processing of the form, three copies of
the member's data are sent via e-mail to Goo Goo Records Central.
A copy is sent to the sales department (sales@googoo.com), so
that they may record the sale; the warehouse (warehouse@googoo.com),
so that the order can be filled, and accounting (accounts@googoo.com),
so that the proper invoices can be issued. This greatly reduces
the interoffice paperwork as well as the time necessary to make
delivery.
The script that handles the data from this order form looks something
like this:
#!/usr/bin/perl
if ($ENV{'REQUEST_METHOD'} EQ 'POST') {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs=split(/&/, $buffer);
# This is the Name-Value pair splitter.. Put into $FORM array
foreach $pair (@pairs) {
($name,$value)=split(/=/,$pair);
$value=~tr/+/ /;
$value=~s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
$FORM{$name}=$value;
}
open(MAIL, "|mail sales\@www.googoo.com");
&pform;
close(MAIL);
open(MAIL, "|mail accounting\@www.googoo.com");
&pform;
close(MAIL);
open(MAIL, "|mail warehouse\@www.googoo.com");
&pform;
close(MAIL);
if ($FORM{email}) {
open(MAIL, "|mail $FORM{email}");
&pform;
close(MAIL);
}
print "Content-type: text/html\n\n";
print <<EOF;
<HTML>
<HEAD>
<TITLE>Thank you for your order!</TITLE>
</HEAD>
<BODY>
<H1>Thank you for your order!</H1>
<HR>
A copy of your order form has been sent to the appropriate people for
processing
and a copy has been sent to your e-mail address for your records. A GooGoo
representative will contact you shortly regarding your payment method.
</BODY>
</HTML>
EOF
}
else {
print "<HTML>\n";
print "<title>Error - Form Error</title>\n";
print "<h1>Error: Form Error</h1>\n";
print "<P><hr><P>\n";
print "There was an error with the form submission. Please\n";
print "contact Imprint at <address><a
href=\"mailto:web@imprint.uwaterloo.ca\">web@imprint.uwaterloo.ca</a></address>\n";
print "</HTML>\n";
exit;
}
sub pform {
print MAIL "Subject: Order form\n";
print MAIL "\nThe following is an order form received on the Web.\n";
print MAIL "\nRequested by:\n\n";
print MAIL "\t$FORM{name}\n";
print MAIL "\t$FORM{numberstreet}\n";
print MAIL "\t$FORM{towncity}\n";
print MAIL "\t$FORM{postcode}\n";
print MAIL "\t$FORM{phone}\n";
print MAIL "\t$FORM{email}\n";
print MAIL "\nMisc Items:\n\n";
print MAIL "\tHats\t\t\t\t$FORM{hats}\n" if $FORM{hats};
print MAIL "\tGoogoo Bag\t\t\t$FORM{dispbag}\n" if $FORM{dispbag};
print MAIL "\tRecord Bag\t\t\t$FORM{recbag}\n" if $FORM{recbag};
print MAIL "\tT-shirt (G on W)\t\t$FORM{tsgow}\n" if $FORM{tsgow};
print MAIL "\tT-shirt (G on B)\t\t$FORM{tsgob}\n" if $FORM{tsgob};
print MAIL "\tT-shirt (B on G)\t\t$FORM{tsbog}\n" if $FORM{tsbog};
print MAIL "\t1xSlipmat\t\t\t$FORM{oneslip}\n" if $FORM{oneslip};
print MAIL "\t2xSlipmat\t\t\t$FORM{pairslip}\n" if $FORM{pairslip};
print MAIL "\nAlbums:\n\n";
print MAIL "\tPetite Fauves/First Bite Vol 1\t\t\t$FORM{xx1}\n" if
$FORM{xx1};
print MAIL "\tTen Days Late/Maiden Voyage EP\t\t\t$FORM{xx2}\n" if
$FORM{xx2};
print MAIL "\tSuggestive/Advances\t\t\t\t$FORM{xx3}\n" if $FORM{xx3};
print MAIL "\tPush Up/Heartbreaker\t\t\t\t$FORM{xx4}\n" if
$FORM{xx4};
print MAIL "\tPetite Fauves/First Bite Vol 3 pt 1\t\t\t$FORM{xx5}\n" if
$FORM{xx5};
print MAIL "\tPetite Fauves/First Bite Vol 3 pt 2\t\t\t$FORM{xx6}\n" if
$FORM{xx6};
print MAIL "\tSeoul Train/Viper Room EP\t\t\t$FORM{xx7}\n" if
$FORM{xx7};
print MAIL "\tPetite Fauves/First Bite Vol 4\t\t\t$FORM{xx8}\n" if
$FORM{xx8};
print MAIL "\tJism/Gravity\t\t\t\t$FORM{xx9}\n" if
$FORM{xx9};
print MAIL "\tDoodle Tool/Let It Be\t\t\t$FORM{xx10}\n" if
$FORM{x10};
print MAIL "\tTired Eyes/Eat Muff\t\t\t$FORM{x11}\n" if $FORM{xx11};
print MAIL "\tJism/Blue Fish/Who Are Them?\t\t\t$FORM{xx12}\n"
if $FORM{x12};
print MAIL "\t Henson's Nuts/Feel Space \t\t\t$FORM{x13}\n" if $FORM{xx13};
print MAIL "\t Needle Nose/Angry Lemon/BBQ Babies \t\t\t$FORM{xx14}\n" if
$FORM{x14};
print MAIL "\n\n";
}
A sample order delivered to the warehouse might look like:
--- Forwarded mail from nobody (SVR4 nobody uid)
Date: Tue, 6 Aug 1996 12:35:35 -0700
From: nobody (SVR4 nobody uid)
Subject: Order form
The following is an order form received on the Web.
Requested by:
Joe Smith
21 Anywhere Lane
Ingersoll, Wyoming
3049112
515-555-1234
joes@wyenet.com
Misc Items:
Hats 1
Googoo Bag 4
Record Bag 1
T-shirt (G on W) 1
T-shirt (G on B) 1
T-shirt (B on G) 1
1xSlipmat 1
2xSlipmat 1
Albums:
Petite Fauves/First Bite Vol 1 1
Ten Days Late/Maiden Voyage EP 1
Suggestive/Advances 2
Push Up/Heartbreaker 1
Petite Fauves/First Bite Vol 3 pt 1 1
Petite Fauves/First Bite Vol 3 pt 2 1
Seoul Train/Viper Room EP 1
Petite Fauves/First Bite Vol 4 1
Jism/Gravity 1
Doodle Tool/Eat Muff
Henson's Nuts/Feel Space
---End of forwarded mail from nobody (SVR4 nobody uid)
This e-mail order is sent using the order.pl script, which sends
three copies of the user's data to the correct e-mail addresses.
Going beyond the limits of the Gallery searches, there is also
the freely available excite search engine, which can search a
Web site for specific word(s). Members can use excite to find
every mention of a band or artist in the Goo Goo Records site,
returning a match page like the one shown in Figure 13.11.
Figure 13.11: The result of an Excite search.
The wonderful thing about the excite search engine is that it
is written using a lot of Perl, unlike many other search engines,
so you might be able to learn a trick or two by looking through
some of its coding. This is the aindex.pl script which links the
index for the search engine with the search engine itself, also
known as a wrapper script, so that the two sources of data are
always current. The listing is as follows:
#!/bin/sh
perl=/usr/local/bin/perl
eval "exec $perl -x $0 $*"
#!perl
## Copyright Architext Software, 1994 (c)
##
## This program is a flexible wrapper for the index program. For
## maximum efficiency, you might want to invoke the executable
## directly, pointing it to the proper info file with "-C".
## this script will index a collection in a 'safe' directory
## and then move the finished index files in to the specified
## destination location once indexing completes successfully.
## This script will also mail a specified user when indexing completes
## if a email address is given in the collections configuration file
$root = "C:\\ews";
$ENV{'PATH'} = '/bin:/usr/bin';
unshift(@INC, "$root/perllib");
require 'architextConf.pl';
require 'os_functions.pl';
require 'ctime.pl';
$database = shift;
if (! $database) {
$error = "Must specify database" unless $database;
goto DONE;
}
$logfile = shift;
$progfile = shift;
$errfile = shift;
## create an empty .inv file so that index forms can tell that
## aindex.pl was actually invoked
open(TEMP, ">$root/collections/$database.inv");
close(TEMP);
## the following code seeds the log files appropriately
$|=1;
if ($errfile) {
unlink($errfile);
open(ERRS, ">$errfile");
print ERRS "No errors encountered so far...\n";
close(ERRS);
}
if ($logfile) {
unlink($logfile);
open(LOG, ">$logfile");
print LOG "Nothing yet logged to this file. Check error log for problems.\n";
close(LOG);
}
if ($progfile) {
unlink($progfile);
open(PROG, ">$progfile");
print PROG "Nothing yet logged to this file. Check error log for problems.\n";
close(PROG);
}
$logfile = "-log $logfile" if $logfile;
$progfile = "-prog $progfile" if $progfile;
## Read the configuration file and look for the database.
%attr = &ArchitextConf'readConfig("$root/Architext.conf", $database);
if (! $attr{'CollectionInfo'}) {
$error = "Configuration file must specify CollectionInfo file\n";
goto DONE;
}
##ECO -- improvements to indexing rules
$filter = $attr{'IndexFilter'}; ## check for html only indexing
$filterflag = " ";
$filterflag = "-html" if ($filter =~ /HTML/);
$filterflag .= " -text" if ($filter =~ /TEXT/);
if ($filter =~ /CUST/) {
$clusionfile = "$root/collections/$database.excl";
unlink($clusionfile);
&compileExcludeFile($attr{'ExclusionRules'}, $clusionfile);
goto DONE if $error;
}
$filterflag .= " -excl $clusionfile" if ($filter =~ /CUST/);
$mailid = $attr{'AdminMail'}; ## check for user to alert when finished
## ECO keep back compatibility with old .conf files
if ($filter =~ /Text/) {
$filterflag = "-html -text" ;
$filterflag .= " -excl $attr{'ExclusionRules'}" if $attr{'ExclusionRules'};
}
chop($startTime = &ctime(time));
## Possibly create a CollectionInfo file.
if (! -e $attr{'CollectionInfo'}) {
print STDERR "Creating CollectionInfo file '$attr{'CollectionInfo'}'\n";
$attr{'PidFile'} = "$root/collections/$database.pid";
&ArchitextConf'makeInfoFile(%attr);
if (! -e $attr{'CollectionInfo'}) {
$error = "Failed to create CollectionInfo file";
goto DONE;
}
}
## calculate $newroot here to do indexing in a 'safe' directory to
## keep index as available as possible
$newroot = $attr{'CollectionRoot'};
$newroot =~ /[\\\/]?([^\/\\]+)$/;
$rootstub = $1;
$newrootdir = $attr{'CollectionIndex'};
$newroot = "$attr{'CollectionIndex'}/new/$rootstub";
$chmodfiles = "$newroot*";
$cpfiles = "$newroot*";
$cpdest = "$newrootdir";
$rmfiles = "$newroot*";
$newroot = "-R $newroot";
## create 'new' subdirectory for indexing
if (! -e "$attr{'CollectionIndex'}/new") {
$exit = &make_directory("$attr{'CollectionIndex'}/new");
$error = "Can't mkdir $attr{'CollectionIndex'}/new -- $!" if $exit;
goto DONE if $exit;
}
if (-e "$root/collections/$database.cus") {
©_files("$root/collections/$database.cus",
"$attr{'CollectionIndex'}/new");
}
## remove error flag from any previous indexing runs
unlink("$root/collections/$database.err");
if (! $attr{'CollectionContents'}) {
$error = "Configuration file must specify CollectionContents\n";
goto DONE;
}
if (! $attr{'IndexExecutable'}) {
$error = "Configuration file must specify IndexExecutable\n";
goto DONE;
}
$indexer = &ArchitextConf'makeAbsolutePath($attr{'IndexExecutable'},
$attr{'ArchitextRoot'});
if (! &executable($indexer)) {
$error = "IndexExecutable '$indexer' does not exist or is not really exectuable\n";
goto DONE;
}
## Pipe stuff into the indexer. Or send it on the command line.
## Args are sent on the command line unless one of the files in
## CollectionContents is a list file. We assume CollectionContents is
## specified as a set of files separated by colons. If the first
## character of a file name is '+', we assume it points to a list file
## whose contents are read and passed to the indexer as if they were
## specified in CollectionInfo itself.
## Will pass exclusion argument to executable as well.
$output_file = "$root/collections/$database.out";
unlink($output_file);
@inputs = split(/[,;\s]+/, $attr{'CollectionContents'});
$index = join(" ", @inputs);
$index = " " . $index;
if ($index =~ /\s\+/) {
## this is the filelist case
$index =~ s/\+//g;
$index_command = "$indexer -C $attr{'CollectionInfo'} -flist $index $newroot
$logfile $progfile > $output_file";
$index_command = &convert_file_names($index_command);
$exit = system($index_command);
} else {
## place arguments on command line instead of through filelist
$index_command = "$indexer -C $attr{'CollectionInfo'} $newroot $index $logfile
$progfile $filterflag > $output_file";
$index_command = &convert_file_names($index_command);
$exit = system($index_command);
}
open(INDEX, $output_file);
##capture errors from output of index process
while ($errline = <INDEX>) {
next unless ($errline =~ /^ARCHITEXTERROR:/);
$errline =~ s/^ARCHITEXTERROR://;
unshift(@errs, $errline);
}
close(INDEX);
unlink($output_file);
## check for error output or error exit status from indexer
if (($#errs > -1) || $exit) {
$errorflag = 1;
$error = $! if $exit;
}
&remove_files("$attr{'CollectionIndex'}/new/*.tmp*");
if (-e "$root/collections/$database.term") {
$error = "Indexing process was terminated by the administrator.";
$terminated = 1;
unlink("$root/collections/$database.term");
}
if ($terminated || $error || $errorflag) {
chop($endTime = &ctime(time));
goto DONE;
}
## sanity check
if (! -e "$attr{'CollectionIndex'}/new/$database.dat") {
$error = "Indexing error -- no .dat file found." ;
chop($endTime = &ctime(time));
goto DONE;
}
## make the index files readwriteable by all to avoid problems
$exit = &make_files_readwriteable($chmodfiles) unless ($error || $errorflag);
## move the now successfully built index files to the official location
$exit = ©_files($cpfiles, $cpdest) unless ($error || $errorflag);
$error = "Error copying index files from temporary build location\n
to new locations: $!" if $exit;
$exit = &remove_files($rmfiles) unless ($error || $errorflag);
$error = "Error removing temporary index files (this is a non-fatal error.) $!" if $exit;
chop($endTime = &ctime(time));
## if indexing was successful, record time of completion, size of index
if (! ($error || $errorflag)) {
unlink("$root/collections/$database.err");
open(LAST, ">$root/collections/$database.last");
print LAST "$endTime";
close(LAST);
}
DONE:
## there was an error
if ($error || $errorflag) {
open(PROB, ">$root/collections/$database.err") unless $terminated;
close(PROB) unless $terminated;
}
## Use Messenger service in NT to alert user when indexing is done
if (($ews_port eq 'NT') && $mailid) {
$special_message = "Excite indexing process on collection $database ";
$special_message .= "finished successfully."
unless ($error || $errorflag);
$special_message .= "was terminated."
if $terminated;
$special_message .=
"failed due to an error. Please check logs for details."
if ((! $terminated) && ($error || $errorflag));
system("net send $mailid $special_message");
$mailid = "";
}
## Mail user if required
if ($mailid) {
$mailapp = &mailer($root);
open(MAIL, "| $mailapp $mailid");
print MAIL "To: $mailid\n";
print MAIL "Subject: Architext indexing process finished.\n"
unless ($error || $errorflag);
print MAIL "Subject: Architext indexing process terminated.\n"
if $terminated;
print MAIL "Subject: Error in Architext indexing process.\n"
if ((! $terminated) && ($error || $errorflag));
print MAIL "\nYour indexing process invoked at $startTime\n";
print MAIL "for the collection '$database' has finished at $endTime.\n";
print MAIL "\nIndexing was successful.\n" unless ($error || $errorflag);
print MAIL "\nIndexing was unsuccessful because of the following:
\n\n $error\n" if ($error || $errorflag);
}
## Report any errors to mail, stdout, and error log
open(ERRLOG, ">$errfile") if $errfile;
if ($errorflag || $error) {
while ($errline = pop(@errs)) {
print MAIL $errline; ##report to mail
print ERRLOG $errline if $errfile; ##report to error log
print $errline; ##report to stdout
}
print MAIL "\nAdditional Error Information\n--------\n$error\n";
print ERRLOG "\nAdditional Error Information\n--------\n$error\n";
print "\nAdditional Error Information\n--------\n$error\n";
}
## add message about running out of vmem on NT
if (($ews_port eq 'NT') && ($errorflag || $error)) {
print ERRLOG "\n\nNOTE: If a message box appeared on the server machine indcating
that the\nsystem was 'Low on Virtual Memory' or 'Out of Virtual Memory', the indexing\
nprocess may have died due to insufficient resources. Try shutting down other\
napplications or increasing the size of your swap file, and then invoke the\
nindexing process again.\n";
}
print MAIL "\nThank You,\nThe Architext Indexer\n" if $mailid;
close(MAIL) if $mailid;
if ($errfile) {
print ERRLOG "No errors encountered during indexing.\n"
unless ($error || $errorflag);
}
close(ERRLOG) if $errfile;
close(INDEXERR);
close(INDEXOUT);
print "Error encountered.\n" if ($error || $errorflag);
if ($compile_error) {
$logfile = "$attr{'CollectionRoot'}.log" unless $logfile;
open(LOG, ">>$logfile");
print LOG "\nCustom Filter File Warnings:\n";
for (@WARNS) {
print LOG "$_\n";
}
}
unlink("$root/collections/$database.pid");
exit 0;
## translated the index filter file into a format
## that architextIndex will understand.
sub compileExcludeFile {
local($source, $target) = @_;
local($expression, $type, $ruletype);
if (! open(SOURCE, "$source")) {
$error = "Couldn't open custom filter file, '$source'";
return;
}
if (! open(TARGET, ">$target")) {
$error = "Couldn't open custom filter target file, '$target'";
return;
}
while (<SOURCE>) {
next unless /\S/; ##skip blank lines
next if /^\#/; ##allow comments
s/^\s*//g; ##trim leading space
s/\s*$//g; ##trim trailing space
s/\s+/ /g; ##shrink internal space
($ruletype, $expression, $type) = split(/\s/, $_);
if (! $expression) {
## old Exclusion Rules
print TARGET $_, "\n";
next;
} elsif ($ruletype =~ /^dir$/i) {
$expression = "/$expression" unless ($expression =~ /^\// ||
$expression =~ /^\w:[\\\/]/);
$expression .= "/" unless ($expression =~ /[\/\\]$/);
$expression = "^$expression"; ##anchor to head
} elsif ($ruletype =~ /^subdir$/i) {
$expression = "/$expression" unless ($expression =~ /^[\/\\]/);
$expression .= "/" unless ($expression =~ /[\/\\]$/);
} elsif ($ruletype =~ /^file$/i) {
$expression .= "\$"; ##anchor to end
} elsif ($ruletype =~ /^regexp$/i) {
print TARGET "$expression $type\n";
next;
} else {
$compile_error = 1;
push(@WARNS, "Bad rule type '$ruletype' in Custom Filter File in line:\n\t'$_'");
next;
}
if ($type && !(($type =~ /^TEXT$/i) || ($type =~ /^HTML$/i))) {
$compile_error = 1;
push(@WARNS, "Bad type '$type' in Custom Filter File in line:\n\t'$_'");
next;
}
$expression =~ s|[\\\/]|[\\\\\\\/]|g; ## match forward or backslashes
$expression =~ s/\./\\\./g; ## backslash periods
$expression =~ s/\*/[^\\\/\\\\]\*/g; ## turn unix '*' to regexp version
$expression =~ s/\?/[^\\\/\\\\]/g; ## turn unix '?' to regexp version
print TARGET "$expression $type\n";
}
close(SOURCE);
close(TARGET);
}
The HTTP, or Web server used for the Goo Goo Records, Web site
is the EMWAC HTTP server, available for free on the WWW, as well
as on the CD-ROM included with this book. This server was chosen
by the Goo Goo Web Master because it is affordable (free) and
it has a long track record of being able to handle a Web site
with a minimum number of server crashes. The frequent use of it
among NT users also ensures a healthy sized FAQs page, a network,
and some online documentation about the EMWAC HTTP server.
To help promote new bands, the marketing division of Goo Goo Records,
working with the Web Master, designed a trivia quiz for the site
which awards prizes, consisting of Goo Goo merchandise, to those
member users who answer all the questions correctly. The HTML
used to create the quiz is as follows:
<HTML>
<HEAD>
<TITLE>Goo Goo Records 80's Trivia</TITLE>
</HEAD>
<BODY bgcolor="#ffffff" >
<Basefont size=3>
<CENTER>
<BR>
<TABLE width=541>
<TD>
<HR width=541>
<P>
<H2>
Which Wave Was That?
</H2>
<H3>
Goo Goo Records Tests Your Knowledge of the Eighties!<BR>
</H3>
<P>
Each night at midnight Goo Goo Records Online will sputter and whirr serving you
up the next day's dish of "Which Wave Was That?", a game asking you to
name ten 80s musical artists. It might be The Bangles. It might be Rick Astley.
It may even be Twisted Sister. You'll never know for sure (fer sure!) until you
press the "How Did I Do?" button at the bottom.
</TD>
</TABLE>
<FORM action="/cgi-bin/trivia.pl" method="post">
<TABLE border=0 cellpadding=5>
<TH align=right>
Nedblake's Nipples<INPUT type="radio" name="a0_gif" value="Nedblake's Nipples"><BR>
Buzz Cuts<INPUT type="radio" name="a0_gif" value="Buzz Cuts"><BR>
Rubiks
<INPUT type="radio" name="a0_gif" value="Rubiks
"><BR>
Jo Boxers<INPUT type="radio" name="a0_gif" value="Jo Boxers"><BR>
</TH>
<TH><IMG src="/current_games/pictures/a132.gif"></TH>
<TH><IMG src="/current_games/pictures/a143.gif"></TH>
<TH align=left>
<INPUT type="radio" name="a1_gif" value="Blow Monkeys">Blow Monkeys<BR>
<INPUT type="radio" name="a1_gif" value="UB-40">UB-40<BR>
<INPUT type="radio" name="a1_gif" value="The B-52s">The B-52s<BR>
<INPUT type="radio" name="a1_gif" value="Sade
">Sade<BR>
</TH>
<TR>
<TH align=right>
Crowded House<INPUT type="radio" name="a2_gif" value="Crowded House"><BR>
U2<INPUT type="radio" name="a2_gif" value="U2"><BR>
Heathers
<INPUT type="radio" name="a2_gif" value="Heathers
"><BR>
Madness< INPUT type="radio" name="a2_gif" value="Madness"><BR>
</TH>
<TH><IMG src="/current_games/pictures/a152.gif"></TH>
<TH><IMG src="/current_games/pictures/a54.gif"></TH>
<TH align=left>
<INPUT type="radio" name="a3_gif" value="John Cougar">John Cougar<BR>
<INPUT type="radio" name="a3_gif" value="John Cougar Melloncamp">John Cougar Melloncamp<br>
<INPUT type="radio" name="a3_gif" value="John Melloncamp">John Melloncamp<BR>
<INPUT type="radio" name="a3_gif" value="John Cougar Melloncamp Bon Jovi
">John Cougar Melloncamp Bon Jovi
<BR>
</TH>
<TR>
<TH align=right>
Rod Stewart< INPUT type="radio" name="a4_gif" value="Rod Stewart"><BR>
Bryan Adams< INPUT type="radio" name="a4_gif" value="Bryan Adams"><BR>
Sting
< INPUT type="radio" name="a4_gif" value="Sting
"><BR>
Tom Tasset< INPUT type="radio" name="a4_gif" value="Tom Tasset"><BR>
</TH>
<TH><IMG src="/current_games/pictures/a84.gif"></TH>
<TH><IMG src="/current_games/pictures/a128.gif"></TH>
<TH align=left>
<INPUT type="radio" name="a5_gif" value="Peter Gabriel
">Peter Gabriel
<BR>
<INPUT type="radio" name="a5_gif" value="RATT">RATT<BR>
<INPUT type="radio" name="a5_gif" value="Quiet Riot">Quiet Riot<BR>
<INPUT type="radio" name="a5_gif" value="The Monroes">The Monroes<BR>
</TH>
<TR>
<TH align=right>
Juice Newton
<INPUT type="radio" name="a6_gif" value="Juice Newton
"><BR>
Greg Kihn Band<INPUT type="radio" name="a6_gif" value="Greg Kihn Band"><BR>
Device<INPUT type="radio" name="a6_gif" value="Device"><BR>
Lisa Lisa and Cult Jam<INPUT type="radio" name="a6_gif" value="Lisa Lisa and Cult Jam"><BR>
</TH>
<TH><IMG src="/current_games/pictures/a125.gif"></TH>
INPUT <TH><IMG src="/current_games/pictures/a38.gif"></TH>
<TH align=left>
<INPUT type="radio" name="a7_gif" value="Iman">Iman<BR>
<INPUT type="radio" name="a7_gif" value="Boy George">Boy George<BR>
<INPUT type="radio" name="a7_gif" value="Berlin">Berlin<BR>
<INPUT type="radio" name="a7_gif" value="Micah's Howl
">Micah's Howl
<BR>
</TH>
<TR>
<TH align=right>
Aerosmith<INPUT type="radio" name="a8_gif" value="Aerosmith"><BR>
Metallica<INPUT type="radio" name="a8_gif" value="Metallica"><BR>
Bon Jovi<INPUT type="radio" name="a8_gif" value="Bon Jovi"><BR>
Megadeth
<INPUT type="radio" name="a8_gif" value="Megadeth
"><BR>
</TH>
<TH><IMG src="/current_games/pictures/a25.gif"></TH>
<TH><IMG src="/current_games/pictures/a85.gif"></TH>
<TH align=left>
<INPUT type="radio" name="a9_gif" value="Janet Jackson
">Janet Jackson
<BR>
<INPUT type="radio" name="a9_gif" value="Paracute Club">Parachute Club<BR>
<INPUT type="radio" name="a9_gif" value="Toto">Toto<BR>
<INPUT type="radio" name="a9_gif" value="Sade">Sade<BR>
</TH>
<TR>
<TD></TD>
<TH><INPUT type="submit" value="How do I rank?"></TH>
<TH><INPUT type="reset" value="Clear my answers"></TH>
<TD></TD>
</TABLE>
<TABLE width=550>
<TD>
<CENTER>
<HR width=550>
<FONT size=-1>
</FONT>
</CENTER>
</TD>
</TABLE>
</BODY>
</HTML>
which creates a page similar to the one shown in Figure 13.12.
Figure 13.12: The Goo Goo Records trivia quiz.
The trivia quiz page takes each member users' answers, scores
them, then ranks the score. An HTML document is created and returned
to the current user, using this script:
#!/usr/bin/perl
# trivia.pl
if ($ENV{'REQUEST_METHOD'} EQ 'POST') {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs=split(/&/, $buffer);
# This is the Name-Value pair splitter.. Put into $FORM array
foreach $pair (@pairs) {
($name,$value)=split(/=/,$pair);
$value=~tr/+/ /;
$value=~s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
$FORM{$name}=$value;
}
print "Content-type: text/html\n\n";
open(ANSWERS,"answer.key");
while ($line=<ANSWERS>) {
chop($line);
@ans=(@ans,$line);
}
close(ANSWERS);
$correct=0;
for ($x=0; $x<10; $x++) {
$d="a${x}_gif";
if (($FORM{$d}) eq ($ans[$x])) {
$correct++;
}
}
open(SCORES,"scores.tq");
$line=<SCORES>;
close(SCORES);
@scr=split(/:/,$line);
print <<EOF;
<HTML>
<HEAD>
<TITLE>Your Score</TITLE>
</HEAD>
<BODY>
<CENTER>
<H1>Your Score!</H1>
<HR><P>
EOF
print "The correct answers were:\n<P>";
for ($x=0; $x<10; $x++) {
$y=$x+1;
print "$y. $ans[$x] <BR>\n";
}
print "<P>";
print "Your Score was:<P>\n";
print "<H3><B>$correct</B></H3><P>\n";
$scr[$correct]++;
open(SCORES,">scores.tq");
$line=join(':',@scr);
print SCORES $line;
close(SCORES);
print "Here's how others are doing so far:<P>\n";
print "<TABLE>\n<TR><TD><B># Question's\n
answered correctly</B></TD><TD><B>Total</B></TD></TR>\n";
for ($x=0; $x<=10; $x++) {
print "<TR><TD>$x</TD><TD>$scr[$x]</TD></TR>\n";
}
print "</TABLE>\n";
print <<EOF;
</BODY>
</HTML>
EOF
}
else {
print "<HTML>\n";
print "<title>Error - Form Error</title>\n";
print "<h1>Error: Form Error</h1>\n";
print "<P><hr><P>\n";
print "There was an error with the form submission. Please\n";
print "contact Goo Goo Records at <address><a href=\"mailto:support@googoo.com\
"> support@googoo.com </a></address>\n";
print "</HTML>\n";
exit;
}
which creates an HTML document that looks like Figure 13.13. For
this script to fully function it needs two other, smaller files
stored in the CGI bin as well. They are the file that holds the
answers, answer.key:
Figure 13.13: Trivia Quiz ranking page.
UB-40
Heathers
John Melloncamp
Rod Stewart
The Monroes
Device
Boy George
Megadeth
Toto
Note that these must be typed in exactly as they appear in the
VALUE fields in the form. The other file is the one that holds
the scores, score.tq:
0:0:0:0:0:0:0:0:0:0:0
As each form is processed, the appropriate field gets updated
to show how many people got how many questions right. When creating
your own quiz, make sure to create this file with all zeros in
it, as above. There should be the number of questions "+1"
fields. So, in this case, there are 10 questions, so there are
11 zero's.
This chapter put all the pieces of the Perl/Web site puzzle into
place by going through an entire Web site and describing the various
roles Perl scripts play in a site. These scripts are used to generate
up-to-date HTML documents based on current directory files, and
to aid in the processing of sales by directing order forms. What
is missing from this full example is a way to monitor and modify
the site so that it serves the registered users better.
The secret to this service is found in the next chapter, which
explores the many ways that logging can be used, in conjunction
with Perl scripts, to create reports that track how a user uses
the Web site, where they go, what browser they are using, and
their IP address, among other things.