Program Example

The program we’ll be creating is a two-page Web site. One page is used for “user registration,” and the other page is the index for a registered user. A real-world Web site has many more pages, but as you’ll see from our example, adding pages to this site is easy.

Figure 9-1 shows the “user registration” screen of our Web site. We are going to collect some data to generate a personalized Web page. Some of this data is required information, so there is a * next to the mandatory fields.

click to expand
Figure 9-1: Sign-up/Registration

For our example, we’ll be taking the first name, last name, three favorite links, a favorite image, favorite quote, page text color, page background color, and how long we should store this information.

signup.cgi

start example
01: #!/usr/bin/perl -wT 02: # signup.cgi 03: use strict; 04: use lib qw(.); 05: use BasicSession; 06: use CGI qw(:standard);
end example

Line 1 tells the system where to find Perl and turns on warnings and taint checking.

Line 2 is a comment about this program.

Line 3 loads the strict module. The strict module keeps the programmer from making simple mistakes such as redeclaring variables or mistyping a variable name. All variables must be declared before they are used—if a variable name is mistyped, an error will occur, warning the programmer of this.

Line 4 makes Perl search in the current directory (.) for modules.

Line 5 loads the BasicSession.pm module. This is a module we’ll create that has the session-tracking code as well as the code for tying our hash to the database.

Line 6 loads the CGI.pm module and its :standard set of functions.

07: my  (%item, $errors); 08: my $remember_for = param(‘remember’);

Line 7 declares a hash named %item and a scalar named $errors.

Line 8 declares a scalar variable named $remember_for and sets it to the value passed in the remember variable from the HTML form. The CGI.pm param function is used to get this value and decode it

09: if(my $clear = param(‘clear’)) { 10:     our $sess     = Get_Session("clear"); 11: }

Line 9 declares a variable named $clear and sets it to the value returned by param(‘clear’). If a value is passed from the Web page in the clear variable, this block will get entered.

Line 10 is executed if something is passed in the clear variable. This declares an our variable named $sess and sets it to the value returned by the Get_Session function. By declaring the variable as our, we are declaring it as a global variable. By passing the value "clear" to the Get_Session function, we are clearing the cookie on the user’s system.

Line 11 closes this block.

12: else { 13:     our $sess     = Get_Session($remember_for); 14: }

Line 12 is the else section of this if..else block. It gets entered if the statement on line 9 is false (that is, no value is passed in the clear variable).

Line 13 declares an our variable named $sess and passes the Get_Session function the value in $remember_for. This causes a cookie to be set on the users system and the "session value" to be returned and stored in the $sess variable. The $sess variable is the key value we use to determine who this user is throughout this program. $sess is therefore very important.

Line 14 closes this if..else block.

15: my  @fields   = qw(first_name last_name link1 link2 16:                    link3 image text_color bg_color 17:                 remember fav_quote);

Lines 15–17 declare an array named @fields and sets it to the HTML form-field names.

18: my  @required = qw(first_name last_name link1 19:                    image text_color bg_color);

Lines 18–19 declare an array named @required and set it to the values we are considering required.

20: tie %item, ‘BasicSession’;

Line 20 uses the tie function to tie the %item hash to a new object of the class BasicSession. For this to work, the BasicSession class has to provide special methods for the tied-hash interface (as described in perldoc perltie). The tie function takes the syntax tie variable, Classname, parameters...; where "parameters" is a list of whatever optional parameters the given class needs. Some classes need no parameters, some need several.

