#!/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/<br>/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/<br>/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 "<br>And ",$and_sql,"<br> Or",$or_sql,"<br>";
                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 "<table border=1",$n,">";
	my $i=0;
	print "\n<tr>";
        # Column titles
	for(my $i=1;$i<$cols;$i++) {
		my $fname=$cursor->{NAME}->[$i];
		my $datatype=$cursor->{TYPE}->[$i]; #ODBC 1==char 11==date 4==int -1==text
		if($datatype == -1 || $datatype==252) {next} #don't show longvarchars
		my $fn=lc($fname);
		if($fn eq 'userkey' || $fn eq 'password' || $fn eq 'date_created' || $fn eq 'date_updated') {next};
		$fname=~s/_/ /g;
		print "<td bgcolor=\"#FFFFCC\"><b>",$fname,"</b></td>";
	}
	print("</tr>");
	
        # Column data
	my $anyrecs=0;
        my $last_sort_value = '';
	while(my @fields = $cursor->fetchrow) {
		$anyrecs=1;
		print "\n<TR>";
		my $cols=$cursor->{NUM_OF_FIELDS};
                if ($fields[0] ne $last_sort_value) {
                   print "<td><td><b>".strip($fields[0])."</b><tr>";
                   $last_sort_value = $fields[0];
                }
		for(my $i=1;$i<$cols;$i++) {
                          #ODBC values Wrong for postgresql so these are
                          # postgresql values, other databases may need this
                          # changed
			my $datatype=$cursor->{TYPE}->[$i]; #ODBC 1==char 11==date 4==int -1==text
			if($datatype == -1 || $datatype==252) {next}
			my $fvalue=strip($fields[$i]) . '&nbsp';
			my $fname=$cursor->{NAME}->[$i];
			#print $fname,"datatype=",$datatype;
			#print "<td nowrap>";
			print "<td>";
			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 "<a href=\"",$cgipgm,"&id=",strip($fields[$i]),"\">&nbsp;",$fvalue,"</a>";
			} elsif ($fn eq 'link') { #generate a link href
				print '<a href="',$fvalue,'">';
				if(length($fvalue)>0) {print 'click'}
				print '</a>';
			} else {
				print $fvalue;
				#print $datatype;
			}
			print "</td>";
		}
		print("</TR>");
	}
	print "</table><p>\n";
	if(!$anyrecs && !(defined $embed)) {print "<p>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 <a href='$loc'>$loc</a>, document is available from:<p>\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 "<p>$files_fields[4] <br>\n";
              }
              my $url = strip($files_fields[0]);
              my $loc = '';
              my $loca = '';
              print "<a href='$url'>$url</a><br>\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 "&nbsp;&nbsp;&nbsp <a href='$pdf_url$loca'>Document as a PDF file</a>\n";
                 print "&nbsp;&nbsp <a href='$pdf_url?pages=$pages$loc'>Selected PDF pages $pages</a><br>\n";
                 $need_pages = 1;
              }
              print "<br>";
              $file_found = 1;
           }
           print "<p>";
              # 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: <input type=text name=pages value="'.$pages.'" size=10 maxlength=15>';
              print '<input type=hidden name=table value="',$table,'">';
              print '<input type=hidden name=id value="',$id,'">';
              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<br>";
        } 
        print '<a href=../../query_docs/view_docs.shtml>How to view documents</a>';
	print "<HR WIDTH='100%'><table>";
	my $cols=$cursor->{NUM_OF_FIELDS};
	my $prec=0;
	for (my $i=0;$i<$cols;$i++) {
		my $fvalue=strip($fields[$i]);
		if(!defined $fvalue) {$fvalue='';}
		my $fname=$cursor->{NAME}->[$i];
		if($fname eq 'userkey' || $fname eq 'password') {next}
		$fname=~s/_/ /g;
		print "<tr><td align=right valign=top>",$fname,":<td><b>",$fvalue,"</b>";
	}
	print "</table>";
	dbCloseCursor($cursor);
}

#Support functions
sub printRow{
	my($txt,$val)=@_;
	print "<tr><td align=right>",$txt;
	print "<td>",$val;
}
sub printCenter {
	my ($txt)=@_;
	print "<center><h2>",$txt,"</h2></center>";
}
sub printSelect {
	my ($name,$init,$values)=@_;
	print "<td><select name=",$name,">";
	print "<option value=\"$init\">$init";
	foreach my $val(split(/,/,$values)) {
		print "<option value=\"$val\">$val";
	}
	print "</select>\n";
}

