DBI (CGI Programming with Perl)

10.4.1. Using DBI

In the examples here, we will use the DBD::CSV DBI driver. DBI drivers are preceded with "DBD" (database driver) followed by the actual driver name. In this case, CSV is short for "Comma Separated Value," otherwise known as a comma-delimited flat text file. The reason the examples use DBD::CSV is that this driver is the simplest in terms of feature availability, and also DBD::CSV does not require you to know how to set up a relational database engine such as Sybase, Oracle, PostgreSQL, or MySQL.

If you are using Perl on Unix, the DBD::CSV driver may be found on CPAN and should be easily compiled for your platform by following the instructions. If you are using Perl on Win32 from ActiveState, we recommend using ActiveState's PPM (Perl Package Manager) to download the DBD::CSV binaries from the ActiveState package repository for Win32 (refer to Appendix B, "Perl Modules").

10.4.1.1. Connecting to DBI

To connect to a DBI database, you need to issue the connect method. A database handle that represents the connection is returned from the connect statement if successful:

use DBI;

my $dbh = DBI->connect("DBI:CSV:f_dir=/usr/local/apache/data/stats")
      or die "Cannot connect: " . $DBI::errstr;

The use statement tells Perl which library to load for accessing DBI. Finally, the connect statement takes the string that has been passed to it and determines the database driver to load, which in this case is DBD::CSV. The rest of the string contains database driver specific information such as username and password. In the case of DBD::CSV, there is no username and password; we need to specify only a directory where files representing database tables will be stored.

When you are finished with the database handle, remember to disconnect from the database:

$dbh->disconnect;

10.4.1.2. Database manipulation

Database manipulation in DBI is quite simple. All you need to do is pass the create table, insert, update, or delete statement to the do method on the database handle. Immediately, the command will be executed:

$dbh->do( "insert into Player_Info values ('Hakeem Olajuwon', 10, 27, 11, 4, 2)")
      or die "Cannot do: " . $dbh->errstr(  );

10.4.1.3. Database querying

Querying a database with DBI involves a few more commands since there are many ways in which you might want to retrieve data. The first step is to pass the SQL query to a prepare command. This will create a statement handle that is used to fetch the results:

my $sql = "select * from Player_Info";
my $sth = $dbh->prepare($sql) 
           or die "Cannot prepare: " . $dbh->errstr(  );
 $sth->execute(  ) or die "Cannot execute: " . $sth->errstr(  );

my @row;
while (@row = $sth->fetchrow_array(  )) {
  print join(",", @row) . "\n";
}
$sth->finish(  );

Once the prepare command has been issued, the execute command is used to start the query. Since a query expects return results, we use a while loop to get each database record. The fetchrow_array command is used to fetch each row that is returned as an array of fields.

Finally, we clean up the statement handle by issuing the finish method. Note that in most cases we do not have to explicitly call the finish method. It is implicitly called by virtue of the fact that we have retrieved all the results. However, if the logic of your program decided to stop retrieving records before the entire statement had finished being retrieved, then calling finish is necessary in order to flush out the statement handle.

10.4.2. DBI Address Book

Most companies with an intranet have an online address book for looking up phone numbers and other employee details. Here, we'll use DBI to implement a full address book against any database that supports SQL.

10.4.2.1. Address book database creation script

There are two scripts we need to take a look at. The first is not a web script. It is a simple script that creates the address table for the address book CGI to access:

#!/usr/bin/perl -wT

use strict;

use DBI;

my $dbh = DBI->connect("DBI:CSV:f_dir=/usr/local/apache/data/address_book")
      or die "Cannot connect: " . $DBI::errstr;
my $sth = $dbh->prepare(qq`
     CREATE TABLE address 
     (lname    CHAR(15),
      fname    CHAR(15),
      dept     CHAR(35),
      phone    CHAR(15),
      location CHAR(15))`)
      or die "Cannot prepare: " . $dbh->errstr(  );
$sth->execute(  ) or die "Cannot execute: " . $sth->errstr(  );
$sth->finish(  );

$dbh->disconnect(  );

