# base.pl - part of dbengine
# see closer information at http://www.cis-computer.com/dbengine
#
# Version 1.1 <c> 2001
# Ingo Ciechowski		ic	<ciechowski@cis-computer.com>
#




sub createMenu {
	#
	# let's generate a list with all available tables in $dbase,
	# beginning with the headline of our window
	local($out) = @_;
	print $out->start_html(-title=>($language ne "german"?"Tables of":"Tabellen von")." $dbase:", -BGCOLOR=>$bgcol, -BACKGROUND=>$menuBackground);
	print "<H5>".($language ne "german"?"Tables of":"Tabellen von")." $dbase</H5><P>";

	#
	# now we ask $dbase for its tables
	# WLM 01/05/30: Implement mySQL
        @names = $dbconn->tables;

        #
        # and print a HREF for every record
        foreach my $table_name (@names) {
        	my $disp_tablename = $table_name;
        	$disp_tablename	=~ s/\W|_/ /o;
		$disp_tablename =~ s/\W|_/ /o;
		$disp_tablename = lc $disp_tablename;
		$disp_tablename =~ s/\b(\w)/\u$1/go;
		# *** Add the descriptive database ($dbdesc) to the HREFs, otherwise
		# *** the default dbdesc will be connected for each HREF followed.
		# *** Added 99/06/23 by M2
		print "<P><H4><A HREF=\"$scriptname?mode=plain&dbase=$dbase&dbdesc=$dbdesc&table=" . $table_name . "\" TARGET=body>[" . $disp_tablename . "]</A>";
		print "&nbsp;<A HREF=\"$scriptname?mode=search&dbase=$dbase&dbdesc=$dbdesc&table=" . $table_name . "\" TARGET=body>" . "$buttons{'list'}" . "</A></H4>\n";
	}
	print $out->end_html;
} # createMenu


sub checkModification {
	#
	# this routine gets the last modification date of our record
	# and compares it with the date that was given from the
	# caller (i.e. fetched right before the target record was
	# displayed the last time) in xmin
	# if they don't match the user will get an error
	local($query, $out) = @_;

	# Determine the uniqOID if not already defined
	$uniqOID = &db_getUniqOIDField($dbconn, $table) unless ($uniqOID);

	#
	# we read the whole row and calculate a checksum
	$comm = "SELECT * FROM $table WHERE $uniqOID='$oid'";
	$result = $dbconn->prepare($comm) ;
	$result->execute;
	@row	= $result->fetchrow_array;
	$xmin	= checksum(@row);
	&dBaseError($result, $comm) if($result->rows == 0);

	#
	# terminate dbengine.cgi if the dates don't match
	if($xmin ne $query->param('xmin')) {
		print "timestamp:$xmin OrigTimeStamp:$newtime" if $debug;
		print $out->start_html(-title=>"update problem", -BGCOLOR=>$bgcol, -BACKGROUND=>$mainBackground);
		if($language eq "german") {
			print "<H4>Der Datensatz mu&szlig; zun&auml;chst neu geladen werden, da ein anderer Benutzer ihn bereits bearbeitet hat.</H3>\n";
		} else {
			print "<H4>You first have to reload the record, because someone else already modified it.</H3>\n";
		}

		$out->delete_all;
		$out->append(-name=>'dbase',-value=>$dbase);	
		$out->append(-name=>'dbdesc',-value=>$dbdesc);  
		$out->append(-name=>'table',-value=>$table);	
		$out->append(-name=>'oid',-value=>$oid);	
		$out->append(-name=>'search',-value=>$search);  
		$out->append(-name=>'mode',-value=>'plain');	
		if($language eq "german") {
			printf("<P><A HREF=\"$scriptname?%s\">erneut einlesen...</A>", $out->query_string);
		} else {
			printf("<P><A HREF=\"$scriptname?%s\">reload record...</A>", $out->query_string);
		}
		print $out->end_html;
		$log->warn("Record $uniqOID:$oid modified before changes committed");
		die;
	}
} # checkModification