21: if(param()) { 22:     $errors = Check_Fields();

Line 21 checks to see if the param() function returns any data. If it does, it must have had some data sent to it, so we enter this block of code.

Line 22 calls the Check_Fields function and sets $errors to the value returned. Check_Fields checks the required fields to see that they contain data.

23:     if($errors) {  24:         $item{"ERROR_MESSAGE"} = "* A required item is                missing..."; 25:     }

Line 23 checks to see if the variable $errors contains anything. If it does, this block is entered.

Line 24 sets the ERROR_MESSAGE value to the string on the right.

Line 25 closes this portion of the if..elsif..else block.

26:     elsif (param(‘clear’)){ 27:         $item{"ERROR_MESSAGE"} = ""; 28:     } 

Line 26 checks to see if the clear HTML form variable has been set to 1. If so, we enter this code block.

Line 27 sets the ERROR_MESSAGE value to an empty string. This causes the cookie to be cleared from the user’s browser, enabling him or her to sign in again. This is useful if someone is on an already signed-in system but is not the user who originally signed in.

Line 28 closes this portion of the if..elsif..else block.

29:     else { 30:         $item{"ERROR_MESSAGE"}  31:          = "Data Updated!<br /> Click  32:             <a                 href=\"/cgi-bin/index.cgi\">here</a>  33:             to go to main site."; 34:     }

Line 29 is the else part of the if..elsif..else block. We get here if the preceding two conditions are not true.

Lines 30–33 simply set the ERROR_MESSAGE to a successful message that gives the user a link he or she can click to get to the main page.

Line 34 closes the last part of this if..elsif..else block.

35:     for(@fields) { 36:         if(defined param($_)) { 37:             $item{$_} = param($_); 38:         } 39:            else { 40:               delete($item{$_}); 41:         } 42:     } 43: }

Line 35 begins a loop that iterates through all of the items in the @fields array.

Line 36 checks to see if the current item has HTML form data passed. The param function will return true if so.

Line 37 adds the value passed from the HTML form to the %item hash. The key value of the hash is actually the name of the item from the HTML form. So, for example, if you had an <input type="text" name="foo_bar"> in your HTML, whatever the user entered there will appear in $item{"foo_bar"}

Line 38 ends the if statement that begins on line 36.

Line 39 is the else block that we get to if the statement on line 36 is false.

Line 40 deletes the current item.

All of the HTML form items that we care about have their names stored in the @fields array. So, as we iterate through all of the values in @fields, we go through all of the HTML form values too. If an item contains data, we need to store that data. But, if an item does not contain data, we need to make sure the item is blank in the hash. Otherwise, we end up having extra data we may not want.

Line 41 closes the if..else block.

Line 42 closes the loop that begins on line 35.

One thing to remember as we manipulate this %item hash is that because we tie the hash to the BasicSession module, it does not behave like a normal hash. In fact, as we add data to or remove data from this hash, we are adding to and deleting from a MySQL database.

Line 43 closes the if block that begins on line 21.

44: Wrap_Page("./templates", "signup.tmpl", \%item);

Line 44 calls the Wrap_Page function and passes it three values. The template directory, the file to display, and a reference to the %item hash.

All of the pages we display by using this program are merely HTML templates. We use this function to print the page header, to read and display the template file, and to display the page footer.

45: sub Check_Fields { 46:     return if(param(‘clear’) == 1);

Line 45 begins the Check_Fields function.

Line 46 returns if the clear parameter is set to 1. If it is, we do not want to proceed in this function.

47:     for my $fld (@required) { 48:         next if(param($fld)); 49:         $errors++; 50:     }

Line 47 iterates through all of the items in the @required array. These are the items that must contain data.

Line 48 calls next to jump to the next iteration of this loop if data is found.

Line 49 increments $errors if we’ve gotten here. The only way to get this far is to have an empty, required, value.

Line 50 closes this for loop.

51:     return $errors; 52: }

Line 51 returns whatever is in $errors. Let’s hope it’s empty!

Line 52 closes the Check_Fields function.

This is the end of our signup.cgi program. This is the program that reads all of the data from the signup screen and sets it in the %item hash (and therefore the database).

Once you fill in the values and click the submit button, you will see something like Figure 9-2.

click to expand
Figure 9-2: Sign-up clicked

From here, click the link to get to the index.cgi page, shown in Figure 9-3 (note the additional text in the second screen).

click to expand
Figure 9-3: index.cgi page

But how does it know what values to put where? Well, by using templates for the HTML pages, we can dynamically substitute values. By surrounding the “variables” that we want with %%, we can create an easy-to-substitute variable. For example, if we want to place the first_name somewhere on the HTML page, we simply place %%first_name%% where we want it to go.

Lets take a closer look at a template.

index.tmpl