As you can see, this script puts together the DBI concepts of connecting to a database and submitting a table creation command. There is one twist though. Although it was previously demonstrated that the table creation could be accomplished through a simple do method on the database handle, the DBI code we used is similar to the DBI commands used to query a database.

In this case, we prepare the create table statement first, and then execute it as part of a statement handle. Although it is quick and easy to use the single do method, breaking up the code like this allows us to troubleshoot errors at different levels of the SQL submission. Adding this extra troubleshooting code can be very useful in a script that you need to support in production.

The final result is a table called address in the /usr/local/apache/data/address_book directory. The address table consists of five fields: lname (last name), fname (first name), dept (department), phone, and location.

10.4.2.2. Address book CGI script

The address book CGI script is a self-contained program that displays query screens as well as allows the users to modify the data in the address book in any fashion they like. The default screen consists of a list of form fields representing fields in the database you might wish to query on (see Figure 10-1). If the Maintain Database button is selected, a new workflow is presented to the user for adding, modifying, or deleting address book records (see Figure 10-2).

Figure 10-1. Address book main page

Figure 10-2. Address book maintenance page

Here's the beginning of the code for the address book CGI script:

#!/usr/bin/perl -wT

use strict;

use DBI;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use vars qw($DBH $CGI $TABLE @FIELD_NAMES @FIELD_DESCRIPTIONS);

$DBH = DBI->connect("DBI:CSV:f_dir=/usr/local/apache/data/address_book")
      or die "Cannot connect: " . $DBI::errstr;

@FIELD_NAMES = ("fname", "lname", "phone",
                "dept", "location");

@FIELD_DESCRIPTIONS = ("First Name", "Last Name", "Phone",
                       "Department", "Location");

$TABLE = "address";

$CGI = new CGI(  );

The use vars statement declares all the global variables we will use in the program. Then, we initialize the global variables for use. First, $DBH contains the database handle to be used throughout the program. Then, @FIELD_NAMES and @FIELD_DESCRIPTIONS contains a list of the field names in the database as well as their descriptive names for display to a user. @FIELD_NAMES also doubles as a list of what the form variable names that correspond to database fields will be called. $TABLE simply contains the table name.

Finally, $CGI is a CGI object that contains the information about data that was sent to the CGI script. In this program, we will make heavy use of the parameters that are sent in order to determine the logical flow of the program. For example, all the submit buttons on a form will be labelled with the prefix "submit_" plus an action. This will be used to determine which button was pressed and hence which action we would like the CGI script to perform.

if ($CGI->param( "submit_do_maintenance" ) ) {
  displayMaintenanceChoices( $CGI );
}
elsif ( $CGI->param( "submit_update" ) ) {
  doUpdate( $CGI, $DBH );
}
elsif ( $CGI->param( "submit_delete" ) ) {
  doDelete( $CGI, $DBH );
}
elsif ( $CGI->param( "submit_add" ) ) {
  doAdd( $CGI, $DBH );
}
elsif ( $CGI->param( "submit_enter_query_for_delete" ) ) {
  displayDeleteQueryScreen( $CGI );
}
elsif ( $CGI->param( "submit_enter_query_for_update" ) ) {
  displayUpdateQueryScreen( $CGI );
}
elsif ( $CGI->param( "submit_query_for_delete" ) ) {
  displayDeleteQueryResults( $CGI, $DBH );
}
elsif ( $CGI->param( "submit_query_for_update" ) ) {
  displayUpdateQueryResults( $CGI, $DBH );
}
elsif ( $CGI->param( "submit_enter_new_address" ) ) {
  displayEnterNewAddressScreen( $CGI );
}
elsif ( $CGI->param( "submit_query" ) ) {
  displayQueryResults( $CGI, $DBH );
}
else {
  displayQueryScreen( $CGI );
}

As we just described, we are using the $CGI variable to determine the flow of control through the CGI script. This big if block may look a bit messy, but the reality is that you only need to go to one spot in this program to see a description of what the entire program does. From this if block, we know that the program deals with displaying the query screen by default, but based on other parameters may display a new address screen, update query screen, delete query screen, and various query result screens, as well as various data modification result screens.