sub doDeleteRecord {
	#
	# delete the record $oid
	local($query, $out) = @_;

	# Determine the uniqOID if not already defined
	$uniqOID = &db_getUniqOIDField($dbconn, $table) unless ($uniqOID);
	
	#
	# if the deletion of our record has been confirmed, we'll go ahead and
	# remove it and all of its related records from our database
	if($mode eq "confdel" || $mode eq $buttons{'confdel'}) {

		#
		# first fetch all its relation records that refer to tables
		# which might contain related records that have to be removed
		$result = $dbdconn->prepare("	SELECT	child, childField, parent, parentField
						FROM	relation 
						WHERE	parent='$table' 
						AND	".$dbVar{'childRM'});
		$result->execute;
		if($result) {
			while(@array = $result->fetchrow_array) {
				$child   = $array[0];
				$childF  = $array[1];
				$parent  = $array[2];
				$parentF = $array[3];
				$cmd	 = "DELETE FROM $child WHERE $child.$childF=$parent.$parentF AND $parent.$uniqOID='$oid'";
				$check=$dbconn->do("$cmd") || $log->error("Delete failed on: $cmd SQL error: $DBI::errstr");
				if ($check) {$log->info("Deleted $check record(s) SQL command: $cmd")}
			}
		}

		#
		# then remove the record
		$cmd	= "DELETE FROM $table WHERE $uniqOID='$oid'";
		$result = $dbconn->do("$cmd");
		&dBaseError($dbconn, $cmd) if (!defined($result));
		$log->info("Deleted from table $table WHERE $uniqOID='$oid'");
		&listTable ($out);



	#
	# if our user just asked for the deletion we'll ask him to confirm his request
	} else {
		print $out->start_html(-title=>"really ??", -BGCOLOR=>$bgcol, -BACKGROUND=>$mainBackground);
		print $out->startform(-method=>"POST", -action=> "$scriptname") . "\n";
		open (MAINFRAME, ">-");
		&printReminder ($out);
		close (MAINFRAME);

		#
		# finally complete our form
		if($language eq "german") {
			print "Wenn Sie den Datensatz wirklich entfernen wollen, dann best&auml;tigen Sie bitte hier: ";
		} else {
			print "In case you really want to remove this record please confirm here: ";
		}
		print $query->submit(-name=>'mode', -value=>$buttons{'confdel'}) . "\n";
	
		if($language eq "german") {
			print "<P>Sie k&ouml;nnen sich auch die &Uuml;bersicht wieder anzeigen lassen: ";
		} else {
			print "<P>You can also go back to the record list: ";
		}

		$temp	= $query->param('xmin');
		$out->append(-name=>'xmin', -value=>$temp);
		print	$out->hidden(-name=>'xmin');
		print	$query->submit(-name=>'mode', -value=>$buttons{'search'}) . "\n";
		print	$out->endform;
		print	$out->end_html;
	}
} # doDeleteRecord



sub doUpdateMultipleRecords {
	#
	# save the given values from $query in the record $oid
	local($query, $out) = @_;

	# Determine the uniqOID if not already defined
	$uniqOID = &db_getUniqOIDField($dbconn, $table) unless ($uniqOID);
	
	#
	# first get the field types and start to build our SQL statement
	&getFieldTypes;

	#
	# add assignments for all given values
	foreach $name ($query->param) {
		unless(&isReservedWord($name)) {
			$name		=~ /([\d\w]*):(\w*)/;
			$oid		= $1;
			$field		= $2;
			$setclause	= "SET $field = " . &local2SQLformat(&checkFieldContent($query->param($name), $field), $field);
			$cmd	= "UPDATE $table $setclause WHERE $uniqOID='$oid'";
			$result	= $dbconn->do("$cmd");
			$log->info("Updated record: $uniqOID='$oid'. SQL command: $cmd");
			&dBaseError($dbconn, $cmd) if(!defined($result));
		}
	}

	$oid	= undef;
	$xmin	= undef;
} # doUpdateMultipleRecords


sub doUpdateRecord {
	#
	# save the given values from $query in the record $oid
	local($query, $out) = @_;

	# Determine the uniqOID if not already defined
	$uniqOID = &db_getUniqOIDField($dbconn, $table) unless ($uniqOID);
	
	#
	# first get the field types and start to build our SQL statement
	&getFieldTypes;
	$setclause = "set ";

	#
	# add assignments for all given values
	foreach $name ($query->param) {

		#
		# according to the type of data we use there might
		# have to be some correction
		# corrected IC 2001-11-27 -> only insert fields that were entered
		if(length($query->param($name))>0) {
			unless(&isReservedWord($name)) {
				$setclause	.=  "$name = " . &local2SQLformat(&checkFieldContent($query->param($name), $name), $name) . ", ";
			}
		}
	}

	#
	# remove the trailing ", "
	chop($setclause); chop($setclause);

	#
	# and send it to the database
	$cmd	= "UPDATE $table $setclause WHERE $uniqOID='$oid'";
	print $cmd if $debug;
	$result	= $dbconn->do("$cmd");
	&dBaseError($dbconn, $cmd) if(!defined($result));
	$log->info("Updated record: $uniqOID='$oid'. SQL command: $cmd");
} # doUpdateRecord


sub checkFieldContent {
	#
	# This routine checks whether the value of a given field is valid
	# in case there's a Perl subroutine defined for this test
	# and dies if the test fails.
	# In this case the subroutines failure description from $@ is presented
	local ($content, $name) = @_;
	if($fieldeval{$name}) {
		@_ = $content;
		print "$name = " . $name . "\n<BR>" if $debug;
		print '"' . $_[0] . '"' . "\n<BR>" if $debug;
		$content = eval ($fieldeval{$name});
		print "$content = " . $content . "\n" . "<BR>" if $debug;

		#
		# if there's an error during the evaluation we
		# display the error message just before we die :-((
		unless(defined($content)) {
			print "<H4><FONT COLOR=BLACK><P>Error in field $name:<BR>$@</FONT></H4>";
			$log->error("Error in field: $name:$@ ");
		}
	}
	$content;
} # checkFieldContent


# listTable
# This subroutine does much of the displaying of tables. Called by search mode.
#
# Parameters:
#	$out - CGI object used for the html output
# Output:
#	
# Globals in use:
#	$table - name of table being operated on
#	$fields - list of fields to display
#	$search 
sub listTable {
	my ($out) = @_;
	
	# Determine the uniqOID if not already defined
	$uniqOID = &db_getUniqOIDField($dbconn, $table) unless ($uniqOID);

	#
	# let's generate a list with all records in $table
	# beginning with the headline of our window
	&getFieldTypes($table); 
	&getTableDesign($table);
	
	# Is the table read-only?
	my ($tableIsView) = db_isView($table);
	$fields = "$table.*" unless($fields);
	
	# why the limit? what does this do/prevent? - wlm
	unless(length($search)>5) {
		#
		# now we consider our users search restrictions, if any...
		$suche = "WHERE ";
		foreach $name ($query->param) {
			$query_param	= $query->param($name);
			$quoted_param	= $dbconn->quote($query_param);
			#
			# while of course dbengine arguments and the submit button will be omitted
			unless (&isReservedWord($name) || !$query->param($name) || length($query->param($name))>100) {

				#
				# for same datatypes we have to quote our search value... 
				# wlm..could this be done by dbi using placeholders?
				if(		$fieldtype{$name} eq "bpchar"	|| $fieldtype{$name} eq "text"
					||	$fieldtype{$name} eq "varchar"	|| $fieldtype{$name} eq "char"
					||	$fieldtype{$name} eq "CHAR"	|| $fieldtype{$name} eq "VARCHAR"
					||	$fieldtype{$name} eq "VARCHAR2"	|| $fieldtype{$name} eq "CLOB") {
					#
					# if our user inserted a % wildcard then we use his input
					if($query->param($name) =~ /(.*)[\%](.*)/) {
						$suche	.= $name . " LIKE " . $quoted_param . " AND " ;
					#
					# if our Users query starts with '=' we try to find an exact match
					} elsif($query->param($name) =~ /\=(.*)/) {				#rl this is not escaped.
						$suche	.= $name . " = \'" . $1 . "\' AND " ;			#rl Remove?

					#
					# the "avarage" user will be given asssistance by inserting % around his search string
					} else {
						$test	="%".$query->param($name)."%";
						$tester	=$dbconn->quote($test);
						$suche	.= $name . " LIKE ". $tester. " AND " ;
					}

				#
				# when comparing dates we have to add quotes
				} elsif($fieldtype{$name} eq "date" || $fieldtype{$name} eq "time" || $fieldtype{$name} eq "DATE") {
					$suche	.= $name . " = " . $quoted_param . " AND " ;

				#
				# when comparing booleans we have to add quotes
				} elsif($fieldtype{$name} eq "bool") {
					$suche	.= $name . " = " . $quoted_param . " AND " ;

				#
				# we don't want any quotes when comparing numbers
				} else {
					$number	 = $query->param($name);
					$suche	.= $name . " = " . &local2SQLformat($number, $name) . " AND " ;
				}
			}
		}

		#
		# if we didn't find a search restriction the WHERE clause in the SQL query can be omitted
		if($suche eq "WHERE ") {
			$suche  = "";

		#
		# otherwise the last "AND " has to be removed...
		} else {
			chop($suche); chop($suche); chop($suche); chop($suche);
		}

		if ($tableQuery) {
			$_	  = $suche;
			$retVal = eval ($tableQuery);
			if (!$retVal && $suche) {
				print "<H4><FONT COLOR=BLACK><P>Error in field xxquerystring of table tabledesign for table $table:<BR>\n" . $@ . "</FONT></H4>";
			} else {
				$suche  = $retVal;
			}
		}
		unless($tableIsView) {		### corrected IC 2001-11-27 !!!
			$search = "SELECT $uniqOID, $fields FROM $table $suche $order";
		} else {
			$search = "SELECT $fields FROM $table $suche $order";
		}
	} # unless(length($search)>5)

	#
	# now lets ask the database...
	$listResult=$dbconn->prepare($search);
	$listResult->execute || $log->error("Search Failed SQL command:$search");
	@listResult_fname=@{$listResult->{NAME}};
	$listResult_data=$listResult->fetchall_arrayref;
	$ntuples=$listResult->rows;
	$nfields=$listResult->{NUM_OF_FIELDS};

	#
	# keep the SQL search statement in mind
	$out->delete_all;
	$out->append(-name=>'search',-value=>$search);  

	
	#
	# if there's only one resulting record we go ahead and show it directly
	if($ntuples == 1 && $tableIsView==0) {
		$oid	= ${${$listResult_data}[0]}[0];			  
		$mode	= "plain";
		&plainDialog ($out);
		exit;

	} else {
		#
		# debug-output of our search restriction
		print $out->start_html(-title=>"Records of $table:", -BGCOLOR=>$bgcol, -BACKGROUND=>$mainBackground);

		#
		# now we start our form part 
		($title=$table)	=~ s/\W|_/ /;
		$title		= lc $title;
		$title		=~ s/\b(\w)/\u$1/g;
		print "<CENTER><H1>$title</H1><CENTER>";
		print "<FORM METHOD=POST ACTION=\"$scriptname\" ENCTYPE=\"application/x-www-form-urlencoded\">";
		print $out->submit(-name=>'mode', -value=>$buttons{'plain'}) . "\n";
		if($tableModifyable eq "t" || $tableModifyable == 1) {
			print $out->submit(-name=>'mode', -value=>$buttons{'mupdate'}) . "\n";
			print $out->reset($buttons{'reset'}) . "\n";
		}
		print $out->hidden('table', $table) . "\n";
		print $out->hidden('dbase', $dbase) . "\n";
		print $out->hidden('childfield', $childfield) . "\n";
		print $out->hidden('childpreset', $childpreset) . "\n";
		print $out->hidden('dbdesc', $dbdesc) . "\n";
		print $out->hidden('search', $search) . "\n";

		print "<P>$search<P>" if $debug;

		#
		# print the header
		if ($tableStart) {
			$retVal = eval ($tableStart) || $log->debug("Error in field xtablestart of table tabledesign for table $table: $@");
			$retVal = "<H4><FONT COLOR=BLACK><P>Error in field xtablestart of table tabledesign for table $table:<BR>\n" . $@ . "</FONT></H4>" unless $retVal;
			print $retVal;
		} else {
			#
			# switch the output into a monospaced font
			print "<P><FONT SIZE=3 FACE=\"Monaco\">\n";

			if ($smarttable == 1) {
				print "<TABLE BORDER=1 WIDTH=100\%><TR><TH BGCOLOR=".$headerbgcol.">&nbsp</TH>";
				for ($j=1; $j < $nfields; $j++) {
					if (!defined($fielddisplay{$listResult_fname[$j]}) || $fielddisplay{$listResult_fname[$j]} ne "hidden") {
						print "<TH BGCOLOR=".$headerbgcol."><FONT COLOR=".$headertxtcol." FACE=\"ARIAL\">";
						#
						#rl Header for cols in multiple list
						if (defined $fielddispstring{$listResult_fname[$j]}) {
							print $fielddispstring{$listResult_fname[$j]};
						} else {
							printf("%s", $listResult_fname[$j]);
						}
						print "</FONT></TH>";
					}
				}
				print "</TR>";
			}
		}

		$comm   = "SELECT * FROM virtual WHERE tablename='$table' ORDER BY xlevel";
		$vfields=$dbdconn->prepare($comm);   #rl
		$vfields->execute || $log->debug("Could not get Virtual Fields. SQL command:$comm");			  #rl

		# *** Only the oid of each 'edit' HREF changes, so the rest of the 
		# *** anchor will be defined here.  The reduces the number of
		# *** CGI->delete and CGI->append instructions, a total of $i X 8 such
		# *** instructions are avoided, total.
		# *** Added 99/07/27 - by M2
		# *** We need to have $dbdesc in each HREF in order to allow each
		# *** database to have an independent description database.  Without
		# *** this addition, each database must rely on the hard-coded default.
		# *** Added 99/06/23 - by M2
		$out->append('dbase', $dbase);
		$out->append('dbdesc', $dbdesc);
		$out->append('table', $table);
		$out->append('mode', 'plain');


		#
		# now scan all records
		for ($i=0; $i < $ntuples; $i++) {

			#
			# if a special item string has been defined; go ahead and store all fields into a hash
			if (defined $tableItem && length($tableItem)>0) {
				for ($j=1; $j < $nfields; $j++) {
					$values{$listResult_fname[$j]}   = ${${$listResult_data}[$i]}[$j];
				}
	
				#
				# then add the contents of any defined virtual fields if needed
				if($vfields && defined($tableVirtuals) && ($tableVirtuals eq "t" || $tableVirtuals == 1)) {
					@vfields_fname=$vfields->{name};
					$nvtuples = $vfields->rows();
					for($vidx=0;  $vidx<$nvtuples; $vidx++) {
			
						#
						# if there's an error during the evaluation we set our 
						# virtual fields  contents to the error message
						## THIS HAS NOT BEEN UPDATED FOR mySQL - wlm 01/08/02
						unless($values{${${$vfields}[$vidx]}[1]}		= eval (${${$vfields}[$vidx]}[4])) {
							$log->debug("Error in virtual field $current:<BR>\n$@"); 
							$values{$vfields_fname[$vidx]}  = "<H4><FONT COLOR=BLACK><P>Error in virtual field $current :<BR>\n" . $@ . "</FONT></H4>";
						}
					}
				}
				$oid	= ${${$listResult_data}[$i]}[0];
				$out->delete('oid');
				$out->append('oid', $oid);
				$_	= "<A HREF=\"$scriptname?".$out->query_string."\">";
				$retVal	= eval ($tableItem);
				$log->debug("Error in field xtableitem = $tableItem of table tabledesign for table $table:<BR>\n$@") unless $retVal;
				$retVal	= "<H4><FONT COLOR=BLACK><P>Error in field xtableitem = $tableItem of table tabledesign for table $table:<BR>\n" . $@ . "</FONT></H4>" unless $retVal;
				print $retVal . "\n";
				$oid	= undef;
	
			} else {
				#
				# and always integrate a HREF to our modify.cgi with the record ID
				if ($smarttable == 1) {
					print "<TR><TD BGCOLOR=".$tablebgcol.">";
					$oid	= ${${$listResult_data}[$i]}[0];
					$out->delete('oid');
					$out->append('oid', $oid);
					print "<P><A HREF=".$scriptname."?".$out->query_string.">".$buttons{'edit'}."</A></TD>";
					for ($j=1; $j < $nfields; $j++) {
						$name = $listResult_fname[$j];
						$align = "RIGHT";
						$typ = $fieldtype{$name};
						$val = ${${$listResult_data}[$i]}[$j];
						$val = "&nbsp" unless length($val) > 0;
						if ($typ eq "bool" || (defined($fielddisplay{$name}) && $fielddisplay{$name} =~ /intasbool/)) {
							$align = "CENTER";
							if (${${$listResult_data}[$i]}[$j] eq "0") {
								${${$listResult_data}[$i]}[$j]=$buttons{'false'};
							} elsif (${${$listResult_data}[$i]}[$j] eq "1") {
								${${$listResult_data}[$i]}[$j]=$buttons{'true'};
							} else {
								${${$listResult_data}[$i]}[$j]=$buttons{'undef'};
							}
						} elsif($typ eq "date" || $typ eq "DATE") {
							$align = "CENTER";
						} elsif($typ eq "text" || $typ eq "CLOB") {
							$align = "LEFT";
							$val =~ s/\n/<BR>/g;
						}
					
						if (!defined ($fielddisplay{$name}) || $fielddisplay{$name} ne "hidden") {
							print "<TD BGCOLOR=".$tablebgcol." ALIGN=".$align."><FONT COLOR=".$tabletxtcol." FACE=\"ARIAL\">";
							if (length(${${$listResult_data}[$i]}[$j])>0) {
								printf("%s ", ${${$listResult_data}[$i]}[$j]);
							} else {
								print "&nbsp";
							}
							print "</FONT></TD>";
						}
					}
					print "</TR>\n";
				} else {
					$oid	= ${${$listResult_data}[$i]}[0];
					$out->delete('oid');
					$out->append('oid', $oid);
					print "<P><A HREF=".$scriptname."?".$out->query_string.">";
					# prior to printing the fields required by 'fields'
					for ($j=1; $j < $nfields; $j++) {
						printf("%s ", ${${$listResult_data}[$i]}[$j]);
					}
					print "</A>\n";
				}
			}
		}


		if ($tableEnd) {
			$retVal = eval ($tableEnd);
			$log->debug("Error in field xtableend of table tabledesign for table $table:$@") unless $retVal;
			$retVal = "<H4><FONT COLOR=BLACK><P>Error in field xtableend of table tabledesign for table $table:<BR>\n" . $@ . "</FONT></H4>" unless $retVal;
			print $retVal;

		} else {
			if ($smarttable == 1) {
				print "</TABLE>";
			}
			print "</FONT>";
		}


		#
		# terminate the form and our HTML file
		print $out->endform;
		print $out->end_html;
	} # if($ntuples == 1 && $tableIsView==0)

} # listTable



sub getTableDesign {
	#
	# let's try to get additional design information (if any)
	# for the proper display of the current $table and store that
	# information in $tableVirtuals, $tableStart, $tableItem, $tableEnd and $tableQuery
	local($table)	= @_;
	$tableVirtuals	= $tableStart   = $tableItem	=   $tableEnd   =   $tableQuery =   $tableModifyable	=   undef;
	$result = $dbdconn->prepare("	SELECT	tablename, needsVirtuals, xtablestart, xtableitem,
						xtableend, xxquerystring, modifyableList
					FROM	tabledesign
					WHERE	tablename='$table'");
	$result->execute || $log->debug("could not get design information. SQL error:$DBI::errstr");
	if($result) {
		@array			= $result->fetchrow_array;
		$current		= $array[0];
		$tableVirtuals		= $array[1];
		$tableStart		= $array[2];
		$tableItem		= $array[3];
		$tableEnd		= $array[4];
		$tableQuery		= $array[5];
		$tableModifyable	= $array[6];
	} 
}



sub createMainFrame {
	#
	# let's generate a list with all available tables in $dbase,
	# beginning with the headline of our window
	local($out) = @_;

	print "<HTML><HEAD><TITLE>Database $dbase</TITLE></HEAD>\n";
	print "<FRAMESET Cols=\"170,*\">\n";
	# *** Add the descriptive database $dbdesc to each HREF.  When a HREF is
	# *** followed, the specified descriptive db is used, rather than defaulting
	# *** back to the hard-coded descriptive database.
	# *** Added 99/06/26 by M2 
	print "<FRAME Name=menu SRC=$scriptname?dbase=$dbase&dbdesc=$dbdesc&mode=menu Scrolling=Auto MARGINWIDTH=1>\n";
	print "<FRAME Name=body SRC=$scriptname?dbase=$dbase&dbdesc=$dbdesc&mode=empty Scrolling=Auto>\n";

	print "</FRAMESET>\n";
	print "</HTML>\n";
}


sub plainDialog {
	#
	# let's generate a dialog that allows for entering values to
	# either add new records or search for existing ones
	local($out) = @_;

	#
	# now get the types and displayinfo for all fields of $table
	# and fill our %values array with the contents of the record at $oid
	# we also try to get relation informations
	&getFieldTypes;
	&fillValues;

	#
	# if there're relations available for $table we create 
	# a temporary file with the dialog, because our output
	# will be a frame...
	if ($relationtuples) {
		#
		# lets first of all remove all files that are older than 60 minutes
		#modifed by WLM per Perl Cookbook ex. 9.7 to work on Win* OS
		my $dirname = "$htdocs$tmp";
		opendir(DIR, $dirname) or $log->error("Can't opendir $dirname: $!");
		while(defined (my $file = readdir(DIR)) ) {
			next if $file =~ /^\.\.?$/;	# skip . and ..
			if($file =~ /dispframe1\.(\d+)\./) {
# ORG:		while(<$htdocs$tmp*>) {
# ORG:			if(/dispframe1\.(\d+)\./) {
				$time = $1;
				unlink $_ if(($time+60*60)<$starttime);
			}
		}
		open (MAINFRAME, ">$htdocs$tmp$table.dispframe1.$starttime.$$.html");

	#
	# otherwise we send our output to STDOUT
	} else {
		open (MAINFRAME, ">-");
	}


	#
	# now we try to open a template .html file that shall
	# be used to display the contents of our record
	if (open (SEARCHMASK, "$templ$table.html")) {
		&scanAndReplaceTemplate ($out);
		close SEARCHMASK;

	#
	# if there's no template file available we simply
	# create something from the database definition ;-))
	} else {
		&createDialog ($out);
	}
	close MAINFRAME;


	#
	# if there're relations available for $table we now
	# have to create some frames...
	if ($relationtuples>0) {
		print "<HTML><HEAD></HEAD>\n<FRAMESET Rows=\"50%, *\">\n\n";
		print "\t<FRAME Name=\"MAINFRAME\" SRC=\"$tmp$table.dispframe1.$starttime.$$.html\" Scrolling=\"Auto\">\n";
		print "\t<FRAMESET Cols=\"";
		$ntuples	= $relationtuples; while($ntuples--) { $cols .= "*," }; chop($cols);
		print "$cols\">";
		$ntuples	= $relationtuples;

		for ($i=0; $i < $ntuples; $i++) {
			$out->delete_all;
#die "$relations_data->[$i]->{parentField} -=- $relations_data->[$i]->{childField} -=- $relations_data->[$i]->{parent} -=- $relations_data->[$i]->{child}";
			$out->append(-name=>'table',-value=>${${$relations_data}[$i]}{'child'}); # child-table  [1]
			$out->append(-name=>'dbase',-value=>$dbase);
			$out->append(-name=>'dbdesc',-value=>$dbdesc);
			$out->append(-name=>'mode',-value=>$buttons{'search'}); 

			$out->append(-name=>'childfield', -value=>xChop(${${$relations_data}[$i]}{'childField'})); # [3]
			# The following two lines had to be modified for mySQL due to insertion of oid field
			$out->append(-name=>'childpreset', -value=>xChop($values{ $relations_data->[$i]->{parentField} })); # [1+$dbVar{'offset'}]
			$out->append(-name=>xChop( $relations_data->[$i]->{childField} ), -value=>xChop($values{${${$relations_data}[$i]}{parentField}})); # [3+$dbVar{'offset'}] /\ [1+$dbVar{'offset'}]
			# end modifications

			print "\n\t\t<FRAME DDD Name=\"LIST$i\" SRC=\"$scriptname?" . $out->query_string . "\" Scrolling=\"Auto\">";
		}
	
		print "\n\t</FRAMESET>\n</FRAMESET>\n\n<BODY></BODY></HTML>";
	}
} # plainDialog



sub scanAndReplaceTemplate {
	#
	# duplicate the contents of SEARCHMASK into
	# MAINFRAME and do some replacements...
	local($fieldout)	= @_;
	while (<SEARCHMASK>) {

		#
		# if we find a TEXTAREA tag we insert the contents of the field
		# with the given name ahead of the </TEXTAREA> tag
		if(/[tT][eE][xX][tT][aA][rR][eE][aA]\s*[nN][aA][mM][eE]\s*\=\s*\"(\w*)\"\s*/ && $values{$1}) {
			$name	= $1;
			s/>(.*)<\/[tT][eE][xX][tT][aA][rR][eE][aA]>/>$1$values{$name}<\/TEXTAREA>/;

		#
		# in case of any NAME tags in the HTML file we insert a VALUE tag with the
		# named fields contents right behind it
		} elsif(/[nN][aA][mM][eE]\s*\=\s*\"(\w*)\"\s*/ && $values{$1}) {
			s/[nN][aA][mM][eE]\s*\=\s*\"(\w*)\"\s*/NAME=\"$1\" VALUE=\"$values{$1}\" /;
		}
	

		#
		# in case of #exec commands for SSIs we simply execute them
		if (/<\!--\#exec\s*cmd\=\"(.*)\"\s-->/) {
			$arg	= $1;
			$result	= `$arg`;
	
			#
			# ... und and replace their call by the result
			s/<\!--\#exec\s*cmd\=\"(.*)\"\s-->/$result/;
		}

		#
		# in case of <--@name--> we simply replace them by their value
		if (/<--\@(.*)-->/) {
			s/<--\@(.*)-->/$values{$1}/;
		}


		#
		# we scan for comment lines starting with <--** -->
		# and interpret the text inside as a Perl script
		if (/<--\*\*(.*)-->/) {
			$arg	= $1;
			$result	= eval ($arg);

			#
			# if there's an error during the evaluation we replace
			# the output with the error message
			$log->debug("Error in embeddet expression $arg :<BR>\n$@ ") if !$result && $@;

			$result = "<H4><FONT COLOR=BLACK><P>Error in embeddet expression $arg :<BR>\n" . $@ . "</FONT></H4>" if !$result && $@;

			#
			# finally we replace the comment by its result
			s/<--\*\*(.*)-->/$result/;
		}

		#
		# if we're showing a real record ...
		if($oid) {
			#
			# replace any search button by an update button and any add button by a delete button
			s/(.*)VALUE\=\"$buttons{'search'}\"(.*)/$1VALUE=\"$buttons{'update'}\"$2/;
			s/(.*)VALUE\=\"$buttons{'add'}\"(.*)/$1VALUE=\"$buttons{'delete'}\"$2/;
		}

		#
		# finally the current line has to be saved
		print MAINFRAME $_ . "\n";

		#
		# once we're behind the <FORM ACTION tag we go ahead and insert
		# a couple of hidden fields that we need to know when we're called again...
		if(/FORM\s*ACTION/) {
			&printReminder ($fieldout);
		}

	} # end while

} # scanAndReplaceTemplate



sub createDialog {
	#
	# create the complete HTML dialog from the information in our database
	local($query)	= @_;
	print MAINFRAME $query->start_html(-title=>"table $table", -BGCOLOR=>$bgcol, -BACKGROUND=>$mainBackground, -expires=>'now') . "\n";
	($title=$table) =~ s/\W|_/ /;
	$title = lc $title;
	$title =~ s/\b(\w)/\u$1/g;
	print MAINFRAME "<CENTER><H1>\u$title</H1><CENTER>";
	print MAINFRAME "<P>$search<P>" if $debug;

	#
	# now we start our form part  
	print MAINFRAME "<FORM METHOD=POST ACTION=\"$scriptname\" ENCTYPE=\"application/x-www-form-urlencoded\" TARGET=body>";

	#
	# start the table with our fields
	# added a table cell background colour $tablebgcol to edit/search - M2
	# print MAINFRAME "<TABLE BORDER CELLSPACING=0 CELLPADDING=5>\n";
	print MAINFRAME "<TABLE BORDER CELLSPACING=0 CELLPADDING=5 BGCOLOR=".$tablebgcol.">\n";
	$line	= 0;
	$column	= 1;
	foreach $name (xSort(keys %values)) {
		#
		# don't include the last modification date of our record
		next if $name eq "xmin"; # let's get rid of some indentation... wlm 01/11/16
		if($fielddispcolumn{$name} <= $column && $fielddispcolumn{$name}) {
			$column = 1;
			if($line) {
				if ($fielddisplay{$name} !~ /hidden/) {
					print MAINFRAME "</TR>\n<TR><TD>";
				}
			} else {
				if ($fielddisplay{$name} !~ /hidden/) {
					print MAINFRAME "<TR><TD>";
				}
			}
			$line++;
		}

		while($fielddispcolumn{$name} > $column) {
			print MAINFRAME "<TD>";
			print MAINFRAME "<TD>" unless $lastUsed == $column;
			$column++;
		}
	
		if(!$fielddispcolumn{$name}) {
			$column = 1;
			if($line) {
				print MAINFRAME "</TR>\n<TR><TD>";
			} else {
				print MAINFRAME "<TR><TD>";
			}
			$line++;
		}

		if ($fielddisplay{$name} !~ /hidden/) {
			if(defined $fielddispstring{$name}) {
				print MAINFRAME $fielddispstring{$name};
			} else {
				print MAINFRAME "$name";
			}
			print MAINFRAME "<TD>";
			$lastUsed   = $column;
		}

		#
		# print static virtual fields
		if($fieldtype{$name} =~/virtual\s(.*)/) {
			print MAINFRAME $values{$name} . "\n";

		#
		# print editable fields
		} else {

			#
			# if there's designinfo available for the field, use it
			if($fielddisplay{$name}) {
				if ($fielddisplay{$name} =~ /hidden/) {
					print MAINFRAME $query->hidden(-name=>$name, -default=>$values{$name}) . "\n";
				} elsif($fielddisplay{$name} =~ /tablepopup/) {
					print MAINFRAME &tablePopup($name) . "\n";
				} elsif($fielddisplay{$name} =~ /intasbool/) {
					$wahr		= "CHECKED" if $values{$name} == 1;
					$falsch		= "CHECKED" if ($values{$name} eq '0');
					$undefiniert	= "CHECKED" if ($values{$name} ne '1' && $values{$name} ne '0');
					print MAINFRAME "<INPUT TYPE=radio NAME=\"$name\" VALUE=1 $wahr>$buttons{'true'}<INPUT TYPE=radio NAME=\"$name\" VALUE=0 $falsch>$buttons{'false'}".
							"<INPUT TYPE=radio NAME=\"$name\" VALUE=\"\" $undefiniert>$buttons{'undef'} \n";
					($wahr, $falsch)="";
				} elsif($fielddisplay{$name} =~ /textarea\s*(\d*)\s*(\d*)/) {
					$arg1 = $1, $arg2 = $2;
					print MAINFRAME $query->textarea(-name=>$name, -default=>$values{$name}, -rows=>$arg1, -columns=>$arg2) . "\n";
				} elsif($fielddisplay{$name} =~ /text\s*(\d*)\s*(\d*)/) {
					$arg1 = $1, $arg2 = $2;
					print MAINFRAME $query->textfield(-name=>$name, -default=>$values{$name}, -size=>$arg1, -maxlength=>$arg2) . "\n";
				} elsif($fielddisplay{$name} =~ /relationpopup\s*(\w*)\s*(\w*)\s*(\w*)/) {
					$arg1 = $1, $arg2 = $2, $arg3 = $3;
					print MAINFRAME &relationPopup($name, $arg1, $arg2, $arg3) . "\n";
				} elsif($fielddisplay{$name} =~ /popup/) {
					print MAINFRAME &valueListPopup($name) . "\n";
				}
			
			#
			# if there's no designinfo available for the field, use common sense...
			} else {
				#
				# chars are displayed in editable textfields with the size
				# of the database field, but not wider than $maxwidth
				if($fieldtype{$name} eq "bpchar" || $fieldtype{$name} eq "CHAR" || $fieldtype{$name} eq "VARCHAR" || $fieldtype{$name} eq "VARCHAR2") {
					$size = ($fieldlength{$name}>$maxwidth)?$maxwidth:$fieldlength{$name};
					print MAINFRAME "<INPUT TYPE=\"text\" NAME=\"" .$name. "\" VALUE=\"".$values{$name}."\"".
							" SIZE=$size MAXLENGTH=".$fieldlength{$name}.">\n";
				#
				# booleans are displayed in form of radio buttons $buttons{'true'} and $buttons{'false'}
				} elsif ($fieldtype{$name} eq "bool") {
					$wahr		= "CHECKED" if ($values{$name} == 1 || $values{$name} eq 't');		### corrected IC 2001-11-27
					$falsch		= "CHECKED" if ($values{$name} eq '0' || $values{$name} eq 'f');	### corrected IC 2001-11-27
					$undefiniert	= "CHECKED" if (length($wahr.$falsch) == 0);				### corrected IC 2001-11-27
					print MAINFRAME	"<INPUT TYPE=radio NAME=\"$name\" VALUE=t $wahr>$buttons{'true'}<INPUT TYPE=radio NAME=\"$name\" VALUE=f $falsch>$buttons{'false'}".
							"<INPUT TYPE=radio NAME=\"$name\" VALUE=\"\" $undefiniert>$buttons{'undef'} \n";
					#
					# rl Reset vars for next time through loop
					# rl so everything is not checked after first bool
					($wahr, $falsch, $undefiniert)="";							### corrected IC 2001-11-27
				#
				# date fields are shown as is or in language specific format
				} elsif ($fieldtype{$name} eq "date" || $fieldtype{$name} eq "DATE") {
					$values{$name}  = "$2.$1.$3" if($language eq "german" && $values{$name}  =~ /(\d\d)\-(\d\d)\-(\d\d\d\d)/);
					print MAINFRAME $query->textfield(-name=>$name, -default=>$values{$name}, -size=>10, -maxlength=>10) . "\n";

				#
				# timestamp fields are shown as is or in language specific format				### added IC 2001-11-27
				} elsif ($fieldtype{$name} =~ /timestamp/i) {
					if($values{$name} =~ /(\d\d\d\d)-(\d\d)-(\d\d)\s+(\d\d:\d\d:\d\d)/) {
						if($language eq "german") {
							$values{$name}  = "$3.$2.$1 $4";
						} else {
							$values{$name}  = "$1-$2-$3 $4";
						}
					}
					print MAINFRAME $query->textfield(-name=>$name, -default=>$values{$name}, -size=>19, -maxlength=>19) . "\n";

				#
				# float4 fields are shown as is or in language specific format
				} elsif ($fieldtype{$name} eq "float4" || $fieldtype{$name} eq "DECIMAL" || $fieldtype{$name} eq "FLOAT" || $fieldtype{$name} eq "NUMBER") {
					$values{$name}  =~ s/\./\,/g if $language eq "german";
					print MAINFRAME $query->textfield(-name=>$name, -default=>$values{$name}, -size=>10, -maxlength=>10) . "\n";

				#
				# text fields are shown as standard text fields, $maxwidth chars wide, but accept up to 512 chars
				} elsif ($fieldtype{$name} eq "text" || $fieldtype{$name} eq "CLOB") {
					if($values{$name} =~ /[\r\n]/sg) {							### corrected IC 2001-11-27
						print MAINFRAME $query->textarea(-name=>$name, -default=>$values{$name}, -rows=>5, -columns=>$maxwidth) . "\n";
					} else {
						print MAINFRAME $query->textfield(-name=>$name, -default=>$values{$name}, -size=>$maxwidth, -maxlength=>512) . "\n";
					}

				#
				# all other fields are also shown as text fields
				} else{
					if($values{$name} =~ /[\r\n]/sg) {							### corrected IC 2001-11-27
						print MAINFRAME $query->textarea(-name=>$name, -default=>$values{$name}, -rows=>5, -columns=>$maxwidth) . "\n";
					} else {
						print MAINFRAME $query->textfield(-name=>$name, -default=>$values{$name}) . "\n";
					}
				}
			}
		}
		$fields .= $name . "," unless $oid;
	}
	chop($fields) unless $oid;
	print MAINFRAME "</TABLE>\n";

	&printReminder ($query);

	#
	# when we show a real record we'll allow our user to either delete or update
	# it or to add a variation of it to the database
	print "<P>";
	if($oid) {
		print MAINFRAME $query->submit(-name=>'mode', -value=>$buttons{'update'}) . "\n";
		print MAINFRAME $query->submit(-name=>'mode', -value=>$buttons{'delete'}) . "\n";
		print MAINFRAME $query->submit(-name=>'mode', -value=>$buttons{'new'})."\n";
		print MAINFRAME $output->hidden('-name'=>'mode',	#rl default to search if there is just one text field
						'-value'=>'update');	#rl I hope that this does not screw anythin up :) 
	#
	# when we only show an empty dialog the user is allowed to search or add records
	} else {
		print MAINFRAME $query->submit(-name=>'mode', -value=>$buttons{'search'}) . "\n";
		print MAINFRAME $query->submit(-name=>'mode', -value=>$buttons{'add'}) . "\n";
		print MAINFRAME $output->hidden('-name'=>'mode',	#rl default to search if there is just one text field
						'-value'=>'add');   #rl I hope that this does not screw anythin up :) 
	}
	print MAINFRAME $query->reset($buttons{'reset'}) . "\n";


	#
	# terminate the form and our HTML file
	print MAINFRAME $query->endform;
	print MAINFRAME $query->end_html;
}


sub doAddRecord {
	#
	# add the complete record that lives in $query to $table
	# therefore first of all get the fieldtypes for $table
	local($query, $out) = @_;
	&getFieldTypes($table);

	#
	# and then build our insert command
	local($cmd_vals)	= "VALUES  ( ";
	local($cmd_fields)	= "( ";

	#
	# let's go through our fields...
	# this is new for mysql - 01/07/30 wlm
	foreach my $name ( @fieldnames ) {
		print	$name.": ".$query->param($name) . "\n<BR>" if $debug;	# IC 2001-11-27

		#
		# according to the type of data we use there might
		# have to be some correction
		# corrected IC 2001-11-27 -> only insert fields that were entered
		if(length($query->param($name))>0) {
			$cmd_fields	.= "$name,";
			$cmd_vals	.= local2SQLformat(&checkFieldContent($query->param($name), $name), $name) . ",";
		}
		$query->param(-name=>$name, -value=>'');
		print $query->param($name) . "\n<BR>" if $debug;

		print @row if $debug;
	}
	
	#
	# now terminate the SQL command
	chop($cmd_vals);
	chop($cmd_fields);
	local($cmd) = "INSERT INTO $table $cmd_fields ) $cmd_vals )";
	print $cmd."\n<BR>" if $debug; 

	#
	# and send it to the database
	$result = $dbconn->do("$cmd");
	&dBaseError($dbconn, $cmd) if(!defined($result));
	$log->info("Record inserted into database. SQL command: $cmd");

	print "<BR>result:".$dbdconn->errstr." - OK is: ".PGRES_COMMAND_OK."</BODY></HTML>\n" if $debug;

	if (defined($result)) {
		#
		# if we're still alive we should go ahead and
		# prepare everything for a new record creation now
		$mode   = "search";
		&plainDialog;
	}
} # doAddRecord



sub getFieldTypes {

	#
	# rl tis a bit of hackery... 
	# But prevents  duplicate entries if this sub is called more than once. 
	if (%fielddisporder) { return; }

	#
	# execute dbase specific subroutine...
	&db_getDbaseFieldTypes();

	#
	# now we need a second request to get additional design information (if any)
	# if the's any error during this request we simply ignore it
	$result = $dbdconn->prepare ("	SELECT	fieldname,displayinfo,displaystring,
						xdefault,xevaluation,displaycolumn,displayorder
					FROM	designinfo
					WHERE	tablename='$table'");	 #rl

	$result->execute || $log->debug("Could not get design Info. SQL Error:$DBI::errstr");
	if($result) {
		while(@array = $result->fetchrow_array) {	#rl
			$current			= $array[0];		#rl
			$fielddisplay{$current}		= $array[1] if(defined($array[1]));
			$fielddispstring{$current}	= $array[2] if(defined($array[2]));
			$fielddefault{$current}		= $array[3] if(defined($array[3]));
			$fieldeval{$current}		= $array[4] if(defined($array[4]));
			$fielddispcolumn{$current}	= defined($array[5])?$array[5]:"";

			
			#
			# make sure that the location information is correct when
			# sorted with sort and xSort (and ASCII-compared...)
			while(defined($fielddispcolumn{$current}) && length($fielddispcolumn{$current}) < 5) {
				$fielddispcolumn{$current}	= "0".$fielddispcolumn{$current};
			}

			local($zwerg)	= defined($array[6])?$array[6]:"";
			while(length($zwerg) < 5) { $zwerg  = "0".$zwerg; }
			local($count)	= 0;
			$txtcount	= "000";
			while(defined($fielddisporder{$zwerg.$txtcount.$fielddispcolumn{$current}}) && $fielddisporder{$zwerg.$txtcount.$fielddispcolumn{$current}}) {
				$count++;
				$txtcount = $count;
				while(length($txtcount) < 3) {  $txtcount   = "0".$txtcount; }
			}

			$fielddisporder{$zwerg.$txtcount.$fielddispcolumn{$current}}	= $current;
		}
	}
}


sub getVirtualFields {
	#
	# This routine scans the table virtual for virtual fields that belong to $table
	# and evaluates the xequation fields of their records to store their values
	# into the %values array.
	# if the's any error during this request we simply ignore it
	$comm		= "SELECT fieldname,fieldtype,xequation FROM virtual WHERE tablename='$table' ORDER BY xlevel"; #rl
	$vfields	= $dbdconn->prepare($comm); #rl
	$vfields->execute || $log->debug("could not get Virtual Fields. SQL Error:$DBI::errstr");
	if($vfields) {
		while(@array = $vfields->fetchrow_array) {
			$current		= $array[0];			#rl
			$fieldtype{$current}	= "virtual " . $array[1];	#rl
			$expression		= $array[2];			#rl
			$values{$current}	= eval ($expression);		#rl

			#
			# if there's an error during the evaluation we set our 
			# virtual fields  contents to the error message
			unless($values{$current}) {
				$log->debug("Error in virtual field $current :<BR>\n$@");
				$values{$current} = "<H4><FONT COLOR=BLACK><P>Error in virtual field $current :<BR>\n" . $@ . "</FONT></H4>";
				$log->debug("Error in virtual field $current: $@");
			}
		}
	}
} # getVirtualFields


# This subroutine, called by &plainDialog(), sets the %values hash and the $data_relations arrayref.
sub fillValues {
	#
	# if there is a valid $oid try to fetch that record from $table
	# and copy it's contents into %values
	# Determine the uniqOID if not already defined
	$uniqOID = &db_getUniqOIDField($dbconn, $table) unless ($uniqOID);
	if ($oid) {
		$cmd	= "SELECT $table.* FROM $table WHERE $uniqOID='$oid'";
		$log->debug("$cmd") if($debug);
		$prep=$dbconn->prepare($cmd);		#rl
		$prep->execute;				#rl
		$result=$prep->fetchrow_hashref;	#rl
		&dBaseError($result, $cmd) if(!defined($result));

		$column = 0;
		%values=%{$result};

		#
		# we'll have to calculate a fake xmin ...
		$prep->execute;
		@row	= $prep->fetchrow_array;
		$xmin	= checksum(@row);
		$values{xmin} = $xmin;

		#
		# then add the contents of any defined virtual fields
		&getVirtualFields;

		#
		# we'll have to strip any trailing spaces...
		foreach $key (keys %values) {
			$values{$key} = xChop($values{$key});
		}


		#
		# now we try to fetch relation records for $table
		# and store them in $relations
		$relations = $dbdconn->prepare("SELECT * FROM relation WHERE parent='$table'");
		$relations->execute();
		while(@array = $relations->fetchrow_array()) {
			$relationtuples = $relationtuples+1;
		}

		$relations->execute();
#		$relations_data = $relations->fetchall_arrayref();
		#
		# returns an array of hash refs
		$relations_data = $relations->fetchall_arrayref({});
		$log->debug("Error retrieving relationship details: $DBI::errstr") if ($relations->err );

	#
	# if there's no oid we'll have to display an empty dialog
	# and therefore reset all our values to ""
	} else {
		foreach $name (keys %fieldtype) {

			#
			# if there's a Perl subroutine specified to
			# set the default value of this field, ask it...
			if($fielddefault{$current}) {
				$values{$name}	= eval ($fielddefault{$name});

			#
			# if we're dependend from a parent table we'll
			# most likely be able to preset a valid reference value...
			} elsif ($name eq $childfield) {
				$values{$name}	= $childpreset;
			} else {
				$values{$name}	= "";
			}
		}
	}

} # fillValues



sub xSort {
	#
	# remove those fields that have a given order from the
	# displayinfo table from our parameter array @in, sort
	# them in the requested display order and return the
	# sorted plus unsorted fields in @out
	local(@in)  = @_;

	local(@out);
	
	foreach $index (sort keys %fielddisporder) {
		push	@out, $fielddisporder{$index};
		@in = xDel ($fielddisporder{$index}, @in);
	}

	push @out, (sort @in);
	@out;
}


sub xDel {
	#
	# delete the element with value $element from
	# the given array @in and return the remaining
	# components in @out
	local ($element, @in) = @_;
	local (@out);

	foreach $name (@in) {
		push @out, $name unless $element eq $name;
	}
	@out;
}


sub maxCols {
	#
	# get the maximum number of columns
	# specified by the displayinfo table
	local ($cols)   = 0;
	local ($name);
	foreach $name (values %fielddispcolumn) {
		$cols = $name if $name > $cols;
	}
	$cols;
}


sub printReminder {
	#
	# print all those fields into our page whose values
	# we might need upon our next call
	local($fieldout)	= @_;
	print MAINFRAME $fieldout->hidden('table', $table) . "\n";
	print MAINFRAME $fieldout->hidden('dbase', $dbase) . "\n";
	print MAINFRAME $fieldout->hidden('dbdesc', $dbdesc) . "\n";
	print MAINFRAME $fieldout->hidden('childfield', $childfield) . "\n";
	print MAINFRAME $fieldout->hidden('childpreset', $childpreset) . "\n";

	if($oid) {
		print MAINFRAME $fieldout->hidden('oid', $oid) . "\n";
		$values{'xmin'} =~ s/ //g, print MAINFRAME $fieldout->hidden('xmin', $values{'xmin'});
		print MAINFRAME $fieldout->hidden('search', $search) . "\n" if($search);
	}
}


sub tablePopup {
	#
	# create a simple HTML popup menu with all the available databases
	local($name) = @_;
	if($dbasetype eq "oracle") {
		$cmd	= "SELECT table_name FROM user_tables ORDER BY table_name";
	} else {
		$cmd	= "SELECT relname FROM pg_class WHERE relkind = 'r' and relname !~ '^pg_' and relname !~ '^Inv' ORDER BY relname";
	}
	$result = $dbconn->prepare($cmd);
	$result->execute;

	#
	# start with the <SELECT tag and add (if any) the real value of the field as first <OPTION>
	local($popup)	= "<SELECT NAME=\"$name\" SIZE=1>\n<OPTION>" . $values{$name} . "\n";
	#

	$popup  .= "<OPTION>\n" if $values{$name};
	# scan all records and add the relnames to the popup unless it's the default option
	while(@array = $result->fetchrow()) {
		$popup	.= "<OPTION>" . $array[0] . "\n" unless(xChop($values{$name}) eq xChop($array[0]));
	}

	$popup . "</SELECT>\n";
}


sub relationPopup {
	#
	# create a simple HTML popup menu that displays all the different values
	# in $relField from table $relTable in the main database
	# IC 2001-11-27 extension
	local($name, $relTable, $relField, $relDispField) = @_;
	$relDispField = $relField if(length($relDispField)<1);
	$cmd	= "SELECT DISTINCT $relField, $relDispField FROM $relTable ORDER BY $relField";
	$res	= $dbconn->prepare($cmd);
	$res->execute || $log->debug("Information for Relation Popup failed: SQL error:$DBI::errstr");

	#
	# start with the <SELECT tag and add (if any) the real value of the field as first <OPTION>
	local($popup, $defpop);
	$defpop = $popup = "";

	#
	# scan all records and add the relnames to the popup unless it's the default option
	while(@array = $res->fetchrow_array) {
		$option_rows++; 
		unless(xChop($values{$name}) eq xChop($array[0])) {
			$popup  .= "<OPTION value=\"".$array[0]."\">" . $array[1] . "\n";
		} else {
			$defpop  = "<OPTION value=\"".$array[0]."\">" . $array[1] . "\n";
		}
	}
	if ($values{$name} && length($defpop)<1) {
		$defpop ="\n<OPTION value=\"".$values{$name}."\">" . $values{$name} . "\n";
		$option_rows++;
	}

	$defpop = $popup = "" unless ($option_rows > 1);
	$popup = "<SELECT NAME=\"$name\" SIZE=1>$defpop$popup<OPTION>\n</SELECT>\n";
}



sub valueListPopup {
	#
	# create a simple HTML popup menu that displays all the values
	# specified in the valuelist table of our display description database for
	# this specific field name
	local($name) = @_;
	$cmd	= "SELECT DISTINCT display,content FROM valuelist WHERE name = '$name' ORDER BY display";
	$result = $dbdconn->prepare($cmd);
	$result->execute || $log->debug("Error creating Value List popup. SQL error$DBI::errstr");

	#
	# start with the <SELECT tag and add (if any) the real value of the field as first <OPTION>
	local($popup)   = "<SELECT NAME=\"$name\" SIZE=1>\n";
	# if valulist has a "display" set, use it
	if ($values{$name}) {
		local($sql) = "SELECT DISTINCT display FROM valuelist WHERE name='$name' and content='$values{$name}'";
		local($res) = $dbdconn->prepare($sql);
		$res->execute() || $log->warn("Error creating Value List popup. SQL error$DBI::errstr");
		local($display) = $res->fetchrow_array();
		$res->finish();
		if ($display) {
			$popup	.= "<OPTION VALUE=$values{$name}>$display\n";
		} else {
			$popup	.= "<OPTION>$values{$name}\n";
		}	
		$popup	.= "<OPTION>\n";
	} else {
		$popup	.= "<OPTION>\n";
	}	

	#
	# scan all records and add the relnames to the popup unless it's the default option
	while(@array = $result->fetchrow_array) {
		# only add current OPTION unless that has been done above
		if ($array[1] ne $values{$name}) {
			$popup .= "<OPTION";
			$popup .= " value=$array[1]" if defined($array[1]);
			$popup .= ">" . $array[0] . "\n" unless(xChop($values{$name}) eq xChop($array[0]));
		}	
	}

	$popup . "</SELECT>\n";
}





sub callDBaseSub {
	#
	# this subroutine expects the name of a perl routine stored in the
	# dbase table equation as first argument, followed by the routines
	# arguments.
	# it then tries to get the routine from our database and to
	# evaluate it.
	# if there occurs any error $@ is set to the error message and
	# undef is returned. Otherwise the routine returns whatever value
	# the last expression of our routine has.
	local($name, @_)	= @_;

	$cmd	= "SELECT content FROM equation WHERE eqname = '$name'";
	$result = $dbdconn->prepare($cmd);
	$result->execute || $log->debug("Could not get equation. SQL Error:$DBI::errstr");
	if($result) {
		unless(@array = $result->fetchrow_array) {
			$@ = "$cmd in dbase $dbase failed ('$name' not found)";
			undef;
		} else {
			local($ret) = eval $array[0];
			$log->debug("Error in DB subroutine $name : <BR>\n $@ ") unless $ret;
			"<H4><FONT COLOR=BLACK><P>Error in DB subroutine " . $name . " : <BR>\n" . $@ . "</FONT></H4>" unless $ret;
		}
	} else {
		$@ = "$cmd in dbase $dbase failed ($dbdconn->errstr)";
		undef;
	}
} # callDBaseSub


sub xChop {
	#
	# this little tool routine removes all spaces from
	# the end of a given string
	local($var) = @_;
	while(($last = chop($var)) eq " ") { };
	$var .= $last;
}

sub connError {
	#
	# print the given $message and the current database
	# error message to STDOUT and die unless the connection is OK
	local($message) = @_;
	if (!defined($dbconn)) {print "<H4><FONT COLOR=BLACK><P>$message<BR>Error: ". $DBI::errstr ."</FONT></H4>"; $log->error("$message ERROR:$DBI::errstr")}
}


sub dBaseError {
	#
	# print the given $message and the current database
	# error message to STDOUT and die 
	local($check, $message) = @_;
	if ($check) {
		print "<H4><FONT COLOR=BLACK><P>$message<BR>Error: ".$check->errstr."</FONT></H4>";
	} else {
		print "<H4><FONT COLOR=BLACK><P>$message<BR>Undefined STH object</FONT></H4>";
	}
	$log->error("Action failed on command:$message  Error_was:$DBI::errstr");
}


sub checksum {
	local(@data)		= @_;
	local($checksum)	= 0;

	while(@data) {
		$field	= pop @data;
		$checksum += unpack("%a*", $field);
	}
	return abs($checksum);
}


sub isReservedWord {
	#
	# return 1 if the given paramter is one of our reserved words
	local($name) = @_;
	local(@reserved) = ("dbase", "table", "oid", "search", "fields", "mode", "xmin", "dbdesc", "childfield", "childpreset", "dbase");

	#
	# corrected IC 2001-11-27
	foreach $word (@reserved) {
		return 1 if($word eq $name);
	}
	return undef;
}


sub local2SQLformat {
	local($var, $field) = @_;
	if($fieldtype{$field} eq "bool") {
		return NULL unless $var;
	} elsif($fieldtype{$field} =~ /float/ || $fieldtype{$field} eq "DECIMAL" || $fieldtype{$field} eq "FLOAT" || $fieldtype{$field} eq "NUMBER") {
		$var  =~ s/\,/\./g;
		$var  = "0.0" unless $var;
		$var .= ".0" unless $var =~ /\./;
	} elsif($fieldtype{$field} eq "date" || $fieldtype{$field} eq "time" || $fieldtype{$field} eq "DATE") {
		return NULL unless $var;
		$var=$dbconn->quote($var);
		return $var; # corrected IC 2001-11-27
	} elsif($fieldtype{$field} eq "int4" || $fieldtype{$field} eq "INTEGER" || $fieldtype{$field} =~ /LONG/) {
		return NULL unless defined $var;
		return $var if $mode eq "search";
	}
	$var=$dbconn->quote($var);
	return "$var" unless $mode eq "search";
	return $var;
}



1;