sub GenSpQuery {
	my ($dbh, $debug,$field)=@_;
	print "<table><tr><td colspan=2>";
        my $prec=40;
 	print "<tr><td align=right>",$field;
	print '<td><input type=text name=',$field,' value="',"",
		'" size=',$prec,' maxlength=',$prec,'> ';
        print "<tr><td allign=right>Search Type&nbsp;";
        printSelect("stype","Partial Word","Whole Word,Anywhere");
        print "<a href='../../query_docs/search_help.shtml'>Search Help</a>";
	print "</table>";
}

####################
#Generate a data-entry form for @fields columns (default '*') from table name
#Optionally fill in form with record_id given
#More not used stuff
sub GenForm {
	my ($dbh, $debug,$table,$id,$fields,$onefield)=@_;
	my $do_update=0;
	my $do_query=0;
	if(!(defined $id)) {$id=0}
	if($id>0) {$do_update=1}
	if($id<0) {$do_query=1}
	if(!(defined $fields) || $fields eq '*') {$fields='*'}
	my $sql = "select " . $fields . " from " . $table;
	if($do_update) {$sql.=" where id=" . $id}
	if($debug) {print "sql=",$sql,"\n";}
	my $cursor = dbExecute($dbh, $sql);
	#if($do_update) {	@fields = $cursor->fetchrow}
	print "<table><tr><td colspan=2>";

	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','<input type=text name=id size=5 maxlength=5>');
				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 "<tr><td align=right>Record ID<td><b>",$id,"</b>";
			print '<input type=hidden name=id value="',$id,'">';
		} elsif($fn eq 'userkey') {
			if($do_query) {next}
			if(defined $genquery::remote_user){
				#put in hidden field
				print "<tr><td><input type=hidden name=userkey value=$genquery::remote_user>";
			}else{
				#user must enter
				print "<tr><td align=right>",$fname;
				print '<td><input type=text name=userkey value="" size=',$prec,
					' maxlength=',$prec,'> ';
			}
		} else {
		#standard field processing
			my $dropval=$genquery::dropdown{$fn}; #from genquery_site.pl
			if(defined $dropval) {
				#drop-down list
				print "<tr><td align=right>",$fname;
				if($value eq '') {$value='(any)'};
				printSelect($fn,$value,$dropval);
			}elsif($prec==1) {
				#check box
				print "<tr><td align=right>",$fname;
				print '<td><input type=checkbox name=',$lfname,' value="Y"';
				if($value) {print ' checked'};
				print '> ';
			}elsif ($prec<200 && $datatype!=-1) { 
				#simple textfield
				print "<tr><td align=right>",$fname;
				print '<td><input type=text name=',$lfname,' value="',$value,
				'" size=',$prec,' maxlength=',$prec,'> ';
			}else{ 
				#textarea
				if($do_query) {next}
				print "<tr><td align=right valign=top>",$fname;
				$value=~s/<br>/\n/g;
				print '<td><textarea name=',$lfname,' wrap=physical rows=18 cols=80>',$value,
				'</textarea> ';
			}
		}
		#print help text
		my $helptext=$genquery::formhelp{$fn}; #from genquery_site.pl
		if(defined $helptext) {
			print "&nbsp;&nbsp;",$helptext;
		}
	}	
        print "<tr><td allign=right>Search Type&nbsp;";
        printSelect("stype","Partial Word","Word, Anywhere");
	print "</table>";
	dbCloseCursor($cursor);
        $cursor->finish;
}


sub footer {
print '<P> <HR WIDTH="100%"> <BR>Feel free to contact me, David Gesswein <A HREF="mailto:djg@drs-esg.com">djg@drs-esg.com</A> with any questions, comments on the web site, or you want to donate equipment, documentation, software etc. to this project.&nbsp; I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation.&nbsp; <BR><BR><A HREF="http://www.pdp8.net/query_docs/query.shtml">PDP-8 Documents home</a><BR><A HREF="../../index.shtml">PDP-8 Home Page</a> <BR><A HREF="../../sitemap.shtml">PDP-8 Site Map</a>';
print "\n";
}
1;