sub displayQueryScreen {
  my $cgi = shift;

  print $cgi->header(  );

print qq`
<HTML>
<HEAD>
<TITLE>Address Book</TITLE>
</HEAD>

<BODY BGCOLOR = "FFFFFF" TEXT = "000000">

<CENTER>
<H1>Address Book</H1> 
</CENTER>
<HR>

<FORM METHOD=POST>

<H3><STRONG>Enter Search criteria: </STRONG></H3>
<TABLE>
<TR>
  <TD ALIGN="RIGHT">First Name:</TD>
  <TD><INPUT TYPE="text" NAME="fname"></TD>
</TR>
<TR>
  <TD ALIGN="RIGHT">Last Name:</TD>
  <TD><INPUT TYPE="text" NAME="lname"></TD>
</TR>
<TR>
  <TD ALIGN="RIGHT">Phone:</TD>
  <TD><INPUT TYPE="text" NAME="PHONE"></TD>
</TR>
<TR>
  <TD ALIGN="RIGHT">Department:</TD>
  <TD><INPUT TYPE="text" NAME="dept"></TD>
</TR>
<TR>
  <TD ALIGN="RIGHT">Location:</TD>
  <TD><INPUT TYPE="text" NAME="location"></TD>
</TR>
</TABLE>
<P>

<INPUT TYPE="checkbox" NAME="exactmatch">
  <STRONG> Perform Exact Match</STRONG> 
  (Default search is case sensitive against partial word matches)
 <P>
<INPUT TYPE="submit" name="submit_query" value="Do Search">
<INPUT TYPE="submit" name="submit_do_maintenance" value="Maintain Database">
<INPUT TYPE="reset" value="Clear Criteria Fields">
</FORM>

<P><HR>

</BODY></HTML>
`;

} # end of displayQueryScreen


sub displayMaintenanceChoices {
  my $cgi = shift;
  my $message = shift;

  if ($message) {
    $message = $message . "\n<HR>\n";
  }

  print $cgi->header(  );

  print qq`<HTML>
<HEAD><TITLE>Address Book Maintenance</TITLE></HEAD>
 
<BODY BGCOLOR="FFFFFF">
<CENTER>
<H1>Address Book Maintenance</H1>
<HR>
$message
<P>

<FORM METHOD=POST>

<INPUT TYPE="SUBMIT" NAME="submit_enter_new_address" VALUE="New Address">
<INPUT TYPE="SUBMIT" NAME="submit_enter_query_for_update" VALUE="Update Address">
<INPUT TYPE="SUBMIT" NAME="submit_enter_query_for_delete" VALUE="Delete Address">
<INPUT TYPE="SUBMIT" NAME="submit_nothing" VALUE="Search Address">

</FORM>
</CENTER>
<HR>
</BODY></HTML>`;

} # end of displayMaintenanceChoices

