#!c:/perl/bin/perl.exe use strict; use DBI; use CGI; #open connection to Access database my $dbh = DBI->connect("dbi:ODBC:directory", { 'AutoCommit' =>1, 'RaiseError' =>1}) || die "Error connecting: '$DBI::errstr'"; # setup CGI handle my $cgi = new CGI; # start HTML print $cgi->header . $cgi->start_html('Drive'); # handle any queries that have been sent our way my $initiative = validate($cgi->param('Initiative')); my $resorientation = validate($cgi->param('ResOrientation')); my $creativity = validate($cgi->param('Creativity')); my $changeorientation = validate($cgi->param('ChangeOrientation')); my $decisionmaking = validate($cgi->param('DecisionMaking')); my $level = validate($cgi->param('SelectLevel')); my $manage = validate($cgi->param('ManagesPeople')); if ($cgi->param('Query')) { my $sql = "select a.ResType, a.ResLevel, a.ResManage a.Details, a.Length, a.Source, a.Cost, a.FurtherDetails from Resources a INNER JOIN ResourceSettings b ON a.ResID = b.ResID"; $sql .= "where DriveInitiative = $initiative" if ($initiative = 'on'); $sql .= "where DriveResOrient = $resorientation" if ($resorientation = 'on'); $sql .= "where DriveCreativity = $creativity" if ($creativity = 'on'); $sql .= "where DriveChangeOrient = $changeorientation" if ($changeorientation = 'on'); $sql .= "where DriveDecisionMake = $decisionmaking" if ($decisionmaking = 'on'); $sql .= "where ResLevel like $level"; $sql .= "where ResManage like $manage"; $sql .= "order by a.ResType, a.ResLevel, a.ResManage, a.Details, a.Length, a.Source, a.Cost, a.FurtherDetails"; my $sth = $dbh->prepare($sql); $sth->execute || die "Could not execute SQL statement ... maybe invalid?"; die "Error connecting: '$DBI::errstr'"; my $rows = $dbh->selectall_arrayref($sql) || die $dbh->errstr; if (@$rows) { print "
| Type | Level | Manage | Details | Length | Source | Cost | Further Details |
|---|---|---|---|---|---|---|---|
| " . join (" | ", @$row) . " |
No matches found
\n"; } } # disconnect from database $dbh->disconnect(); exit(0); # validate user input sub validate { my $string = shift; # get rid of all non-letter, non-numerical characters and percents $string =~ s/[^A-Za-z0-9%]//g; return $string; }