Program Listings

Listings 9-1 to 9-6 show the complete listings of the programs what we covered in this chapter.

Listing 9-1: 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); 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: }
end example

Listing 9-2: index.cgi

start example
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);
end example

Listing 9-3: BasicSession.pm

start example
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;
end example

Listing 9-4: header.tmpl

start example
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>
end example

Listing 9-5: 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

Listing 9-6: footer.tmpl

start example
01:  </body> 02: </html>
end example



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

Similar book on Amazon

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