#!/usr/bin/perl -w -T
# genquery.pl v1.01
# "Generic" SQL query generator and html form and table generator.
# Author:Marc Beneteau marc@odbsoft.com Date:Oct/98
package genquery;
use Text::ParseWords;
use strict;
#########################
#Remove trailing blanks
sub strip {
my @parms = @_;
for (@parms) {
s/\s+$//;
}
return wantarray ? @parms : $parms[0];
}
#########################
#Open database connection
sub dbOpen {
my $dbh;
if($genquery::remote_db) {
#connect through dbi:Pg
$dbh = DBI->connect("dbi:Pg:dbname=$genquery::dbname", "", "")
|| die "Cannot connect to db server $DBI::errstr,\n";
}else{
#connect through dbi:ODBC
$dbh = DBI->connect("dbi:ODBC:$genquery::dbname", '', '')
|| die "Cannot connect to db server $DBI::errstr,\n";
}
return $dbh
}
#########################
#Open cursor
sub dbExecute {
my ($dbh,$sql,$debug)=@_;
if($debug) {print "sql=",$sql,"\n";}
my $cursor =$dbh->prepare($sql)
|| die "Cannot prepare statement: $DBI::errstr\n";
$cursor->execute;
return $cursor;
}
#########################
#Fetch
sub dbFetch {
$_[0]->fetchrow; #returns @fields
}
#########################
#Execute statement
sub dbDo {
my ($dbh, $sql)=@_;
my $rows=$dbh->do($sql) || die $dbh->errstr;
$rows;
}
#########################
#Close cursor
sub dbCloseCursor {
$_[0]->finish;
}
#########################
#Close connection
sub dbClose {
$_[0]->disconnect;
}
#########################
#Automatically generate an SQL INSERT statement from the names/values of form parameters
#This is left over from code I got which allowed editing, not callable
sub GenInsert {
my ($dbh,$q,$table)=@_;
my @fparam=$q->param; #names of all parameters
my $first_where=1;
my $first_col=1;
my $sql='insert into '.$table.' (';
my $values=' values (';
for(my $i=0;defined(my $fname=$fparam[$i]);$i++) {
my $fn=lc($fname);
my $fvalue=$q->param($fname);
if(length($fvalue)==0) {next;}
if($fvalue eq '(any)') {$fvalue=''}
my $rw=$genquery::reserved_words{$fn};
if (defined $rw) {next;}
if($fn eq 'state' || $fn eq 'country') {$fvalue=uc($fvalue)}
if($first_col) {
$first_col=0;
}else{
$sql.=',';
$values.=',';
}
$sql.=$fname;
$fvalue=~s/\cM//g;
$fvalue=~s/\n/
/g;
$values.=$dbh->quote($fvalue);
}
$sql.=')';
$values.=')';
$sql.$values;
}
####################
#Generate an SQL UPDATE statement from the names/values of form parameters
#This is left over from code I got which allowed editing, not callable
sub GenUpdate {
my ($dbh, $q,$table,$id)=@_;
my @fparam=$q->param;
my $first_col=1;
my $sql='update '.$table.' set ';
for(my $i=0;defined(my $fname=$fparam[$i]);$i++) {
my $fn=lc($fname);
my $rw=$genquery::reserved_words{$fn};
if (defined $rw) {next;}
my $fvalue=$q->param($fname);
if($fn eq 'state' || $fn eq 'country') {$fvalue=uc($fvalue)}
if($first_col) {
$first_col=0;
}else{
$sql.=',';
}
$sql.=$fname."=";
$fvalue=~s/\cM//g;
$fvalue=~s/\n/
/g;
$sql.=$dbh->quote($fvalue);
}
$sql.=" where id=".$id;
$sql;
}
##################
#Generate the WHERE clause from form parameters
#Pass in the initial sql statement ('Select abc from xyx')
sub GenWhere {
my ($dbh, $q,$sql,$stype,$sfields,$onefield)=@_;
my $fvalue;
my @fparam;
if ($onefield) {
$fvalue = $q->param("Search");
@fparam = split(',',$sfields);
} else {
@fparam=$q->param; #names of all parameters
}
my $first_col=1;
for(my $i=0;defined(my $fname=$fparam[$i]);$i++) {
my $fn=lc($fname);
if (!$onefield) {
$fvalue=$q->param($fname);
}
if($fvalue eq '(any)') {$fvalue=''}
if(length($fvalue)==0 || length($fvalue)>80) {next;}
my $rw=$genquery::reserved_words{$fn};
if (defined $rw) {next;}
if($first_col) {
$first_col=0;
$sql.=" WHERE (";
}else{
$sql.=" OR (";
}
my $or_sql = "";
my $and_sql = "";
my @words = quotewords(" ", 0, lc($fvalue));
my $tmp;
foreach my $word (@words) {
# Remove some special characters to try to match better
# This way pdp-8 pdp/8 and pdp8 will all match.
# pdp 8 will not though, can't have everything.
$word =~ s'/'';
$word =~ s'-'';
$word =~ s"'"";
next if $word eq "";
my $numeric=$genquery::numeric_columns{$fn};
my $firstchar = substr($word,0,1);
# Handle + to require word and - to require word to not
# matched like many search sites
if ($firstchar eq '+' || $firstchar eq '-') {
$word = substr($word,1);
}
if(lc($fname) eq 'id' || defined $numeric) {
$sql.=$fname."=";
$sql.=$word; #insert numeric value
} else {
# My 3 search types
if ($stype eq "Partial Word") {
$tmp =$dbh->quote('([^A-z]|^)'.lc($word)); #add quotes and escape special chars
} elsif ($stype eq "Anywhere") {
$tmp =$dbh->quote(lc($word)); #add quotes and escape special chars
} else { # Word
$tmp =$dbh->quote('([^A-z]|^)'.lc($word).'([^A-z]|$)'); #add quotes and escape special chars
}
# Do the same munging of special characters for the
# search also.
$tmp = "(lower(".$fname.") ~* $tmp or translate(translate(translate(lower(".$fname."),'\\'',''),'/',''),'-','') ~* $tmp)";
}
if ($firstchar eq '+') {
if ($and_sql ne "") {
$and_sql .= " and ";
}
$and_sql .= $tmp;
} elsif ($firstchar eq '-') {
if ($and_sql ne "") {
$and_sql .= " and ";
}
$and_sql .= 'not '.$tmp;
}else {
if ($or_sql ne "") {
$or_sql .= " or ";
}
$or_sql .= $tmp;
}
}
#print "
And ",$and_sql,"
Or",$or_sql,"
";
if ($or_sql ne "") {
if ($and_sql ne "") {
$and_sql .= " and ";
}
$and_sql .= " (". $or_sql .")";
}
$sql .= $and_sql . ')';
}
#print "Sql ",$sql;
$sql;
}
####################
#Generates an html table from a cursor
#Parameter is the name of the cgi to execute for the detail view (one record per page)
sub GenTable {
my ($dbh, $cursor,$cgipgm,$embed,$link_field)=@_;
my $cols=$cursor->{NUM_OF_FIELDS};
my $n='';
print "
",$fname," | "; } print("|
".strip($fields[0])." | |
"; print " | "; my $fn=lc($fname); # Ignore various fields, left over from original code if($fn eq 'userkey' || $fn eq 'password'|| $fn eq 'date_created' || $fn eq 'date_updated') {next}; if($fn eq $link_field) { #generate a submit href print " ",$fvalue,""; } elsif ($fn eq 'link') { #generate a link href print ''; if(length($fvalue)>0) {print 'click'} print ''; } else { print $fvalue; #print $datatype; } print " | "; } print("
\n"; if(!$anyrecs && !(defined $embed)) {print "
No records matched your query - try removing some of your search criteria";} } ################# #Generate a full record printout sub GenFullRecord { my ($dbh, $table,$id,$title,$pages, $q, $debug)=@_; my $sql = "select * from " . $table . " where id=" . $id; my $cursor = dbExecute($dbh, $sql, $debug); my @fields = $cursor->fetchrow; my $fileloc = strip($fields[9]) . strip($fields[6]); $sql = "select * from files where location = '$fileloc'"; my $files_cursor = dbExecute($dbh, $sql); my $loc = strip($fields[9]); printCenter($title); print "Document home site is $loc, document is available from:
\n"; my $file_found; my $need_pages = 0; if (my @files_fields = $files_cursor->fetchrow) { $files_cursor->finish; my $file_md5 = $files_fields[1]; # Lookup where the document is stored $sql = "select * from files where md5 = '$file_md5'"; $files_cursor = dbExecute($dbh, $sql); my $pdf_url; while (@files_fields = $files_cursor->fetchrow) { # If it has a special description print it if ($files_fields[4] and $files_fields[4] ne '') { print "
$files_fields[4]
\n";
}
my $url = strip($files_fields[0]);
my $loc = '';
my $loca = '';
print "$url
\n";
undef $pdf_url;
# If tiff generate link to conversion to PDF if possible
if ($url =~ /\.tif{1,2}$/) {
undef $pdf_url;
# Generate link for document on my site
if ($files_fields[2]) {
my $tmp = strip($files_fields[0]);
$tmp =~ s'http://www.pdp8.net'';
$tmp =~ s'\.tif'.pdf';
$pdf_url = "tifftopdf.pl/$tmp";
}
# Generate link for document on my mirror site
if (strip($files_fields[3]) eq "highgate") {
$url =~ s'\.tif'.pdf';
if ($url =~ s'http://highgate.comm.sfu.ca/pdp8/'') {
$loca = '?loc=webloc';
$loc = '&loc=webloc';
}
if ($url =~ s'http://highgate.comm.sfu.ca/~djg/newstuff/'') {
$loca = '?loc=newstuff';
$loc = '&loc=newstuff';
}
$pdf_url = "http://highgate.comm.sfu.ca/~djg/htdocs/cgi-bin/tifftopdf.cgi/$url";
}
}
# If a PDF conversion URL needed add it to page
if ($pdf_url) {
print "   Document as a PDF file\n";
print "   Selected PDF pages $pages
\n";
$need_pages = 1;
}
print "
";
$file_found = 1;
}
print "
";
# Some site had a document to convert to PDF, allow selection
# of pages to be converted. My conversion utility doesn't know
# how to optimize PDF so the viewer can download a page at once
# so this allows them to look at a few pages before downloading
# the entire document
if ($need_pages) {
print $q->start_form;
print 'PDF Pages: ';
print '';
print '';
print $q->submit('submit','Select PDF Pages');
print $q->end_form;
}
} else {
print "Internal error, unable to find location for this document";
print "Location $fileloc\n
";
}
print 'How to view documents';
print "
",$fname,": | ",$fvalue,""; } print " |
"; my $prec=40; print " | |
",$field; print ' | '; print " |
Search Type "; printSelect("stype","Partial Word","Whole Word,Anywhere"); print "Search Help"; print " |
"; for(my $i=0;defined (my $fname=$cursor->{NAME}->[$i]);$i++) { #print "$i=",$i,"\n"; my $lfname=lc($fname); my $fn=$lfname; my $prec; $fname=~s/_/ /; if($genquery::remote_db) { #$prec=$cursor->{PRECISION}->[$i]; #$prec=$cursor->{SCALE}->[$i]; $prec=30; }else{ #$prec=$cursor->{PRECISION}->[$i]; doesn't work $prec=60; if($fn eq 'vegetarian') {$prec=1} #for testing } my $datatype=$cursor->{TYPE}->[$i]; #1==char 11==date 4==int -1==text #print "datatype=",$datatype," prec=",$prec,"\n"; my $value=''; #if($do_update) {$value=$fields[$i]} ######Special processing of individual fields goes here#### if($fn eq 'date_created' || $fn eq 'date_updated') {next} if($fn eq 'id') { if($do_query) { printRow('Record ID',''); next; } if(!$do_update) {next;} #don't show id field on add new record #not all browsers support readonly text variables, put in hidden field for safety print " | |
Record ID | ",$id,""; print ''; } elsif($fn eq 'userkey') { if($do_query) {next} if(defined $genquery::remote_user){ #put in hidden field print " |
"; }else{ #user must enter print " | |
",$fname; print ' | '; } } else { #standard field processing my $dropval=$genquery::dropdown{$fn}; #from genquery_site.pl if(defined $dropval) { #drop-down list print " |
",$fname; if($value eq '') {$value='(any)'}; printSelect($fn,$value,$dropval); }elsif($prec==1) { #check box print " | |
",$fname; print ' | '; }elsif ($prec<200 && $datatype!=-1) { #simple textfield print " |
",$fname; print ' | '; }else{ #textarea if($do_query) {next} print " |
",$fname;
$value=~s/ /\n/g; print ' | '; } } #print help text my $helptext=$genquery::formhelp{$fn}; #from genquery_site.pl if(defined $helptext) { print " ",$helptext; } } print " |
Search Type "; printSelect("stype","Partial Word","Word, Anywhere"); print " |