sub displayAllQueryResults {
  my $cgi = shift;
  my $dbh = shift;
  my $op  = shift;

  my $ra_query_results = getQueryResults($cgi, $dbh);

  print $cgi->header(  );

  my $title;
  my $extra_column = "";
  my $form = "";
  my $center = "";
  if ($op eq "SEARCH") {
    $title = "AddressBook Query Results";
    $center = "<CENTER>";
  } elsif ($op eq "UPDATE") {
    $title = "AddressBook Query Results For Update";
    $extra_column = "<TH>Update</TH>";
    $form = qq`<FORM METHOD="POST">`;
  } else {
    $title = "AddressBook Query Results For Delete";
    $extra_column = "<TH>Delete</TH>";
    $form = qq`<FORM METHOD="POST">`;
  }

  print qq`<HTML>
<HEAD><TITLE>$title</TITLE></HEAD>
<BODY BGCOLOR="WHITE">
$center
<H1>Query Results</H1>
<HR>
$form
<TABLE BORDER=1>
`;

  print "<TR>$extra_column" 
        . join("\n", map("<TH>" . $_ . "</TH>", @FIELD_DESCRIPTIONS))
        . "</TR>\n";

  
  my $row;
  foreach $row (@$ra_query_results) { 
    print "<TR>";
    if ($op eq "SEARCH") {
      print join("\n", map("<TD>" . $_ . "</TD>", @$row));
    } elsif ($op eq "UPDATE") {
      print qq`\n<TD ALIGN="CENTER">
            <INPUT TYPE="radio" NAME="update_criteria" VALUE="` .
            join("|", @$row) . qq`"></TD>\n`;
      print join("\n", map("<TD>" . $_ . "</TD>", @$row));
    } else { # delete
      print qq`\n<TD ALIGN="CENTER">
            <INPUT TYPE="radio" NAME="delete_criteria" VALUE="` .
            join("|", @$row) . qq`"></TD>\n`;
      print join("\n", map("<TD>" . $_ . "</TD>", @$row));
    }
    print "</TR>\n";
  }

  print qq"</TABLE>\n";

  if ($op eq "UPDATE") {
    my $address_table = getAddressTableHTML(  );

    print qq`$address_table
      <INPUT TYPE="submit" NAME="submit_update" VALUE="Update Selected Row">
      <INPUT TYPE="submit" NAME="submit_do_maintenance" VALUE="Maintain Database">
      </FORM>
      `;
  } elsif ($op eq "DELETE") {
    print qq`<P>
      <INPUT TYPE="submit" NAME="submit_delete" VALUE="Delete Selected Row">
      <INPUT TYPE="submit" NAME="submit_do_maintenance" VALUE="Maintain Database">
      </FORM>
      `;
  } else {
    print "</CENTER>";
  }

  print "</BODY></HTML>\n";

}

sub getQueryResults {
  my $cgi = shift;
  my $dbh = shift;

  my @query_results;
  my $field_list = join(",", @FIELD_NAMES);
  my $sql = "SELECT $field_list FROM $TABLE";

  my %criteria = (  );

  my $field;  
  foreach $field (@FIELD_NAMES) {
    if ($cgi->param($field)) {
      $criteria{$field} = $cgi->param($field);
    }
  }

  # build up where clause
  my $where_clause;
  if ($cgi->param('exactmatch')) {
    $where_clause = join(" and ", 
                    map ($_ 
                         . " = \"" 
                         . $criteria{$_} . "\"", (keys %criteria)));
  } else {
    $where_clause = join(" and ", 
                    map ($_ 
                         . " like \"%"
                         . $criteria{$_} . "%\"", (keys %criteria)));

  }
  $where_clause =~ /(.*)/;
  $where_clause = $1;

  $sql = $sql . " where " . $where_clause if ($where_clause);
  
  my $sth = $dbh->prepare($sql) 
           or die "Cannot prepare: " . $dbh->errstr(  );
  $sth->execute(  ) or die "Cannot execute: " . $sth->errstr(  );

  my @row;
  while (@row = $sth->fetchrow_array(  )) {
    my @record = @row;
    push(@query_results, \@record);    
  }
  $sth->finish(  );

  return \@query_results;

} # end of getQueryResults

sub displayQueryResults {
  my $cgi = shift;
  my $dbh = shift;

  displayAllQueryResults($cgi,$dbh,"SEARCH");

} # end of displayQueryResults

sub displayUpdateQueryResults {
  my $cgi = shift;
  my $dbh = shift;

  displayAllQueryResults($cgi,$dbh,"UPDATE");

} # end of displayUpdateQueryResults 

sub displayDeleteQueryResults {
  my $cgi = shift;
  my $dbh = shift;

  displayAllQueryResults($cgi, $dbh, "DELETE");

} # end of displayDeleteQueryResults

sub doAdd {
  my $cgi = shift;
  my $dbh = shift;

  my @value_array = (  );
  my @missing_fields = (  );

  my $field;
  foreach $field (@FIELD_NAMES){
    my $value = $cgi->param($field);
    if ($value) {
      push(@value_array, "'" . $value . "'");
    } else {
      push(@missing_fields, $field);
    }
  }

  my $value_list = "(" . join(",", @value_array) . ")";
  $value_list =~ /(.*)/;
  $value_list = $1;
  my $field_list = "(" . join(",", @FIELD_NAMES) . ")";

  if (@missing_fields > 0) {
    my $error_message = 
      qq`<STRONG> Some Fields (` . join(",", @missing_fields) .
      qq`) Were Not
            Entered!
            Address Not Inserted.
         </STRONG>`;
    displayErrorMessage($cgi, $error_message);

  } else {

    my $sql = qq`INSERT INTO $TABLE $field_list VALUES $value_list`;
    my $sth = $dbh->prepare($sql) 
           or die "Cannot prepare: " . $dbh->errstr(  );
    $sth->execute(  ) or die "Cannot execute: " . $sth->errstr(  );
    $sth->finish(  );
    
    displayMaintenanceChoices($cgi,"Add Was Successful!");    

  }

} # end of doAdd

