Listings 9-1 to 9-6 show the complete listings of the programs what we covered in this chapter.
Listing 9-1: signup.cgi
01: #!/usr/bin/perl -wT 02: # signup.cgi 03: use strict; 04: use lib qw(.); 05: use BasicSession; 06: use CGI qw(:standard); 07: my (%item, $errors); 08: my $remember_for = param(‘remember’); 09: if(my $clear = param(‘clear’)) { 10: our $sess = Get_Session("clear"); 11: } 12: else { 13: our $sess = Get_Session($remember_for); 14: } 15: my @fields = qw(first_name last_name link1 link2 16: link3 image text_color bg_color 17: remember fav_quote); 18: my @required = qw(first_name last_name link1 19: image text_color bg_color); 20: tie %item, ‘BasicSession’; 21: if(param()) { 22: $errors = Check_Fields(); 23: if($errors) { 24: $item{"ERROR_MESSAGE"} = "* A required item is missing..."; 25: } 26: elsif (param(‘clear’) == 1){ 27: $item{"ERROR_MESSAGE"} = ""; 28: } 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: } 35: for(@fields) { 36: if(defined param($_)) { 37: $item{$_} = param($_); 38: } 39: else { 40: delete($item{$_}); 41: } 42: } 43: } 44: Wrap_Page("./templates", "signup.tmpl", \%item); 45: sub Check_Fields { 46: return if(param(‘clear’) == 1); 47: for my $fld (@required) { 48: next if(param($fld)); 49: $errors++; 50: } 51: return $errors; 52: }
Listing 9-2: index.cgi
01: #!/usr/bin/perl -wT 02: use strict; 03: use lib qw(.); 04: use BasicSession; 05: use CGI qw(:standard); 06: our $sess; 07: my %item; 08: $sess = Get_Session(); 09: tie %item, ‘BasicSession’; 10: Wrap_Page("./templates", "index.tmpl", \%item);
Listing 9-3: BasicSession.pm
01: package BasicSession; 02: use Tie::Hash; 03: use DBI; 04: use CGI qw(cookie header); 05: use strict; 06: use vars qw(@ISA @EXPORT $sess); 07: @ISA = qw(Tie::StdHash Exporter); 08: use Exporter; 09: @EXPORT = qw(Wrap_Page Get_Session); 10: my $dbh = DBI->connect("DBI:mysql:user_prefs", "bookuser", "testpass") 11: or die "Error: $DBI::errstr\nAborting"; 12: my ($sql, @KEYS); 13: sub STORE { 14: my ($self, $key, $val) = @_; 15: $val =~ s#^http://##; # Get rid of http:// 16: my $exists = $self->EXISTS($key); 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: } 26: else { 27: $sql = qq{INSERT INTO session 28: (name, value, user_id) 29: VALUES 30: (‘$key’, ‘$val’, ‘$main::sess’) }; 31: } 32: my $sth = $dbh->prepare($sql); 33: $sth->execute or die $DBI::errstr; 34: } 35: sub EXISTS { 36: my ($self, $sess, $key) = @_; 37: my $sql = qq{ SELECT * FROM session 38: WHERE user_id = ? AND 39: name = ?}; 40: my $sth = $dbh->prepare($sql); 41: $sth->execute($sess, $key) or die $DBI::errstr; 42: my $tmp = $sth->fetch; 43: return $tmp->[0] ? $tmp->[0] : 0; 44: } 45: sub DELETE { 46: my ($self, $key) = @_; 47: my $sql = qq{ DELETE FROM session 48: WHERE user_id = ? AND 49: name = ?}; 50: my $sth = $dbh->prepare($sql); 51: $sth->execute($main::sess, $key) or die $DBI::errstr; 52: } 53: sub FIRSTKEY { 54: my $self = shift; 55: my $sql = qq{ SELECT value FROM session 56: WHERE user_id = ? }; 57: my $sth = $dbh->prepare($sql); 58: $sth->execute($main::sess) or die $DBI::errstr; 59: $self->{DATA} = $sth->fetchall_arrayref; 60: for(@{$self->{DATA}}) { 61: $_ = $_->[0]; 62: $_ = ‘’ unless defined $_; 63: } 64: return shift @{ $self->{DATA} }; 65: } 66: sub NEXTKEY { 67: my ($self) = @_; 68: return shift @{ $self->{DATA} }; 69: } 70: sub FETCH { 71: my ($self, $key) = @_; 72: my $sql = qq{ SELECT value FROM session 73: WHERE user_id = ? AND 74: name = ?}; 75: my $sth = $dbh->prepare($sql); 76: $sth->execute($main::sess, $key) or die $DBI::errstr; 77: my $tmp = $sth->fetch; 78: return $tmp->[0]; 79: } 08: sub DESTROY { 81: $dbh->disconnect(); 82: } 83: sub Get_Session { 84: my $expires = shift; 85: my $sess = cookie("user_id"); 86: my $cookie; 87: $sess = time() . $$ unless($sess); 88: if($expires eq "clear") { 89: $cookie = cookie( -name => ‘user_id’, 90: -value => ‘’, 91: -expires => "now", 92: ); 93: } 94: else { 95: $cookie = cookie( -name => ‘user_id’, 96: -value => $sess, 97: -expires => $expires, 98: ); 99: } 100: print header( -cookie => $cookie ); 101: return $sess; 102: } 103: sub Wrap_Page { 104: my $tdir = shift; 105: my $tmpl = shift; 106: my $item = shift; 107: Print_Page($tdir, "header.tmpl", $item); 108: Print_Page($tdir, $tmpl, $item); 109: Print_Page($tdir, "footer.tmpl", $item); 110: } 111: sub Print_Page { 112: my $tdir = shift; 113: my $tmpl = shift; 114: my $item = shift; 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); 122: return; 123: } 124: 1;
Listing 9-4: header.tmpl
01: <html><head><title>%%title%%</title> 02: <style type="text/css"> 03: <!-- 04: body { background: %%bg_color%% } 05: hr { color: #c0c0c0 } 06: td { background: #e0e0e0; 07: color: #000000; 08: font-size: 10pt 09: font-family: Lucida, Verdana, Helvetica, Arial; } 10: a:link { color: #4444ff; 11: background: #c0c0c0 } 12: a:visited { color: #333377 } 13: a:active { color: #0000dd } 14: i, p, ul, li 15: { font-family: Lucida, Verdana, Helvetica, Arial; 16: font-size: 10pt; 17: color: %%text_color%% } 18: b 19: { font-family: Lucida, Verdana, Helvetica, Arial; 20: font-size: 10pt; 21: color: %%text_color%% } 22: .small 23: { font-family: Lucida, Verdana, Helvetica, Arial; 24: font-size: 10pt; 25: color: %%text_color%% } 26: .medium 27: { font-family: Lucida, Verdana, Helvetica, Arial; 28: font-size: 12pt; 29: color: %%text_color%% } 30: .big_error 31: { font-family: Lucida, Verdana, Helvetica, Arial; 32: font-size: 14pt; 33: font-weight: bold; 34: color: #ff0000 } 35: .big 36: { font-family: Lucida, Verdana, Helvetica, Arial; 37: font-size: 14pt; 38: color: %%text_color%% } 39: h2 40: { font-family: Lucida, Verdana, Helvetica, Arial; 41: font-size: 18pt; 42: color: %%text_color%% } 43: h1 44: { font-family: Lucida, Verdana, Helvetica, Arial; 45: font-size: 24pt; 46: color: %%text_color%% } 47: --> 48: </style> 49: </head> 50: <body>
Listing 9-5: index.tmpl
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>
Listing 9-6: footer.tmpl
01: </body> 02: </html>