ch10_04.htm

用perl编写CGI的好书。本书从解释CGI和底层HTTP协议如何工作开始

<p>Finally, <tt class="literal">$CGI</tt>
<a name="INDEX-2165" /> 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 <a name="INDEX-2166" />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.</p>


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


<p>As we just described, we are using the
<tt class="literal">$CGI</tt>
<a name="INDEX-2167" /> variable to determine the flow of
control through the CGI script. This big
<em class="emphasis">if</em>
<a name="INDEX-2168" /> 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 <em class="emphasis">if</em> block, we know that the program
deals with displaying the query screen by default, but based on other
parameters may display a <a name="INDEX-2169" /> <a name="INDEX-2,170" /> <a name="INDEX-2,171" /> <a name="INDEX-2,172" /> <a name="INDEX-2,173" />new address screen,
update query screen, delete query screen, and various query result
screens, as well as various data modification result screens.</p>


<blockquote><pre class="code">sub displayQueryScreen {
  my $cgi = shift;

  print $cgi-&gt;header(  );

print qq`
&lt;HTML&gt;
&lt;HEAD&gt;
&lt;TITLE&gt;Address Book&lt;/TITLE&gt;
&lt;/HEAD&gt;

&lt;BODY BGCOLOR = "FFFFFF" TEXT = "000000"&gt;

&lt;CENTER&gt;
&lt;H1&gt;Address Book&lt;/H1&gt; 
&lt;/CENTER&gt;
&lt;HR&gt;

&lt;FORM METHOD=POST&gt;

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

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

&lt;P&gt;&lt;HR&gt;

&lt;/BODY&gt;&lt;/HTML&gt;
`;

} # end of displayQueryScreen


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

  if ($message) {
    $message = $message . "\n&lt;HR&gt;\n";
  }

  print $cgi-&gt;header(  );

  print qq`&lt;HTML&gt;
&lt;HEAD&gt;&lt;TITLE&gt;Address Book Maintenance&lt;/TITLE&gt;&lt;/HEAD&gt;
 
&lt;BODY BGCOLOR="FFFFFF"&gt;
&lt;CENTER&gt;
&lt;H1&gt;Address Book Maintenance&lt;/H1&gt;
&lt;HR&gt;
$message
&lt;P&gt;

&lt;FORM METHOD=POST&gt;

&lt;INPUT TYPE="SUBMIT" NAME="submit_enter_new_address" VALUE="New Address"&gt;
&lt;INPUT TYPE="SUBMIT" NAME="submit_enter_query_for_update" VALUE="Update Address"&gt;
&lt;INPUT TYPE="SUBMIT" NAME="submit_enter_query_for_delete" VALUE="Delete Address"&gt;
&lt;INPUT TYPE="SUBMIT" NAME="submit_nothing" VALUE="Search Address"&gt;

&lt;/FORM&gt;
&lt;/CENTER&gt;
&lt;HR&gt;
&lt;/BODY&gt;&lt;/HTML&gt;`;

} # end of displayMaintenanceChoices

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

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

  print $cgi-&gt;header(  );

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

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

  print "&lt;TR&gt;$extra_column" 
        . join("\n", map("&lt;TH&gt;" . $_ . "&lt;/TH&gt;", @FIELD_DESCRIPTIONS))
        . "&lt;/TR&gt;\n";

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

  print qq"&lt;/TABLE&gt;\n";

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

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

  print "&lt;/BODY&gt;&lt;/HTML&gt;\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-&gt;param($field)) {
      $criteria{$field} = $cgi-&gt;param($field);
    }
  }

  # build up where clause
  my $where_clause;
  if ($cgi-&gt;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-&gt;prepare($sql) 
           or die "Cannot prepare: " . $dbh-&gt;errstr(  );
  $sth-&gt;execute(  ) or die "Cannot execute: " . $sth-&gt;errstr(  );

  my @row;
  while (@row = $sth-&gt;fetchrow_array(  )) {
    my @record = @row;
    push(@query_results, \@record);    
  }
  $sth-&gt;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;