sub doDelete {
  my $cgi = shift;
  my $dbh = shift;

  my $delete_criteria = $cgi->param("delete_criteria");
  if (!$delete_criteria) {
    my $error_message = 
      "<STRONG>You didn't select a record to delete!</STRONG>";
    displayErrorMessage($cgi, $error_message);
  } else {

    my %criteria = (  );

    my @field_values = split(/\|/, $delete_criteria);  
    for (1..@FIELD_NAMES) {
      $criteria{$FIELD_NAMES[$_ - 1]} = 
        $field_values[$_ - 1];
    }

    # build up where clause
    my $where_clause;
    $where_clause = join(" and ", 
                    map ($_ 
                         . " = \"" 
                         . $criteria{$_} . "\"", (keys %criteria)));
    $where_clause =~ /(.*)/;
    $where_clause = $1;


    my $sql = qq`DELETE FROM $TABLE WHERE $where_clause`;
    my $sth = $dbh->prepare($sql) 
           or die "Cannot prepare: " . $dbh->errstr(  );
    $sth->execute(  ) or die "Cannot execute: " . $sth->errstr(  );
    $sth->finish(  );
    
    displayMaintenanceChoices($cgi,"Delete Was Successful!");    

  }

} # end of doDelete

sub doUpdate {
  my $cgi = shift;
  my $dbh = shift;

  my $update_criteria = $cgi->param("update_criteria");
  if (!$update_criteria) {
    my $error_message = 
      "<STRONG>You didn't select a record to update!</STRONG>";
    displayErrorMessage($cgi, $error_message);
  } else {

    # build up set logic
    my $set_logic = "";
    my %set_fields = (  );
    my $field;
    foreach $field (@FIELD_NAMES) {
      my $value = $cgi->param($field);
      if ($value) {
        $set_fields{$field} = $value;
      }
    }
    $set_logic = join(", ", 
                 map ($_ . " = \"" . $set_fields{$_} . "\"",
                 (keys %set_fields)));
    $set_logic = " SET $set_logic" if ($set_logic);
    $set_logic =~ /(.*)/;
    $set_logic = $1;

    my %criteria = (  );

    my @field_values = split(/\|/, $update_criteria);  
    for (1..@FIELD_NAMES) {
      $criteria{$FIELD_NAMES[$_ - 1]} = 
        $field_values[$_ - 1];
    }

    # build up where clause
    my $where_clause;
    $where_clause = join(" and ", 
                    map ($_ 
                         . " = \"" 
                         . $criteria{$_} . "\"", (keys %criteria)));
    $where_clause =~ /(.*)/;
    $where_clause = $1;


    my $sql = qq`UPDATE $TABLE $set_logic` .
                  qq` WHERE $where_clause`;

    my $sth = $dbh->prepare($sql) 
           or die "Cannot prepare: " . $dbh->errstr(  );
    $sth->execute(  ) or die "Cannot execute: " . $sth->errstr(  );
    $sth->finish(  );
    
    displayMaintenanceChoices($cgi,"Update Was Successful!");    

  }

} # end of doUpdate

sub displayEnterNewAddressScreen {
  my $cgi = shift;

  displayNewDeleteUpdateScreen($cgi, "ADD");

} # end of displayEnterNewAddressScreen

sub displayUpdateQueryScreen {
  my $cgi = shift;
 
  displayNewDeleteUpdateScreen($cgi, "UPDATE");

} # end of displayUpdateQueryScreen