start example
01: <div align="center"> 02:  <table border="1"> 03:   <tr> 04:    <td> 05:     <img src="/books/2/889/1/html/2/http://%%image%%" width="320" height="240" alt=""> 06:    </td> 07:    <td valign="top"> 08:     <h2>Welcome to %%first_name%% %%last_name%%’s Page!</h2><br /> 09:     <font > 10:      This is a site that contains some of %%first_name%%’s favorite          links and quotes. 11:     </font> 12:    </td> 13:   </tr> 14:   <tr> 15:    <td valign="top" colspan="2"> 16:     <font > 17:      <b>%%first_name%%’s favorite links:</b> 18:     </font> 19:     <br /> 20:     <font > 21:      <a href="http://%%link1%%">%%link1%%</a><br /> 22:      <a href="http://%%link2%%">%%link2%%</a><br /> 23:      <a href="http://%%link3%%">%%link3%%</a><br /> 24:     <br /> 25:     <font > 26:      <b>%%first_name%%’s favorite quote:</b> 27:     </font><br /> 28:     <font > 29:      %%fav_quote%% 30:     </font><br /> 31:     </font> 32:    </td> 33:   </tr> 34:  </table> 35:  <br /><br /> 36:  <table border="0"> 37:   <tr> 38:    <td> 39:     <font > 40:      If you are not %%first_name%% or have not yet signed up, please 41:     [ <a href="/cgi-bin/chapter9/signup.cgi?clear=1">Click Here</a> ]. 42:      <br /> 43:      If you <b>are</b> %%first_name%% and wish to make changes to           your page, please 44:      [ <a href="/cgi-bin/chapter9/signup.cgi">Click Here</a> ]. 45:     </font> 46:    </td> 47:   </tr> 48:  </table> 49: </div>
end example

We won’t go through this template line by line, since it is just HTML. But take a look at the bold areas. Each “variable” we are going to replace is surrounded by %% and bold. The bolding is just to make it easier to spot; the %% are important. Inside of our BasicSession module, we have a function called Print_Page that handles the variable substitution and printing of the HTML.

Before we get to the BasicSession module, we’ll take a look at index.cgi. The index.cgi script calls the preceding template file. As you’ll see, generating personalized pages using templates and tied hashes is quite easy once you’ve set it up.

index.cgi

start example
01: #!/usr/bin/perl -wT 02: use strict; 03: use lib qw(.); 04: use BasicSession; 05: use CGI qw(:standard);
end example

Line 1 tells the system where to find Perl and turns on warnings and taint checking.

Line 2 loads the strict module.

Line 3 tells Perl that it can use the current directory (the .) also when looking for modules. This is necessary because BasicSession is not in the normal path on which Perl looks for modules.

Line 4 loads the BasicSession Perl module.

Line 5 loads the CGI module and imports its :standard functions.

06: our $sess; 07: my  %item; 08: $sess = Get_Session(); 09: tie %item, ‘BasicSession’; 10: Wrap_Page("./templates", "index.tmpl", \%item); 

Line 6 declares the $sess variable by using the our declaration. Using our makes the variable globally scoped so that we can share it with the functions in the BasicSession module.

Line 7 declares the %item hash.

Line 8 sets the $sess variable to the value returned by a call to the Get_Session function.

Line 9 ties the %item variable to the BasicSession module.

Line 10 calls the Wrap_Page function. This function expects three arguments; the template directory, the name of the file to display, and a reference to the %item hash. This hash reference is used to fill in the "variables" in the HTML template.

Also, notice that we call Wrap_Page, not the Print_Page function. This is because we want all of our pages to be wrapped with a header and footer. By calling Wrap_Page, we have it do the calls to the header template, then to the index.tmpl template, and finally to the footer template.

And that is it for the index.cgi program. Simply 10 lines and a template file and you have a personalized page!

Now that we’ve seen all of the easy stuff, let’s take a look at the workhorse. The BasicSession.pm Perl module is a little bigger than the other files we’ve worked with so far. This module handles the cookies, the getting session, and all of the database transactions. Yet, this file is still under 125 lines of Perl.

BasicSession.pm

