fig15_23.pl

来自「PERL语言资料 可以用于PERL程序设计」· PL 代码 · 共 267 行

#!perl
# Fig. 15.21: fig15_21.pl
# Demonstrates providing a web interface for a database.

use warnings;
use strict;
use DBI;
use DBD::ODBC;
use CGI qw( :standard );

my $DSN = "dbi:ODBC:employeeDB";

print header(), 
   start_html( { title => "Working with DBI",
      background => "http://localhost/images/background.jpg" } );

unless ( param ) {
   print h1( "Database Manager" ),
         start_form(),
         popup_menu( -name => 'selection',
                     -value => [ 'View the Database',
                                 'Insert a Record',
                                 'Delete a Record',
                                 'Update a Record' ] ),
         hidden( { -name => "LAST", -value => "MAIN" } ),
         br(), br(), br(), br(), br(),
         submit( -value => "Click to Proceed" ),
         end_form();
}
else {
   my $dbh = DBI->connect( $DSN, "", "", { RaiseError => 1 } );
   
   if ( param( "LAST" ) eq "MAIN" ) {
      my $selection = param( "selection" );
 
      view( $dbh ) if ( $selection eq "View the Database" );
      displayInsert() if ( $selection eq "Insert a Record" );
      displayDelete( $dbh ) if ( $selection eq "Delete a Record" );
      displayUpdate( $dbh ) if ( $selection eq "Update a Record" );
   }
   elsif ( param( "LAST" ) eq "INSERT" ) {
      insertRecord( $dbh );
      view( $dbh );
   }
   elsif ( param( "LAST" ) eq "DELETE" ) {
      deleteRecord( $dbh );
      view( $dbh );
   }
   elsif ( param( "LAST" ) eq "UPDATE1" ) {
      updateRecordForm( $dbh );
   }
   elsif ( param( "LAST" ) eq "UPDATE2" ) {
      updateRecord( $dbh );
      view( $dbh );
   }
   $dbh->disconnect();
}

print end_html();

sub view 
{
   my $dbh = shift(); 
   
   my $sth = $dbh->prepare( 
      "SELECT * FROM employee ORDER BY EmployeeID ASC" );
   $sth->execute();
   
   my $rows = $sth->fetchall_arrayref();
   $sth->finish();
   
   my $tablerows = 
      Tr( th( { -bgcolor => "#dddddd", -align=>'left' }, 
              [ "ID", "First", "Last"] ),
          th( { -bgcolor => "#dddddd" }, [ "YOB", "SSN" ] ) );
          
   foreach my $row ( @$rows ) {
      $tablerows .= Tr( td( { -bgcolor => "#dddddd" }, $row ) );
   }
   
   print h1( "Employee Database" ),
         table( { -border => 0, -cellpadding => 5, 
                  -cellspacing => 0 }, $tablerows ),
         br(), br(),
         "Your query yielded ", b( scalar( @$rows ) ), 
         " records.",br(), br(),
         a( { -href => "/cgi-bin/fig15_23.pl" }, 
            "Back to the Main Database Page" );
}
      
sub displayInsert 
{
   print h3( "Add a new employee to the database." ), br(),
         start_form(),
            "Employee ID", br(), 
            textfield( -name => 'ID' ), br(),
            "First Name", br(), 
            textfield( -name => 'FIRST' ), br(),
            "Last Name", br(), 
            textfield( -name => 'LASTNAME' ), br(),
            "Year of Birth", br, 
            textfield( -name => 'YEAR' ), br(), 
            "Social Security Number", br(), 
            textfield( -name => 'SSN' ),
            hidden( { -name => "LAST", -value => "INSERT",
                      -override => "1" } ),
            br(), br(), submit( -value => "Add New Employee" ), 
         end_form(), br(), br(),
         a( { -href => "/cgi-bin/fig15_23.pl" }, 
            "Back to the Main Database Page" );
}

sub displayDelete
{
   my $dbh = shift();
   
   my $sth = $dbh->prepare(  
      "SELECT EmployeeID, FirstName, LastName FROM employee " );
   
   $sth->execute();
   
   my ( %names, @ids );

   while ( my @row = $sth->fetchrow_array ) {
      push( @ids, $row[ 0 ] );
      $names{ $row[ 0 ] } = join( " ", @row[ 1, 2 ] );
   }

   $sth->finish;
   
   print h3( "Delete an employee from the database" ), br(),
      start_form(),
         "Select an Employee to delete ",
         popup_menu( -name => 'DELETE_ID', 
                     -value => \@ids, 
                     -labels => \%names ), br(), br(), br(),
         hidden( { -name => "LAST", -value => "DELETE", 
                   -override => 1 } ),
         submit( -value => "Delete a Record" ), br(), br(),
      end_form(), 
      font( { -color => "red" }, 
            "This action removes the record permanently." ),
      br(), br(), a( { -href => "/cgi-bin/fig15_23.pl" }, 
                     "Back to the Main Database Page" );
}
      