sub displayDeleteQueryScreen {
  my $cgi = shift;

  displayNewDeleteUpdateScreen($cgi, "DELETE");

} # end of displayDeleteQueryScreen

sub displayNewDeleteUpdateScreen {
  my $cgi       = shift;
  my $operation = shift;

  my $address_op = "Enter New Address";
  $address_op = "Enter Search Criteria For Deletion" if ($operation eq "DELETE");
  $address_op = "Enter Search Criterio For Updates" if ($operation eq "UPDATE");

  print $cgi->header(  );

# Prints out the header
print qq`
<HTML><HEAD>
<TITLE>Address Book Maintenance</TITLE>
</HEAD>
 
<BODY BGCOLOR="FFFFFF">
 
<H1>$address_op</H1>

<HR>
<P>
<FORM METHOD=POST>
`;

if ($operation eq "ADD") {
  print "Enter The New Information In The Form Below\n";
} elsif ($operation eq "UPDATE") {
  print "Enter Criteria To Query On In The Form Below.<P>\nYou will then be 
  able to choose entries to modify from the resulting list.\n";
} else {
  print "Enter Criteria To Query On In The Form Below.<P>\nYou will then be 
  able to choose entries to delete from the resulting list.\n"
}

my $address_table = getAddressTableHTML(  );
print qq`
<HR>
<P>

$address_table
`;

if ($operation eq "ADD") {
      print qq`
      <P>
      <INPUT TYPE="submit" NAME="submit_add" 
      VALUE="Add This New Address"><P>
      `; 
} elsif ($operation eq "UPDATE") {
      print qq`      <INPUT TYPE="checkbox" NAME="exactsearch">
      <STRONG>Perform Exact Search</STRONG>
      <P>
      <INPUT TYPE="submit" NAME="submit_query_for_update"
      VALUE="Query For Modification">
      <P>
      `;
} else {
      print qq`
      <INPUT TYPE="checkbox" NAME="exactsearch">
      <STRONG>Perform Exact Search</STRONG>
      <P>
      <INPUT TYPE="submit" NAME="submit_query_for_delete"
      VALUE="Query For List To Delete">
      <P>
      `;
}

# print the HTML footer.

print qq`
<INPUT TYPE="reset" VALUE="Clear Form">
</FORM>
</BODY></HTML> 
`;

} # end of displayNewUpdateDeleteScreen
sub displayErrorMessage {
  my $cgi = shift;
  my $error_message = shift;


  print $cgi->header(  );

  print qq`
<HTML>
<HEAD><TITLE>Error Message</TITLE></HEAD>
<BODY BGCOLOR="WHITE">
<H1>Error Occurred</H1>
<HR>
$error_message
<HR>
</BODY>
</HTML>
`;

} # end of displayErrorMessage

sub getAddressTableHTML {

return qq`
<TABLE>
<TR>
  <TD ALIGN="RIGHT">First Name:</TD>
  <TD><INPUT TYPE="text" NAME="fname"></TD>
</TR>
<TR>
  <TD ALIGN="RIGHT">Last Name:</TD>
  <TD><INPUT TYPE="text" NAME="lname"></TD>
</TR>
<TR>
  <TD ALIGN="RIGHT">Phone:</TD>
  <TD><INPUT TYPE="text" NAME="phone"></TD>
</TR>
<TR>
  <TD ALIGN="RIGHT">Department:</TD>
  <TD><INPUT TYPE="text" NAME="dept"></TD>
</TR>
<TR>
  <TD ALIGN="RIGHT">Location:</TD>
  <TD><INPUT TYPE="text" NAME="location"></TD>
</TR>
</TABLE>
`;

} # end of getAddressTableHTML

You probably noticed that the style of this CGI script is different from other examples in this book. We have already seen scripts that use CGI.pm, Embperl, and HTML::Template. This script uses quoted HTML; you can compare it against other examples to help you choose the style that you prefer.

Likewise, this CGI script is one long file. The advantage is that all of the logic is present within this file. The disadvantage is that it can be difficult to read through such a long listing. We'll discuss the pros and cons of unifying applications versus breaking them into components in Chapter 16, "Guidelines for Better CGI Applications".

10.4. DBI