start example
01: package BasicSession; 02: use Tie::Hash; 03: use DBI; 04: use CGI qw(cookie header); 05: use strict;
end example

Line 1 sets the package for this module to BasicSession. This causes Perl to change to the BasicSession namespace rather than using the default main namespace you are in when you begin a Perl program.

Line 2 loads the Tie::Hash library, which defines the classes Tie::Hash and Tie::StdHash. We’ll use the Tie::StdHash class.

Line 3 loads the DBI module for our database access.

Line 4 loads the CGI module and imports the :standard functions.

Note 

You might notice that this module loads the CGI module; the programs that call this module might also load the CGI module. Perl is smart enough to know if the CGI module is already loaded and will not load it if it is already present.

Line 5 loads the strict module. We do all of our programming under strict mode to avoid having to debug common errors that might creep into our program.

06: use vars qw(@ISA @EXPORT $sess); 07: @ISA = qw(Tie::StdHash Exporter); 08: use Exporter; 09: @EXPORT = qw(Wrap_Page Get_Session);

Line 6 declares the variables @ISA, @EXPORT, and $sess so that strict won’t complain about them.

Line 7 loads the @ISA array by using Tie::StdHash and Exporter. The @ISA array is used for inheritance. This tells Perl that this module is a descendent of the Tie::StdHash and Exporter classes.

Line 8 calls the Exporter module. This allows us to export the functions we choose so that other Perl programs may use them.

Line 9 adds the functions that are to be exported to the @EXPORT array.

10: my $dbh = DBI->connect("DBI:mysql:user_prefs",         "bookuser", "testpass") 11:   or die "Error: $DBI::errstr\nAborting"; 12: my ($sql, @KEYS);

Line 10 creates our connection to the database by using the DBI module. The result of the connection is stored as a handle in $dbh.

Line 11 is part of line 10. If the connection to the database has failed, line 11 will cause the program to abort and display an error message.

Line 12 declares some variables that we’ll be using.

13: sub STORE { 14:     my ($self, $key, $val) = @_; 15:     $val =~ s#^http://##;  # Get rid of http://  16:     my $exists = $self->EXISTS($key);

Line 13 begins our STORE subroutine.

Note 

Remember that when a hash is tied to a class, certain subroutines must be created so that Perl knows what to do for each possible way the hash is accessed. Because of this, we need to have TIEHASH; STORE, FETCH; EXISTS; CLEAR; DELETE; FIRSTKEY; NEXTKEY, and DESTROY methods.

Luckily, someone has done all of the initial work for us. The Tie::Hash module we have imported contains default methods for each of these actions. So, if you want to stick with the default behavior, you don’t have to worry about creating a method for it; it has already been done. Since our hash is tied directly to a database, however, we’ll need to create our own methods for most of these actions.

Line 14 reads in the values passed to the subroutine. The first value is always a reference to itself, so we’ll call it $self. The next two are the key and value pair that will be the key and value of the hash item.

Line 15 examines the $val variable and removes any http:// that may be at the beginning of the string. This occurs so that any links that the users enter will not have the http:// in them.

Line 16 checks to see if the value we are setting already exists. The EXISTS method expects the session and $key to be passed to it. If it does exist, the $exists variable will be set to a true value.

17:     if($exists) { 18:         $sql = qq{ UPDATE session  19:                    SET  20:               name  = ‘$key’,  21:               value = ‘$val’  22:               WHERE  23:               (user_id = ‘$main::sess’  24:                    AND name = ‘$key’) }; 25:     }

Line 17 begins an if..else block. This section checks to see if the $exists variable contains a true value. If so, this block is entered.

Lines 18–24 create the SQL statement needed to update the value in the database. Since the value already exists, we cannot do an INSERT; we must do an UPDATE instead. This sets the $key and $val to the new value, where the user_id is $main::sess and the name is $key.

Line 25 ends this part of the if..else block.

26:     else { 27:         $sql = qq{INSERT INTO session  28:                 (name, value, user_id)  29:             VALUES  30:              (‘$key’, ‘$val’, ‘$main::sess’) }; 31:     } 

Line 26 is where we end up if the $exists variable does not contain a true value. This means that the item we are trying to add to the hash does not yet exist.

Lines 27–30 create the SQL statement needed to insert this new value into the database.

Line 31 ends this block and the if..else statement.

32:     my $sth = $dbh->prepare($sql); 33:     $sth->execute or die $DBI::errstr; 34: }