sub displayUpdate
{
   my $dbh = shift();
   
   my $sth = $dbh->prepare(  
      "SELECT EmployeeID, FirstName, LastName FROM employee " );
   
   $sth->execute();
   
   my ( %names, @ids );

   while ( my @row = $sth->fetchrow_array ) {
      push( @ids, $row[ 0 ] );
      $names{ $row[ 0 ] } = join( " ", @row[ 1, 2 ] );
   }

   $sth->finish;
   
   print h3( "Update an employee in the database" ), br(),
      start_form(),
         "Select an Employee to update ",
         popup_menu( -name => 'UPDATE_ID', 
                     -value => \@ids, 
                     -labels => \%names ), br(), br(), br(),
         hidden( { -name => "LAST", -value => "UPDATE1", 
                   -override => 1 } ), 
         submit( -value => "Update a Record" ), br(), br(),
      end_form(), 
      a( { -href => "/cgi-bin/fig15_23.pl" }, 
         "Back to the Main Database Page" );
}

sub updateRecordForm 
{
   my $dbh = shift();   
   my $statement = "SELECT * FROM employee " .
                   "WHERE EmployeeID = '" . 
                   param( 'UPDATE_ID' ) . "'";
   my $sth = $dbh->prepare( $statement );

   $sth->execute();
   
   my @values = $sth->fetchrow_array;
   my @names = ( "", "First Name ", "Last Name ", "Year Born ",
                 "Social Security Number " );
   $sth->finish();
   
   print h3( "Updating the record for employee #$values[ 0 ]." ),
         br(), br(),
         start_form(),
            "@values\n", br(),
            hidden( { -name => '0', -value => $values[ 0 ] } );
  
   foreach ( 1 .. 4 ) {
      print $names[$_], br(),
            textfield( -name=>$_, -value => $values[ $_ ], 
                       -override => 1 ), br();
   }
   
   print submit( -value => "Update the Record" ),
         hidden( { -name => "LAST", -value => "UPDATE2", 
                   -override => 1 } ),
         end_form(),
       a( { -href => "/cgi-bin/fig15_23.pl" }, 
          "Back to the Main Database Page" );
}

sub insertRecord
{
   my $dbh = shift();
   my ( $id, $first, $last, $year, $ssn ) = 
      ( param( 'ID' ), param( 'FIRST' ), param( 'LASTNAME' ),
        param( 'YEAR' ), param( 'SSN' ) );    
   my $string = "INSERT INTO employee VALUES 
        ( '$id', '$first', '$last', '$year', '$ssn' );";
  
   $dbh->do( $string );
}

sub deleteRecord 
{
   my $dbh = shift();
   my $string = "DELETE FROM employee ".
                "WHERE EmployeeID = '" . 
                param( 'DELETE_ID' ) . "'";
   
   $dbh->do( $string );
   print "Employee #", param( 'DELETE_ID' ), 
         " deleted.", br(), br();
}

sub updateRecord
{
   my $dbh = shift();
   my ( $id, $first, $last, $year, $ssn ) = 
      ( param( '0' ), param( '1' ), param( '2' ), 
        param( '3' ), param( '4' ) );
   my $string = "UPDATE employee SET FirstName = '$first', " .
                "LastName = '$last', YearBorn = '$year', " .
                "SocialSecurity = '$ssn' " .
                "WHERE EmployeeID = '$id'";
   
   $dbh->do( $string );
}                   


###########################################################################
#  (C) Copyright 2001 by Deitel & Associates, Inc. and Prentice Hall.     #
#  All Rights Reserved.                                                   #
#                                                                         #
#  DISCLAIMER: The authors and publisher of this book have used their     #
#  best efforts in preparing the book. These efforts include the          #
#  development, research, and testing of the theories and programs        #
#  to determine their effectiveness. The authors and publisher make       #
#  no warranty of any kind, expressed or implied, with regard to these    #
#  programs or to the documentation contained in these books. The authors #
#  and publisher shall not be liable in any event for incidental or       #
#  consequential damages in connection with, or arising out of, the       #
#  furnishing, performance, or use of these programs.                     #
###########################################################################