TPJ: Issue_09_Win32::ODBC

This is a collection of programs published by The Perl Journal. You can download all source-code also from TPJ: Programs.
Download peppersearch.pl

#!/usr/bin/perl -w # # Copyright © Joseph L. Casadonte Jr. 1998. All rights reserved. # PepperSearch.pl / 17 January 1998 / joc@netaxs.com use strict; use Win32::ODBC; use CGI qw(:standard); #***** open database connection ***** my($DSN) = "Article"; my($db) = new Win32::ODBC($DSN) || die qq{Cannot open ODBC connection to "$DSN":}, Win32::ODBC::E\ rror, qq{\n}; #***** get incoming CGI params ***** my($query) = new CGI; my($submit, $pid, $heat, $start, $maxrows); $submit = $query->param('submit'); $pid = $query->param('pid'); $heat = $query->param('heat'); $start = $query->param('start'); $maxrows = $query->param('maxrows'); $pid = $$ if ! $pid; #***** globally used ***** my($rc, $stmt, $num_rows, $end); $num_rows = 10; #***** determine scoville limits ***** my($max, $min); if ($heat eq 'MILD') { #***** just a hint of pepper ***** $min = 0; $max = 500; } elsif ($heat eq 'MEDIUM') { #***** where most people like it ***** $min = 500; $max = 2500; } elsif ($heat eq 'HOT') { #***** finally, some flavor! ***** $min = 2500; $max = 10000; } elsif ($heat eq 'SCORCHER') { #***** now we're talking ***** $min = 10000; $max = 100000; } else { #***** implied: $heat eq 'INSANE' ***** $heat = 'INSANE'; #***** no limit.... ***** $min = 100000; $max = 0; } #***** what button was used? ***** if ($submit eq 'new') { #***** submit: new ***** #***** delete old search results from State table ***** $stmt = "DELETE FROM State WHERE PID = $pid"; $rc = $db->Sql($stmt); die qq{SQL failed "$stmt": }, $db->Error(), qq{\n} if $rc; #***** fill State table ***** #***** get second DB connection ***** my($ins) = new Win32::ODBC($db); #***** perform new search ***** #***** build SQL statement ***** $stmt = "SELECT ProductID FROM Sauces " . "WHERE Scoville >= $min "; #***** add in maximum value (if there is one) ***** $stmt .= "AND Scoville < $max " if $max; #***** add sequence request ***** $stmt .= "ORDER BY Scoville, ProductName"; #***** compile the SQL statement ***** $rc = $db->Sql($stmt); die qq{SQL failed "$stmt": }, $db->Error(), qq{\n} if $rc; #***** loop thru all rows ***** my($cnt, $id) = 0; while ($db->FetchRow) { #***** get Product ID ***** ($id) = $db->Data; #***** immediately insert into State table ***** $stmt = "INSERT INTO State (PID, ProductID, Sequence) \ " . "VALUES ($$, $id, " . $cnt++ . ")"; $rc = $ins->Sql($stmt); die qq{SQL failed "$stmt": }, $ins->Error(), qq{\n}\ if $rc; } #***** set start, maxrows and pid ***** $start = 0; $pid = $$; $maxrows = $cnt; } elsif ($submit eq 'next') { #***** submit: next ***** $start += $num_rows; } else { #***** submit: prev ***** $start -= $num_rows; } #***** check min and max ***** $start = $maxrows - $num_rows if $start > $maxrows; $start = 0 if $start < 0; $end = ($start + $num_rows > $maxrows ? $maxrows : $start + $num_ro\ ws); #***** print HTML headers ***** print qq(<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">\n\n); print qq(<HTML><HEAD>\n); print qq(<TITLE>Peppers, Inc. Search Results</TITLE>\n); print qq(</HEAD>\n); print qq(<BODY>\n); print qq(<H1 ALIGN=center>Peppers, Inc. Search Results</H1>\ ;\n); #***** print search results info ***** $max -= 1 if $max; print qq(Search: $heat [$min), ($max ? " - $max" : "+"), qq( units Sco\ ville]<BR>\n); print qq(Search results: ), $start + 1, qq( - $end of $maxrows<BR&g\ t;\n); #***** start form, table ***** print qq(<FORM METHOD=POST ACTION="http://www.foobar.com/cgi-bin/Pe\ pperSearch.pl">\n); print qq(<TABLE BORDER=1>\n); print qq(<TR><TH>Scoville<TH>Name<TH>Pepper<\ ;TH>Quantity<TH>Price\n); #***** fetch Sauces data based on State table data ***** $stmt = "SELECT sa.* FROM State st " . "INNER JOIN Sauces sa ON st.ProductID = sa.ProductID " . "WHERE st.PID = $pid " . "AND st.Sequence >= $start " . "AND st.Sequence < $end " . "ORDER BY st.Sequence"; #***** compile the SQL statement ***** $rc = $db->Sql($stmt); die qq{SQL failed "$stmt": }, $db->Error(), qq{\n} if $rc; #***** fetch each row ***** while ($db->FetchRow) { my(%data) = $db->DataHash; #***** output HTML **** print qq(<TR><TD>$data{'Scoville'}<TD>$data{\ 'ProductName'}), qq(<TD>$data{'PepperType'}<TD>$data{'Quant\ ity'}<TD>$data{'Price'}\n); } #***** end table && print hidden form elements print qq(</TABLE>\n); print qq(<P>\n); print qq(<INPUT TYPE=HIDDEN NAME="pid" VALUE="$$">\n); print qq(<INPUT TYPE=HIDDEN NAME="heat" VALUE="$heat">\n); print qq(<INPUT TYPE=HIDDEN NAME="start" VALUE="$start">\n); print qq(<INPUT TYPE=HIDDEN NAME="maxrows" VALUE="$maxrows">\n); #***** print buttons (next, prev, new) ***** print qq(<INPUT TYPE=SUBMIT VALUE="Prev $num_rows" NAME="prev">\\ n) if ($start > 0); print qq(<INPUT TYPE=SUBMIT VALUE="Next $num_rows" NAME="next">\\ n) if ($end < $maxrows); print qq(<P>\n) if ($start > 0) || ($end < $maxrows); print qq(<INPUT TYPE=SUBMIT VALUE="New Search" NAME="new">\n); print qq(<INPUT TYPE=RADIO VALUE="MILD" NAME="heat"> Mild\n); print qq(<INPUT TYPE=RADIO VALUE="MEDIUM" NAME="heat"> Medium\n)\ ; print qq(<INPUT TYPE=RADIO VALUE="HOT" NAME="heat"> Hot\n); print qq(<INPUT TYPE=RADIO VALUE="SCORCHER" NAME="heat"> Scorche\ r\n); print qq(<INPUT TYPE=RADIO VALUE="INSANE" NAME="heat" CHECKED> I\ nsane\n); #***** all done ***** print qq(</FORM></BODY><HTML>\n);