Line 32 prepares the $sql statement that we just created and stores a handle to the prepared statement in $sth.

Line 33 executes the SQL statement. If there is a problem executing it, the program will abort, and an error message will be displayed.

Line 34 ends the STORE subroutine.

35: sub EXISTS { 36:     my ($self, $sess, $key) = @_; 37:     my $sql = qq{ SELECT * FROM session 38:                   WHERE user_id = ? AND 39:             name = ?};

Line 35 begins the EXISTS subroutine. This subroutine simply has to check the database to see if the key already exists. If it does, it simply has to return some data (true); if not, it returns 0 (false).

Line 36 gets the arguments passed to the subroutine ($sess and $key, in this case, since the $self value is passed automatically).

Lines 37–39 create the SQL statement that selects all data from the session table, where the user_id = (the session id) and the name = (the key value).

40:     my $sth = $dbh->prepare($sql); 41:     $sth->execute($sess, $key) or die $DBI::errstr; 42:     my $tmp = $sth->fetch;

Line 40 prepares the SQL statement we just created and stores a handle, or reference, to that statement in $sth.

Line 41 executes the SQL statement and passes the values in $sess and $key to the statement to fill in the placeholders (?) used in the SQL statement. If, for some reason, the execute fails, the die statement will cause the program to terminate and display an error message.

Line 42 creates a variable named $tmp and stores the result of a call to $sth->fetch. If any data is returned, $tmp should contain a reference to an array of the data now.

43:     return $tmp->[0] ? $tmp->[0] : 0; 44: }

Line 43 checks to see if element [0] contained any data. If so, this item existed. This line uses the trinary operator to return the proper value. If $tmp->[0] is true (it contained data), the first item after the ? will be returned ($tmp->[0]). If not ($tmp->[0] was false), the value after the : is returned, 0 in our case.

Line 44 ends the EXISTS subroutine.

45: sub DELETE { 46:     my ($self, $key) = @_;

Line 45 creates the DELETE subroutine. This is used to delete a value from the hash and database. It corresponds to a call to Perl’s delete function on a hash value.

Line 46 gets the values passed in to this subroutine. This subroutine simply needs to be passed the $key of the value being deleted.

47:     my $sql = qq{ DELETE FROM session 48:                   WHERE user_id = ? AND 49:                   name = ?};

Lines 47–49 create the SQL statement needed to delete the value from the database.

50:     my $sth = $dbh->prepare($sql); 51:     $sth->execute($main::sess, $key) or die $DBI::errstr; 52: }

Line 50 prepares the SQL statement and stores a reference to the prepared statement in the $sth variable.

Line 51 executes the SQL statement. We pass the values $main::sess and $key to fill in the placeholders in the SQL statement. If the execute fails for some unlikely reason, say the database is no longer available, the die statement will cause the program to abort and display an error message.

Line 52 ends the DELETE subroutine.

53: sub FIRSTKEY { 54:     my $self = shift; 

Line 53 begins the FIRSTKEY subroutine. This subroutine is used when a call to each or keys is made. It typically needs the NEXTKEY subroutine as well to work properly.

Line 54 shifts in a reference to itself; nothing is passed to this subroutine.

55:     my $sql = qq{ SELECT name FROM session 56:                   WHERE user_id = ? };

Lines 55–56 create the SQL statement to select all of the name items from the session table, where user_id = (the session id).

57:     my $sth = $dbh->prepare($sql); 58:     $sth->execute($main::sess) or die $DBI::errstr; 59:     $self->{DATA}  = $sth->fetchall_arrayref;

Line 57 prepares the SQL statement and stores a reference to the prepared statement in the $sth variable.

Line 58 executes the SQL statement and passes $main::sess to fill the placeholder. If a problem occurs during this statement’s execution, the die function will cause the program to abort and display an error message.

Line 59 sets $self->{DATA} to the value returned by the call to $sth->fetchall_arrayref. $sth->fetchall_arrayref returns a reference to an array containing all values returned by the SQL call.

60:     for(@{$self->{DATA}}) { 61:         $_ = $_->[0]; 62:         $_ = ‘’ unless defined $_; 63:     }

Line 60 begins a for loop that iterates over all of the elements in the array referenced by $self->{DATA}.

Line 61 sets the current item, $_, to the value of the current array, element [0].

Line 62 sets the current value of $_ to an empty string if it is not defined. We can’t return undef as a key, or we will get an error.

Line 63 closes this for loop.

64:     return shift @{ $self->{DATA} }; 65: }

