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 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
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.
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.
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.
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.