Line 64 returns the first key, or undef.

Line 65 ends this FIRSTKEY subroutine.

66: sub NEXTKEY { 67:     my ($self) = @_; 68:     return shift @{ $self->{DATA} }; 69: }

Line 66 begins the NEXTKEY subroutine. This is the second half of the subroutines that handle the each and keys calls for tied hashes.

Line 67 gets the value passed to the subroutine.

Line 68 returns the same thing we return in the FIRSTKEY subroutine. Perl knows how to handle this though and takes the next key of the hash.

Line 69 ends the NEXTKEY subroutine.

70: sub FETCH { 71:     my ($self, $key) = @_;

Line 70 begins the FETCH subroutine. This is the subroutine that gets called when someone tries to get a value from a tied hash, like so:

my $foo = $item{first_name};

This is considered fetching the value of the %item hash with the first_name key. The result is a call to the FETCH subroutine.

Line 71 gets the values passed to the subroutine.

72:     my $sql = qq{ SELECT value FROM session 73:                   WHERE user_id = ? AND 74:                   name = ?};

Lines 72–74 create the SQL needed to fetch an item from the database. Here we need the item name (which is the key). The user_id is just the $main::sess variable stored as a cookie on the user’s browser.

75:     my $sth = $dbh->prepare($sql); 76:     $sth->execute($main::sess, $key) or die $DBI::errstr;

Line 75 prepares the SQL and stores a reference to the prepared SQL statement in $sth.

Line 76 executes the SQL statement and passes the $main::sess and $key values to fill in the placeholders in the SQL statement. If there is a problem executing the SQL statement, the die function is called, and an error message displayed.

77:     my $tmp = $sth->fetch; 78:     return $tmp->[0]; 79: }

Line 77 creates a variable named $tmp and sets it to the value returned by a call to $sth->fetch.

Line 78 returns the value at element [0] of $tmp. Since the SQL statement is looking for a specific item, and using the primary key (user_id) to find the value, no more than one value should ever be returned. This is why we can rely on using element [0]—if there is an item, it will be at this element and if there isn’t, then the value of $tmp->[0] is undef, which is what you get when you try to call $something{"stuff"} and there’s no such entry in that hash.

Line 79 closes the FETCH subroutine.

80: sub DESTROY { 81:     $dbh->disconnect(); 82: }

Line 80 begins the DESTROY subroutine. This is the subroutine called when the tie-hash object is no longer used and Perl is garbage collecting.

Line 81 disconnects from the database.

Line 82 ends the DESTROY subroutine.

That was the last of the subroutines related to the tied hash.

83: sub Get_Session { 84:     my $expires = shift; 85:     my $sess    = cookie("user_id"); 86:     my $cookie; 87:     $sess = time() . $$ unless($sess);

Line 83 begins the Get_Session subroutine. This subroutine is used to get the cookie from the user, if the cookie exists.

Line 84 shifts in the expiration date. These functions do not automatically pass a reference to themselves, so you don’t see the $self variable anymore.

Line 85 calls the cookie function and tells it to get the user_id cookie. The value returned is stored in $sess.

Line 86 declares a variable named $cookie.

Line 87 sets $sess to the value returned by a call to time() plus the current process id $$. The unless($sess) tells Perl to set $sess only if it does not yet contain any data. This means that if data has already been set by the call to the cookie function on line 85, this line will be ignored.

Note 

The session value is the current time plus the process ID. This should be a unique string and safe for most applications.

88:     if($expires eq "clear") { 89:         $cookie = cookie( -name    => ‘user_id’, 90:                           -value   => ‘’, 91:                           -expires => "now", 92:                         ); 93:     }

Line 88 checks to see if the variable $expires is equal to clear. If so, we enter this block of code and expire the users cookie.

Lines 89–92 are the call to the cookie function. The cookie function is very handy and versatile. Notice that we call it previously and pass it a name and that it returns the cookie to us. Now, we are calling it and passing it some values. We pass it the cookie name, the value to store, and when the cookie should expire. The properly formatted cookie is then stored in the variable named $cookie.

Line 93 closes this part of the if..else block.

94:     else { 95:         $cookie = cookie( -name    => ‘user_id’, 96:                           -value   => $sess, 97:                           -expires => $expires, 98:                         ); 99:     }

Line 94 begins the else block; we get here if the value of $expires is not clear.

Lines 95–98 again create a cookie. This time, though, we set the value to $sess and expires to $expires.

Line 99 ends the if..else block.

100:     print header( -cookie => $cookie ); 101:     return $sess; 102: } 

Line 100 prints the HTTP header and passes the cookie to the header function. Passing the cookie to the header function causes the header function to pass not only the HTTP header information, but also the properly formatted cookie information.

Line 101 returns the $sess.

Line 102 ends the Get_Session subroutine.

103: sub Wrap_Page { 104:     my $tdir = shift; 105:     my $tmpl = shift; 106:     my $item = shift;

Line 103 beings the Wrap_Page subroutine. This subroutine is used to wrap a header and footer around the page we want to print.

Lines 104–106 shift in the information needed for this function. $tdir is the template directory, $tmpl is the template of the file we wish to display, and $item is a reference to the hash that contains the data, dynamically displayed on the page.

107:     Print_Page($tdir, "header.tmpl", $item); 108:     Print_Page($tdir, $tmpl, $item); 109:     Print_Page($tdir, "footer.tmpl", $item); 110: }

Lines 107–109 are simply calls to the Print_Page subroutine. Print_Page handles the details of substituting in the dynamic variables and displaying the HTML.

Line 110 ends the Wrap_Page subroutine.

111: sub Print_Page { 112:     my $tdir = shift; 113:     my $tmpl = shift; 114:     my $item = shift;

Line 111 begins the Print_Page subroutine. This is the one that substitutes the dynamic variables and prints the HTML.

Lines 112–114 shift in the values passed to the subroutine. These are the same values passed to the Wrap_Page subroutine.

115:     local $^W = 0; 116:     open(TMPL, "$tdir/$tmpl")               or die("ERROR: $!\nAborting"); 117:         while(<TMPL>) { 118:             s/%%(.*?)%%/$item->{$1}/g; 119:             print; 120:         } 121:     close(TMPL); 

Line 115 turns warnings off for this block. Turning warnings off will suppress undef warning messages that may occur if we try to replace an item %%foo%% and there’s no $item->{"foo"}.

Line 116 opens the template file and stores the filehandle in TMPL.

Line 117 loops through the filehandle, one line at a time.

Line 118 replaces for the %%varname%% strings in the template with the appropriate values. The parentheses capture the variable name between the %%’s and stores it in $1. Then, on the right side of the substitution it calls $item->{$1} so to get the value of that key in the %$item hash. So "In %%city%%, I bet it’s hot!" looks up $item->{‘city’}, producing "In Springfield, I bet it’s hot!". If there is no "city" entry in the %$item hash, an empty-string is interpolated, like "In , I bet it’s hot!". Line 119 prints the current line.

Line 120 closes the while loop that begins on line 115.

Line 121 closes the TMPL filehandle.

122:     return; 123: } 124: 1;

Line 122 returns from the subroutine.

Line 123 closes this subroutine.

Line 124 is needed because all modules must return a true value to signal that it has been properly loaded—this returns 1, so it satisfies that requirement.



Perl Database Programming
Perl Database Programming
ISBN: 0764549561
EAN: 2147483647
Year: 2001
Pages: 175

flylib.com © 2008-2017.
If you may any questions please contact us: flylib@qtcs.net