#!/usr/bin/perl
#
# dbviewer.cgi derived from
# dbengine.cgi alex shevlakov shevl@yahoo.com
#
# Version 1.0 beta
# <c> 1999 Ingo Ciechowski
# see closer information at http://www.cis-computer.com/dbengine
#
# thanx to contributions of
# Jaime Cervera Bravo       <jcervera@aq.upm.es>
# John Goerzen              <jgoerzen@complete.org>
# Werner Modenbach          <modenbach@alc.de>
# Rudolf Lippan             <rlippan@elastic.com>
#


require 5.003;

use CGI;
use DBI;
# use util::LOG;
 use Statistics::Descriptive;


#
# and here are some variables we might want to change...
$debug=1;
# domain of the server where our database lives (PostgreSQL)
$server	= "255.255.2.25";
# port of the database server (PostgreSQL)
$port	= "5432";
# User to access database with (updated by johnbr - 1/11/99)  (PostgreSQL)
$user	= "nobody";"; 
# password (if any) to access the database  (PostgreSQL)
$passwd	= "password";
# name of default database (PostgreSQL) - user/password (Oracle)
$defdb	= "cis";
# name of default database with additional display and relation informations  (PostgreSQL) - user/password (Oracle)
#$descdb	= "cisinfo";
# Oracle TWO_TASK name
$oraTWOTASK	= "";
# Oracle SID
$oraSID	= "CIS";
# Oracle HOME
$oraHOME	= "/opt/oracle/actual/product/8.0.5";
# Absolute UNIX path to document-root directory of your WWW Server
$htdocs	= "/home/clients/director/public_html/";
# Absolute UNIX path to folder where dbengine.cgi lives
$abs_cgi	= "/home/director/directo/public_html/cgi/";
# Absolute UNIX path to folder where template .html files are stored for processing
$templ	= "/home/clients/director/public_html/cgi/";
# Absolute http path to folder for temporary .html files
$tmp	= "/tmp/";
# Absolute http path to folder where dbengine.cgi lives (will be used in temporary .html files)
$cgis	= "/cgi/";
# special behavior if $language eq "german"
 $language	= "russian";
# $language	= "english";
# background color for our generated pages
$bgcol	= "#C4DDFF";


#
# Now we'll define a couple of variables that are used
# to define the look of our generated data pages
$smarttable	= "1";
$headerbgcol	= "#AAAAAA";
$headerbgcol2	= "#DDDDDD";
$headertxtcol	= "#FFFFFF";
$tablebgcol	= "#DDDDBB";
$tablebgcol2	= "#EEEECC";
$tabletxtcol	= "#000000";
$with_stat=0;

#
# we first of all create a new query-CGI and get our
# most essential parameters as follows:
$query      = new CGI;
$starttime  = time();
$newtime    = $query->param('xmin');
$dbase      = $query->param('dbase');# (optional) name of the database to connect

$stringsearch     = $query->param('stringsearch');   

$dbdesc     = $query->param('dbdesc');  # (optional) name of database with all these additional display and relation information
$order      = GetOrderBy($query->param('orderby'));
$table      = $query->param('table');   # (optional) name of the table to use
$old_table  = $query->param('old_table');
$oid        = $query->param('oid');     # (optional) ID of the record to work with
$search     = $query->param('search');  # (optional) SQL statement for a user-chosen selection
$info     = $query->param('info');
$childfield = $query->param('childfield');   # (optional) fieldname of relation field
$childpreset= $query->param('childpreset');  # (optional) preset data for relation field
$mode       = $query->param('mode');    # (optional) working mode for dbengine.cgi as follows
$flag 	    = $query->param('flag');
#$with_stat  = $query->param('with_stat');
                                        #      menu: generates a menu with list of all tables on the fly
                                        #     plain: generates a dialog that allows for entering values to either add new records or search for existing ones
                                        #            if called with $oid set this mode will show the contents of the so given record and allow to update/delete the record
                                        #    delete: ask whether our user really wants to delete the record $oid in $table and $dbase
                                        #   confdel: delete the record $oid in $table and $dbase
                                        #    update: update the record $oid in $table and $dbase with the additional data in $query
                                        #       add: add a new record to $table and $dbase with the additional data in $query
                                        #    search: search all records in $table and $dbase that match the additional data in $query
                                        #     empty: generates an empty page on the fly
$modeX      = $query->param('mode.x');                  # (optional) working mode for dbengine.cgi as follows
                                        #      0-55: plain
                                        #    56-110: add
                                        #   111-165: update
                                        #   166-220: delete
                                        #   221-275: search
$maxwidth   = 45;                       # maximum width of an automatically generated text field
$scriptname = "dbviewer.cgi";
#$debug      = 1;                       # enable output of some debugging infos
$ntuples_all=0;
$ntuples=0;
$f_overflow=0;
$changetable=0;



# choose either oracle or postgresql
# it must be Oracle, when $dbase comes in the form <user>/<password>
if($dbase =~/\//) {
    $dbasetype	= "oracle";
    $uniqOID    = "ROWID";
    eval "use DBD::Oracle qw(:ora_types)";
    $dbase   =~ /\w*\/(\w*)/;
    $passwd  = $1;
    $descdb .= "/".$passwd unless ($descdb =~/\//);
    if(defined($dbdesc)) { $dbdesc .= "/".$passwd unless ($dbdesc =~/\//); }
} else {
	$dbasetype	= "postgres";
	$descdb		=~ s/\/(\w+)//;
	$dbdesc		=~ s/\/(\w+)//;
	$uniqOID    = "oid";
}



#
# rl needs to be deleted so that it does not cause a problem 
# rl with listing all records, but needs a better fix in
# rl list tables to cover the posibility of params that are not
# rl fields in the database.
$query->delete('dbdesc');
$query->delete('orderby');


#$log=new LOG;


if ($language eq "russian") {
    $buttons{'search'}  = "Искать";
    $buttons{'save'}  = "Сохранить";
    $buttons{'savetext'}  = "Сохранить";
    $buttons{'search_with_overflow'} = "Продолжить";
    $buttons{'info'}  = "Инфо";
    $buttons{'plain'}   = "Фильтр";
#    $buttons{'update'}  = "---->";
    $buttons{'undef'}   = "?";
#    $buttons{'mupdate'} = "----> все";
#    $buttons{'delete'}  = "Удалить";
#    $buttons{'confdel'} = "Удалить совсем";
#    $buttons{'add'}     = "Добавить";
    $buttons{'reset'}   = "Заново";
    $buttons{'true'}    = "Да";
    $buttons{'false'}   = "Нет";
    $buttons{'list'}    = "лист";
#    $buttons{'new'}     = "Нов.запись";
#    $buttons{'edit'}    = "Ред.";
    $buttons{'sql'}	= "SQL запрос";
    $buttons{'stat'}	= "Статистика";
    $buttons{'dist'}	= "Значения";
} else {
    $buttons{'search'}  = "search";
    $buttons{'save'}  = "save";
    $buttons{'savetext'}  = "save";
    $buttons{'search_with_overflow'} = "continue";
    $buttons{'info'}  = "info";
    $buttons{'plain'}   = "find";
  #  $buttons{'update'}  = "update";
    $buttons{'undef'}   = "undef";
  #  $buttons{'mupdate'} = "multiupdate";
  #  $buttons{'delete'}  = "delete";
  #  $buttons{'confdel'} = "do remove record";
  #  $buttons{'add'}     = "add";
    $buttons{'reset'}   = "reset form";
    $buttons{'true'}    = "true";
    $buttons{'false'}   = "false";
    $buttons{'list'}    = "list";
  #  $buttons{'new'}     = "new";
  #  $buttons{'edit'}    = "edit";
    $buttons{'sql'}	= "SQL query";
    $buttons{'stat'}	= "Stats";
    $buttons{'dist'}	= "values";
}


#
# let's first of all create a new CGI instance to seperate our 
# input from our output  and print the HTML header to our browser
$output = new CGI('');
print $query->header;

$changetable=1 if $table != $old_table;
$old_table = $table;

	if ($flag) {
		$stringsearch = join(':', split(/ /,$search));
		$stringsearch =~ s/\=/eqlsggnm/;
		$flag=0;
	}
$search = join(' ', split(/:/,$stringsearch));
$search =~ s/eqlsggnm/\=/;

if($dbasetype eq "oracle") {
    $ENV{TWO_TASK}      = $oraTWOTASK if(length($oraTWOTASK)>0);
	$ENV{ORACLE_HOME}   = $oraHOME;
    $ENV{ORACLE_SID}	= $oraSID if(length($oraSID)>0);

	#
	# contact our database server to connect to the database with our data and die properly if this attempt fails...
	$dbase  = $defdb unless $dbase;
	$dbconn=DBI->connect("dbi:Oracle:","$dbase","");
	&connError("could not connect to SID=$oraSID TWO_TASK=$oraTWOTASK User=$dbase *** try $scriptname?dbase='aValidUser/password' ***");

	#
	# contact our databse to connect to the database with additional display information
	# if we can't contact this database we'll have to die :-((
	if($dbdesc) {
		$dbdconn=DBI->connect("dbi:Oracle:","$dbdesc","");
		&connError("could not connect to SID=$oraSID TWO_TASK=$oraTWOTASK User=$dbdesc *** try $scriptname?dbase='aValidUser/password' ***");

	#
	# if there was no additional name specified we try to access the default $descdb database,
	# but if that fails we simply assume that our user wants to store this information in the same database
	} else {
		$dbdconn=DBI->connect("dbi:Oracle:","$descdb","");
 		$dbdconn=$dbconn unless (defined($dbdconn));
		$dbdesc	= $descdb;
	}
} else {
	#
	# contact our database server to connect to the database with our data and die properly if this attempt fails...
	$dbase  = $defdb unless $dbase;

$dbconn=DBI->connect("dbi:Pg:dbname=$dbase;port=$port;host=$server","$user","$passwd");
	&connError("could not connect to $dbase on server $server port $port *** try $scriptname?dbase='aValidDatabaseName' ***");

	#
	# contact our databse to connect to the database with additional display information
	# if we can't contact this database we'll have to die :-((
	if($dbdesc) {
   	 
$dbdconn=DBI->connect("dbi:Pg:dbname=$dbdesc;port=$port;host=$server","$user","$passwd");
    	&connError("could not connect to $dbdesc on server $server port $port *** try $scriptname?dbdesc='aValidDatabaseName' ***");

	#
	# if there was no additional name specified we try to access the default $descdb database,
	# but if that fails we simply assume that our user wants to store this information in the same database
	} else {
	
$dbdconn=DBI->connect("dbi:Pg:dbname=$descdb;port=$port;host=$server","$user", "$passwd");
 		$dbdconn=$dbconn unless (defined($dbdconn));
		$dbdesc	= $descdb;
	}
}


#
# set maximum field length when working with fields of
# unspecified length
$dbdconn->{LongReadLen} = 16384;
$dbconn->{LongReadLen} = 16384;


#
# if there's no $table specified we'll generate
# a framset on the fly that shows a menu and some empty space
unless ($table) {
    if($mode eq "menu") {
        &createMenu ($output);

    } elsif($mode eq "empty") {
        
	if ($language eq "russian"){
	print $output->start_html(-title=>"empty page", -BGCOLOR=>$bgcol);
	local ($phrase) = "Привет!            <BR>";
	$phrase .= "<FONT COLOR=blue>" .`/usr/games/fortune`. "</FONT>";
	print "<H4><FONT COLOR=RED>Добро пожаловать," .$user. "!</FONT></H4><BR>" .$phrase. "<P>
	<BR><P>Для задания условий поиска выберите НАЗВАНИЕ таблицы.";
        print $output->end_html;
	}else{
	print $output->start_html(-title=>"empty page", -BGCOLOR=>$bgcol);
	local ($phrase) = "Hello!                  <BR>";
	$phrase .= "<FONT COLOR=blue>" .`/usr/games/fortune`. "</FONT>";
	print "<H4><FONT COLOR=RED>Welcome," .$user. "!</FONT></H4><BR>"   .$phrase. "<P>
	<BR><P>Choose name of the table in the left frame to begin search.";
        print $output->end_html;
	}
    } else {
        &createMainFrame ($output);

    }

#
# otherwise we'll check the 'mode' argument to find out what to do...
} elsif($mode eq $buttons{'info'} || $mode eq "info") {
    $mode   = "info";
    &infoTable ($output);
    
} elsif($mode eq "empty1") {
        
	print $output->start_html(-title=>"empty page", -BGCOLOR=>$bgcol);	
        print $output->end_html;

} elsif($mode eq $buttons{'search'} || $mode eq "search") {
    
    $mode   = "search";
    &listTable ($output);

} elsif($mode eq $buttons{'save'} || $mode eq "save") {
    $mode   = "save";
    &saveTable ($output);
    
} elsif($mode eq $buttons{'savetext'} || $mode eq "savetext") {
    $mode   = "savetext";
    &savetextTable ($output);

} elsif($mode eq $buttons{'demo'} || $mode eq "demo") {
    $mode   = "demo";
    &demo ($output);
    
} elsif($mode eq $buttons{'search_with_overflow'} || $mode eq "search_with_overflow") {
    $mode   = "search_with_overflow";
    $f_overflow=1;
    &listTable ($output);
} elsif($mode eq $buttons{'dist'} || $mode eq "dist") {
    $mode   = "dist";
    &distTable ($output);    
#
# generate a dialog that allows for entering values to either add new records or search for existing ones
} elsif($mode eq $buttons{'plain'} || $mode eq "plain" ) {
     &frame_plainDialog ($output);

} elsif($mode eq $buttons{'frame'} || $mode eq "frame" ) {
     &plainDialog ($output);
     
} elsif($mode eq $buttons{'sql'} || $mode eq "sql" ) {
	
     &sqlDialog ($output);

} elsif($mode eq $buttons{'stat'} || $mode eq "stat" ) {

     $with_stat = 1;
     &sqlDialog ($output);

# finally give our caller a hint that he made an error...
} else {
    print $output->start_html(-title=>"empty page", -BGCOLOR=>$bgcol);
    print "<H4><FONT COLOR=BLACK><P>$scriptname called with illegal arguments:</H4>\n\n<TABLE BORDER CELLSPACING=0 CELLPADDING=5>\n";
    @names  = $query->param;
    foreach $name (sort @names) {
        print "<TR><TD>$name<TD>" . $query->param($name) . "\n";
    }
    print "</TABLE>\n";
    print $output->end_html;
}

$dbconn->disconnect;
$dbdconn->disconnect;
exit;



##################################################################



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) = @_;

    #
    # since there's no modification time in oracle, we read the whole
    # row and calculate a checksum instead
    if($dbasetype eq "oracle") {
		$comm = "SELECT * FROM $table WHERE $uniqOID='$oid'";
	} else {
		$comm = "SELECT xmin FROM $table WHERE $uniqOID='$oid'";
	}
    $result = $dbconn->prepare($comm) ;
    $result->execute;

    if($dbasetype eq "oracle") {
    	@row	= $result->fetchrow_array;
    	$xmin	= checksum(@row);
    } else {
	    $xmin   = $result->fetchrow_array();
	    $xmin   =~ s/ //g;
	}
    &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);
        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;
    }
}


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>";
            die("Error in field: $name:$@ ");
        }
    }
    $content;
}


sub listTable {

    #
    # let's generate a list with all records in $table
    # beginning with the headline of our window
    local($out) = @_;

    &getFieldTypes($table); 
    &getTableDesign($table);
    
    $fields = "$table.*" unless($fields);



    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... 
                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 . " ~* ". $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 {
		if($query->param($name) =~ /\>(.*)/) {
                        $suche  .= $name . " > " . &local2SQLformat($1, $name) . " AND " ;               #rl Remove?
                        
                    }elsif ($query->param($name) =~ /\<(.*)/) {
                        $suche  .= $name . " < " . &local2SQLformat($1, $name) . " AND " ;
		    }else {
                    $number     =  $query->param($name);
                    $suche  .= $name . " = " . &local2SQLformat($number, $name) . " AND " ;
		    }
                }
            }
        }

        #
        # wenn wir keine echten Sucheingaben gefunden haben, dann
        # entf┼llt auch der WHERE-Clause in der SQL-Abfrage
        if($suche eq "WHERE ") {
            $suche  = "";
        
        #
        # sonst m÷ssen wir hat das letzte "AND " wegschmeissen...
        } 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;
            }
        }
        $search = "SELECT $uniqOID, $fields FROM $table $suche";
    }
    
unless ($search =~ m/distinct/i) {    
#---------------Доступна только команда SELECT
 $bubu=substr($search,0,6);
 if (($bubu ne "SELECT" && $bubu ne "select")|| $search =~ m/ into /i) 
 {
  if ($language eq "russian") {
  print "<p>Ваш запрос:<B>" .$search. "</B> задан неверно: Вы можете использовать
  только команду SELECT. Выполнен по умолчанию.";
  }else{
  print "<p>Your query:<B>" .$search. "</B> You can only use SELECT command. (executing by default)";
  }
  $search = "SELECT $uniqOID, $fields FROM $table";
 }
 unless ($search =~ m/ where /i || $search =~ m/ group by /i) {
 if ($language eq "russian") {
 print "<p>Ваш запрос:<B>" .$search. "</B> не содержит WHERE/GROUP BY. Выполнен по умолчанию.<p>";
 }else{
 print "<p>Your query:<B>" .$search. "</B> does not include WHERE/GROUP BY clase. (executing by default)<p>";
 }
 $search = "SELECT $uniqOID, $fields FROM $table";
 }
#--------------

$search =~ s/where/WHERE/i;
$search =~ s/from/FROM/i;
$search =~ s/select/SELECT/i;

    unless ($search =~ m/[ ,]$uniqOID[ ,]/ || $search =~ m/ group by /i) {
    ($chunk,$rmndr) = split ("SELECT", $search);
    ($fields,$rmndr) = split ("FROM", $rmndr);
    $fields = "$uniqOID, $fields";
    $search = join (' ',"SELECT",$fields,"FROM",$rmndr);
    }
}    
    #
    # now lets ask the database...
    #----------------
    #----Добавлена строка "Выбрано % записей из %." Для этого ntuples_all узнаем до поиска.
    
    $search_all = "SELECT oid from $table";
    $listResult=$dbconn->prepare_cached($search_all);
    $listResult->execute || die("Search Failed SQL command:$search");
#$listResult->execute;
    $ntuples_all=$listResult->rows;
    
    $listResult=$dbconn->prepare($search);
    $listResult->execute || die("Search Failed SQL command:$search");
#$listResult->execute;
    @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) {
#        $oid=${${$listResult_data}[0]}[0];              
#        $mode   = "plain";
#        &plainDialog ($out);
#        exit;

#    } else {
    
	
	$stringsearch=join(':',split(/ /,$search));
	$stringsearch =~ s/\=/eqlsggnm/;
	
	#print "$stringsearch - stringsearch, $search - search!";
	if ($language eq "russian") {
	print "Сохранить в формате <A HREF=\"$scriptname?mode=save&dbase=$dbase&table=$table&stringsearch=$stringsearch \" TARGET=body>" .
	"HTML " . "</A>/ 
	<A HREF=\"$scriptname?mode=savetext&dbase=$dbase&table=$table&stringsearch=$stringsearch \" TARGET=body>"
	."простой техт". "</A>\n";
	}else{
	print "Save as <A HREF=\"$scriptname?mode=save&dbase=$dbase&table=$table&stringsearch=$stringsearch \" TARGET=body>" .
	"HTML " . "</A>/ 
	<A HREF=\"$scriptname?mode=savetext&dbase=$dbase&table=$table&stringsearch=$stringsearch \" TARGET=body>"
	."plain text". "</A>\n";
	}
#	print "<p>(правой кнопкой!)";

     if ( $nfields * $ntuples > 10000 && !$f_overflow) {
    
	print $out->start_html(-title=>"Overflow records of $table:", -BGCOLOR=>$bgcol);
	($title=$table) =~ s/\W|_/ /;
	    $title = lc $title;
        $title =~ s/\b(\w)/\u$1/g;
	if ($language eq "russian") {
	print  "<CENTER><H1>Таблица $title</H1><CENTER>";}else{
        print  "<CENTER><H1>$title List</H1><CENTER>";}
	
	if ($language eq "russian") {
	print "<br> Внимание! По вашему запросу найдено <B>$ntuples</B> из общего числа <B>$ntuples_all</B>.<BR>";
	print "Вывод данного результата в окно браузера может занять драматически много времени. Вы можете сохранить результат 
	запроса в текстовом формате для последующей обработки, уточнить запрос, заново задать фильтры,
	или продолжить вывод результата на экран.<br>";   
	}else{
	print "<br> Whoa! Your query got <B>$ntuples</B> from total <B>$ntuples_all</B>.<BR>";
	print "Putting out these records into the browser frame can take much time. You may choose to continue output, save
	result for further processing, modify the query directly or via filters.<br>";
	}
	#NB ded\" ".($cgis?"TARGET=body":"").">";
        print "<FORM METHOD=POST ACTION=".$cgis."$scriptname ENCTYPE=\"application/x-www-form-urlencoded\" ".($cgis?"TARGET=body":"").">";
        #print "<FORM METHOD=POST ACTION=".$cgis."$scriptname ENCTYPE=\"application/x-www-form-urlencoded\" " .($cgis?"":"").">";
	
	print $out->submit(-name=>'mode', -value=>$buttons{'search_with_overflow'}) . "\n";
	print $out->submit(-name=>'mode', -value=>$buttons{'plain'}) . "\n";
	print $out->submit(-name=>'mode', -value=>$buttons{'sql'}) . "\n";
	print $out->submit(-name=>'mode', -value=>$buttons{'stat'}) . "\n";
	
	#$wahr = "CHECKED";
	#$falsch = "";
	#print "<br>Статистика <INPUT TYPE=radio NAME=\"$nstat\" VALUE=1 $wahr>$buttons{'true'}<INPUT TYPE=radio NAME=\"$nstat\" VALUE=0 $falsch>$buttons{'false'} \n";#.
                        				#"<INPUT TYPE=radio NAME=\"$with_stat\" VALUE=\"\" $undefiniert>$buttons{'undef'} \n";
        
	#print "nstat is $nstat, withstat is $with_stat<br>";
	
        print $out->hidden('stringsearch', $stringsearch) . "\n";
	print $out->hidden('old_table', $old_table) . "\n";
#	print $out->hidden('with_stat', $with_stat) . "\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 "<P>$search<P>" if $debug;

	print $out->endform;
        print $out->end_html;
	
    } else {
        #
        # debug-Ausgabe zur Anzeige unserer Suchbedingung
        print $out->start_html(-title=>"Records of $table:", -BGCOLOR=>$bgcol);

        #
        # now we start our form part 
        ($title=$table) =~ s/\W|_/ /;
	    $title = lc $title;
        $title =~ s/\b(\w)/\u$1/g;
	if ($language eq "russian") {
	print  "<CENTER><H1>Таблица $title</H1><CENTER>";
	print "<br> Число записей <B>$table</B>: выбрано <B>$ntuples</B> из <B>$ntuples_all</B><BR>";
	}else{
        print  "<CENTER><H1>$title List</H1><CENTER>";
	print "<br> Number of records <B>$table</B>: selected <B>$ntuples</B> of <B>$ntuples_all</B><BR>";
	}
	
	
	
	
	#--------------------------

	#--------------------------
	#ded\" ".($cgis?"TARGET=body":"").">";
        print "<FORM METHOD=POST ACTION=".$cgis."$scriptname ENCTYPE=\"application/x-www-form-urlencoded\" ".($cgis?"TARGET=body":"").">";
        #print "<FORM METHOD=POST ACTION=".$cgis."$scriptname ENCTYPE=\"application/x-www-form-urlencoded\" " .($cgis?"":"").">";

	print $out->submit(-name=>'mode', -value=>$buttons{'plain'}) . "\n";
	print $out->submit(-name=>'mode', -value=>$buttons{'sql'}) . "\n";
	print $out->submit(-name=>'mode', -value=>$buttons{'stat'}) . "\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('stringsearch', $stringsearch) . "\n";
	print $out->hidden('table', $table) . "\n";
	print $out->hidden('old_table', $old_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 "<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 = eval ($tableStart);
	    $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 {
            #
            # schalten in der Ausgabe auf einen monospaced Font um
            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>";
            }
        }
        
	 	if($dbasetype eq "oracle") {
        	$comm   = "SELECT * FROM virtual WHERE tablename='$table' ORDER BY xlevel";
        } else {
        	$comm	= "SELECT * FROM virtual WHERE tablename='$table' ORDER BY level";
        }
        $vfields=$dbdconn->prepare($comm);   #rl
#        $vfields->execute || $log->debug("Could not get Virtual Fields. SQL command:$comm");              #rl
        $vfields->execute;
        #
        # 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)) {
                    #XXX not used?? $vfields_data=$vfields->fetchall_arrayref;
                    @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
                        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('dbase');
                $out->delete('oid');
                $out->delete('table');
                $out->delete('mode');
		        $out->append('dbase', $dbase);
		        $out->append('oid', $oid);
		        $out->append('table', $table);
		        $out->append('mode', 'plain');
                $_      = "<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 {
                #
                # wobei wir jeweils eine HREF auf unser modify.cgi mit der Record-ID einbauen
                if ($smarttable == 1) {
#--------------------Убрана возможность редакции.
         #           print "<TR><TD BGCOLOR=".$tablebgcol.">";
                	$oid    = ${${$listResult_data}[$i]}[0];
                	$out->delete('dbase');
                	$out->delete('dbdesc');
                	$out->delete('oid');
                	$out->delete('table');
                	$out->delete('mode');
		        	$out->append('dbase', $dbase);
		        	$out->append('dbdesc', $dbdesc);
		        	$out->append('oid', $oid);
		        	$out->append('table', $table);
		        	$out->append('mode', 'plain');
         #           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('dbase');
                	$out->delete('dbdesc');
                	$out->delete('oid');
                	$out->delete('table');
                	$out->delete('mode');
		        	$out->append('dbase', $dbase);
		        	$out->append('dbdesc', $dbdesc);
		        	$out->append('oid', $oid);
		        	$out->append('table', $table);
		        	$out->append('mode', 'plain');
                    print "<P><A HREF=".$scriptname."?".$out->query_string.">";
                    # bevor wir die in 'fields' gew÷nschten Felder ausgeben
                    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;
     }
#    }
}

sub distTable {

    
    local($out) = @_;

    &getFieldTypes($table); 
    &getTableDesign($table);
    
    $fields = "$table.*" unless($fields);

$search = join(' ',split(/:/, $stringsearch));
$search =~ s/eqlsggnm/\=/;
    
    $listResult=$dbconn->prepare($search);
    $listResult->execute || die("Search Failed SQL command:$search");
#$listResult->execute;
    @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);
    
	
    
	
 	$stringsearch=join(':',split(/ /,$search));
	$stringsearch =~ s/\=/eqlsggnm/;

        print $out->start_html(-title=>"Values", -BGCOLOR=>$bgcol);

        #
        # now we start our form part 
        ($title=$table) =~ s/\W|_/ /;
	    $title = lc $title;
        $title =~ s/\b(\w)/\u$1/g;
	
	if ($language eq "russian") {
	print "<br>$ntuples значений";
	}else{
	print "<br>$ntuples unique";
	}
	
#        print "<P>$search<P>" if $debug;

      
	if ($tableStart) {
#        	$retVal = eval ($tableStart) || $log->debug("Error in field xtablestart of table tabledesign for table $table: $@");
        	$retVal = eval ($tableStart);
	    $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 {
            #
            # schalten in der Ausgabe auf einen monospaced Font um
            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>";
            }
        }
        
	 	if($dbasetype eq "oracle") {
        	$comm   = "SELECT * FROM virtual WHERE tablename='$table' ORDER BY xlevel";
        } else {
        	$comm	= "SELECT * FROM virtual WHERE tablename='$table' ORDER BY level";
        }
        $vfields=$dbdconn->prepare($comm);   #rl
#        $vfields->execute || $log->debug("Could not get Virtual Fields. SQL command:$comm");              #rl
$vfields->execute;
        #
        # 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)) {
                    #XXX not used?? $vfields_data=$vfields->fetchall_arrayref;
                    @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
                        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('dbase');
                $out->delete('oid');
                $out->delete('table');
                $out->delete('mode');
		        $out->append('dbase', $dbase);
		        $out->append('oid', $oid);
		        $out->append('table', $table);
		        $out->append('mode', 'plain');
                $_      = "<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 {

                if ($smarttable == 1) {

                	$oid    = ${${$listResult_data}[$i]}[0];
                	$out->delete('dbase');
                	$out->delete('dbdesc');
                	$out->delete('oid');
                	$out->delete('table');
                	$out->delete('mode');
		        	$out->append('dbase', $dbase);
		        	$out->append('dbdesc', $dbdesc);
		        	$out->append('oid', $oid);
		        	$out->append('table', $table);
		        	$out->append('mode', 'plain');

                    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('dbase');
                	$out->delete('dbdesc');
                	$out->delete('oid');
                	$out->delete('table');
                	$out->delete('mode');
		        	$out->append('dbase', $dbase);
		        	$out->append('dbdesc', $dbdesc);
		        	$out->append('oid', $oid);
		        	$out->append('table', $table);
		        	$out->append('mode', 'plain');
                    print "<P><A HREF=".$scriptname."?".$out->query_string.">";

                    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>";
        }


        print $out->end_html;
}

sub saveTable {

    #
    # let's generate a list with all records in $table
    # beginning with the headline of our window
    local($out) = @_;

    &getFieldTypes($table); 
    &getTableDesign($table);
    
    $fields = "$table.*" unless($fields);

$search = join(' ', split(/:/,$stringsearch));
$search =~ s/eqlsggnm/\=/;    
    
    $search_all = "SELECT * from $table";
    $listResult=$dbconn->prepare_cached($search_all);
    $listResult->execute || die("Search Failed SQL command:$search");
#$listResult->execute;
    $ntuples_all=$listResult->rows;
    
    $listResult=$dbconn->prepare($search);
    $listResult->execute || die("Search Failed SQL command:$search");
#$listResult->execute;
    @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) {
        $oid=${${$listResult_data}[0]}[0];              
        $mode   = "plain";
        &plainDialog ($out);
        exit;

    } else {
    


        # debug-Ausgabe zur Anzeige unserer Suchbedingung
        print $out->start_html(-title=>"Records of $table:", -BGCOLOR=>$bgcol);

        #
        # now we start our form part 
        ($title=$table) =~ s/\W|_/ /;
	    $title = lc $title;
        $title =~ s/\b(\w)/\u$1/g;
	
	
        
	if ($tableStart) {
#        	$retVal = eval ($tableStart) || $log->debug("Error in field xtablestart of table tabledesign for table $table: $@");
        	$retVal = eval ($tableStart);
	    $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 {
            #
            # schalten in der Ausgabe auf einen monospaced Font um
            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>";
            }
        }
        
	 	if($dbasetype eq "oracle") {
        	$comm   = "SELECT * FROM virtual WHERE tablename='$table' ORDER BY xlevel";
        } else {
        	$comm	= "SELECT * FROM virtual WHERE tablename='$table' ORDER BY level";
        }
        $vfields=$dbdconn->prepare($comm);   #rl
#        $vfields->execute || $log->debug("Could not get Virtual Fields. SQL command:$comm");              #rl
        $vfields->execute;
        #
        # 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)) {
                    #XXX not used?? $vfields_data=$vfields->fetchall_arrayref;
                    @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
                        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('dbase');
                $out->delete('oid');
                $out->delete('table');
                $out->delete('mode');
		        $out->append('dbase', $dbase);
		        $out->append('oid', $oid);
		        $out->append('table', $table);
		        $out->append('mode', 'plain');
                $_      = "<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 {
                #
                # wobei wir jeweils eine HREF auf unser modify.cgi mit der Record-ID einbauen
                if ($smarttable == 1) {
#--------------------Убрана возможность редакции.
         #           print "<TR><TD BGCOLOR=".$tablebgcol.">";
                	$oid    = ${${$listResult_data}[$i]}[0];
                	$out->delete('dbase');
                	$out->delete('dbdesc');
                	$out->delete('oid');
                	$out->delete('table');
                	$out->delete('mode');
		        	$out->append('dbase', $dbase);
		        	$out->append('dbdesc', $dbdesc);
		        	$out->append('oid', $oid);
		        	$out->append('table', $table);
		        	$out->append('mode', 'plain');
         #           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('dbase');
                	$out->delete('dbdesc');
                	$out->delete('oid');
                	$out->delete('table');
                	$out->delete('mode');
		        	$out->append('dbase', $dbase);
		        	$out->append('dbdesc', $dbdesc);
		        	$out->append('oid', $oid);
		        	$out->append('table', $table);
		        	$out->append('mode', 'plain');
                    print "<P><A HREF=".$scriptname."?".$out->query_string.">";
                    # bevor wir die in 'fields' gew÷nschten Felder ausgeben
                    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;
    }
}

sub savetextTable {

    #
    # let's generate a list with all records in $table
    # beginning with the headline of our window
    local($out) = @_;

    &getFieldTypes($table); 
    &getTableDesign($table);
    
    $fields = "$table.*" unless($fields);

$search = join(' ', split(/:/,$stringsearch));
$search =~ s/eqlsggnm/\=/;    
    
    $search_all = "SELECT * from $table";
    $listResult=$dbconn->prepare_cached($search_all);
    $listResult->execute || die("Search Failed SQL command:$search");
#    $listResult->execute;   
    $ntuples_all=$listResult->rows;
    
    $listResult=$dbconn->prepare($search);
    $listResult->execute || die("Search Failed SQL command:$search");
#$listResult->execute;
    @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);
    
	
    
        #
        # now we start our form part 
        ($title=$table) =~ s/\W|_/ /;
	    $title = lc $title;
        $title =~ s/\b(\w)/\u$1/g;
	
	
        
	if ($tableStart) {
#        	$retVal = eval ($tableStart) || $log->debug("Error in field xtablestart of table tabledesign for table $table: $@");
        	$retVal = eval ($tableStart);
	    $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 {
            #
            # schalten in der Ausgabe auf einen monospaced Font um

            if ($smarttable == 1) {

                for ($j=1; $j < $nfields; $j++) {
                    if (!defined($fielddisplay{$listResult_fname[$j]}) || $fielddisplay{$listResult_fname[$j]} ne "hidden") {
                        #
                        #rl Header for cols in multiple list
                        if (defined $fielddispstring{$listResult_fname[$j]}) {
                            print "$fielddispstring{$listResult_fname[$j]}\t";
                        } else {
                            printf("%s\t", $listResult_fname[$j]);
                        }
                    }
                }
		print "\n";
            }
        }
        
	 	if($dbasetype eq "oracle") {
        	$comm   = "SELECT * FROM virtual WHERE tablename='$table' ORDER BY xlevel";
        } else {
        	$comm	= "SELECT * FROM virtual WHERE tablename='$table' ORDER BY level";
        }
        $vfields=$dbdconn->prepare($comm);   #rl
#        $vfields->execute || $log->debug("Could not get Virtual Fields. SQL command:$comm");              #rl
        $vfields->execute;
        #
        # 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)) {
                    #XXX not used?? $vfields_data=$vfields->fetchall_arrayref;
                    @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
                        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('dbase');
                $out->delete('oid');
                $out->delete('table');
                $out->delete('mode');
		        $out->append('dbase', $dbase);
		        $out->append('oid', $oid);
		        $out->append('table', $table);
		        $out->append('mode', 'plain');
                $_      = "<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 {
                #
                # wobei wir jeweils eine HREF auf unser modify.cgi mit der Record-ID einbauen
                if ($smarttable == 1) {
#--------------------Убрана возможность редакции.
         #           print "<TR><TD BGCOLOR=".$tablebgcol.">";
                	$oid    = ${${$listResult_data}[$i]}[0];
                	$out->delete('dbase');
                	$out->delete('dbdesc');
                	$out->delete('oid');
                	$out->delete('table');
                	$out->delete('mode');
		        	$out->append('dbase', $dbase);
		        	$out->append('dbdesc', $dbdesc);
		        	$out->append('oid', $oid);
		        	$out->append('table', $table);
		        	$out->append('mode', 'plain');
         #           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") {
                            if (length(${${$listResult_data}[$i]}[$j])>0) {
                                printf("%s\t", ${${$listResult_data}[$i]}[$j]);
                            } else {
				printf("\t");
                            }
                        }
                    }
		print "\n";
                } else {
                	$oid    = ${${$listResult_data}[$i]}[0];
                	$out->delete('dbase');
                	$out->delete('dbdesc');
                	$out->delete('oid');
                	$out->delete('table');
                	$out->delete('mode');
		        	$out->append('dbase', $dbase);
		        	$out->append('dbdesc', $dbdesc);
		        	$out->append('oid', $oid);
		        	$out->append('table', $table);
		        	$out->append('mode', 'plain');
                    print "<P><A HREF=".$scriptname."?".$out->query_string.">";
                    # bevor wir die in 'fields' gew÷nschten Felder ausgeben
                    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) {
            }
        }

#    }
}

sub infoTable {


    local($out) = @_;

    
        
        print $out->start_html(-title=>"Records of $table:", -BGCOLOR=>$bgcol);

    $search_all = "SELECT oid from $table";
    $listResult=$dbconn->prepare_cached($search_all);
    #$listResult->execute || die("Search Failed SQL command:$search");
    $listResult->execute || print ($language ne "russian"?"No access to this table.":"Нет права доступа к данной таблице.");
    $ntuples_all=$listResult->rows;
        #
        # now we start our form part 
        ($title=$table) =~ s/\W|_/ /;
	    $title = lc $title;
        $title =~ s/\b(\w)/\u$1/g;
	if ($language eq "russian") {
	print  "<CENTER><H1>Таблица $title</H1><CENTER>";}else{
        print  "<CENTER><H1>$title Description</H1><CENTER>";}
	
	$filename="/usr/local/pgsql/data/base/$dbase/$table";
	
	print "<table BORDER COLS=2>";
	
	print "<tr>";
	print "<td>".($language ne "russian"?"Number of records":"Число записей")." <B>$table</B>:</td>";
	print "<td>$ntuples_all</td>";
	print "</tr>";
	
	print "<tr>";
	print "<td>".($language ne "russian"?"Owner:":"Владелец:")."</td>";
	print "<td>";
	printf "%s\n", getpwuid ((stat($filename))[4]);
	print "</td>";
	print "</tr>";

	print "<tr>";
	print "<td>".($language ne "russian"?"Last edited:":"Дата последней редакции:")."</td>";
	print "<td>";
	printf "%s\n", scalar localtime ((stat($filename))[9]);
 	print "</td>";
	print "</tr>";
	
	print "<tr>";
	print "<td>".($language ne "russian"?"Other info:":"Дополнительная информация:")."</td>";
	print "<td>";
	if ($language eq "russian") {
	$descfile = "/home/clients/w_tigers/public_html/db/$table.koi";
	} else {
	$descfile = "/home/clients/w_tigers/public_html/db/$table.eng";
	}
	if (-f $descfile) {
	print `cat $descfile`;
	} else {
	print ($language ne "russian"?"none":"нет");
	}
 	print "</td>";
	print "</tr>";
	
	print "</table>";

	
        print "<FORM METHOD=POST ACTION=".$cgis."$scriptname ENCTYPE=\"application/x-www-form-urlencoded\" " .($cgis?"":"").">";
        print $out->submit(-name=>'mode', -value=>$buttons{'plain'}) . "\n";
	print $out->submit(-name=>'mode', -value=>$buttons{'sql'}) . "\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

        # terminate the form and our HTML file
        print $out->endform;
	print "<div align=right><a href=\"/db/db_intro.html#filtr\" TARGET=new>Что такое фильтр?</a><br>";
	print "<a href=\"/db/db_intro.html#sql\"  TARGET=new>Что такое SQL запрос?</a></div>";
        print $out->end_html;

}

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");
    $result->execute;
    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";
    print "<FRAME Name=menu SRC=$scriptname?dbase=$dbase&mode=menu Scrolling=Auto MARGINWIDTH=1>\n";
    print "<FRAME Name=body SRC=$scriptname?dbase=$dbase&mode=empty Scrolling=Auto>\n";
    print "</FRAMESET>\n";
    print "</HTML>\n";
}

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

    print "<HTML><HEAD><TITLE>Table $table</TITLE></HEAD>\n";
    print "<FRAMESET Cols=\"650,*\">\n";
    print "<FRAME Name=plain_frame SRC=$scriptname?dbase=$dbase&table=$table&mode=frame Scrolling=Auto MARGINWIDTH=1>\n";
    print "<FRAME Name=unique SRC=$scriptname?dbase=$dbase&table=$table&mode=empty1 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
		while(<$htdocs$tmp*>) {
			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, ">-");
        $cgis = undef;
    }


    #
    # 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;
            $out->append(-name=>'table',-value=>${${$relations_data}[$i]}[2]); # child-table
            $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]}[3]));
            $out->append(-name=>'childpreset', -value=>xChop($values{${${$relations_data}[$i]}[1]}));
            $out->append(-name=>xChop(${${$relations_data}[$i]}[3]),-value=>xChop($values{${${$relations_data}[$i]}[1]}));
            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>";
    }

}

#----------------Нужен еще один модуль для независимого ввода sql-запроса
sub sqlDialog {
   
    local($out) = @_;
 
    open (MAINFRAME, ">-");
        $cgis = undef;
        &createSQLDialog ($out);

    close MAINFRAME;

}
#------------------------------

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/;
        }

        
        #
        # finally 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);
        }
    }
}


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, -expires=>'now') . "\n";
    ($title=$table) =~ s/\W|_/ /;
    $title = lc $title;
    $title =~ s/\b(\w)/\u$1/g;
    if ($language eq "russian") {
    print MAINFRAME "<CENTER><H1>\u Данные $title</H1><CENTER>";}else{
    print MAINFRAME "<CENTER><H1>\u$title Data</H1><CENTER>";}
    print MAINFRAME "<P>$search<P>" if $debug;

    
    #
    # now we start our form part  
    print MAINFRAME "<FORM METHOD=POST ACTION=".$cgis."$scriptname ENCTYPE=\"application/x-www-form-urlencoded\" ".($cgis?"TARGET=body":"").">";
    
    #
    # start the table with our fields
    print MAINFRAME "<TABLE BORDER CELLSPACING=0 CELLPADDING=5>\n";
    $line   = 0;
    $column = 1;
    foreach $name (xSort(keys %values)) {
        #
        # don't include the last modification date of our record
        unless ($name eq "xmin") {
            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(.*)/) {
                #XXX not used? $actualfieldtype    = $1;
                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*)/) {
                        $arg1 = $1, $arg2 = $2;
                        print MAINFRAME &relationPopup($name, $arg1, $arg2) . "\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
		    
		    $stringsearch="select:distinct:on:$name:$uniqOID:,:$name:from:$table:order:by:$name";
                    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";
			
                    print MAINFRAME "<A HREF=\"$scriptname?mode=dist&dbase=$dbase&table=$table&stringsearch=$stringsearch
		    \" TARGET=unique>" .($language ne "russian"?"what?":"что?"). "</A>\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;
                        $falsch = "CHECKED" if ($values{$name} eq '0'); # || !defined($values{$name}));
                        $undefiniert = "CHECKED" if ($values{$name} ne '1' && $values{$name} ne '0');
                        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)="";
                    #
                    # date fields are shown as is or in language specific format
                    } elsif ($fieldtype{$name} eq "date" || $fieldtype{$name} eq "DATE") {
                        $values{$name}  =~ s/\-/\./g if $language eq "german";
                        print MAINFRAME $query->textfield(-name=>$name, -default=>$values{$name}, -size=>10, -maxlength=>10) . "\n";

                     print MAINFRAME "<A HREF=\"$scriptname?mode=dist&dbase=$dbase&table=$table&stringsearch=$stringsearch \" TARGET=unique>" .($language ne "russian"?"what?":"что?"). "</A>\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";

                     print MAINFRAME "<A HREF=\"$scriptname?mode=dist&dbase=$dbase&table=$table&stringsearch=$stringsearch \" TARGET=unique>" .($language ne "russian"?"what?":"что?"). "</A>\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") {
                        print MAINFRAME $query->textfield(-name=>$name, -default=>$values{$name}, -size=>$maxwidth, -maxlength=>512) . "\n";
		     print MAINFRAME "<A HREF=\"$scriptname?mode=dist&dbase=$dbase&table=$table&stringsearch=$stringsearch \" TARGET=unique>" .($language ne "russian"?"what?":"что?"). "</A>\n";

                    #
                    # all other fields are also shown as text fields
                    } else{
                        print MAINFRAME $query->textfield(-name=>$name, -default=>$values{$name}) . "\n";
                     print MAINFRAME "<A HREF=\"$scriptname?mode=dist&dbase=$dbase&table=$table&stringsearch=$stringsearch \" TARGET=unique>" .($language ne "russian"?"what?":"что?"). "</A>\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>";

        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', '-value'=>'search');   

    print MAINFRAME $query->reset($buttons{'reset'}) . "\n";


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

#--------------------------

sub createSQLDialog {
	
    local($query)   = @_;
    print MAINFRAME $query->start_html(-title=>"table $table c", -BGCOLOR=>$bgcol, -expires=>'now') . "\n";
 
    ($title=$table) =~ s/\W|_/ /;
    $title = lc $title;
    $title =~ s/\b(\w)/\u$1/g;

    $search = join(' ', split(/:/,$stringsearch));
    $search =~ s/eqlsggnm/\=/;
    
    if ($language eq "russian") {
    print MAINFRAME "<CENTER><H1>\u Данные $title</H1><CENTER>";}else{
    print MAINFRAME "<CENTER><H1>\u$title Data</H1><CENTER>";}

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

    &printReminder ($query);
    print "<P>";

print MAINFRAME "<FONT COLOR=RED><B>".($language ne "russian"?"Last query:":"Пред. запрос:")."</B></FONT> ".$search."\n<BR>";
print MAINFRAME "<HR>";
print "<P>";
print MAINFRAME "<B>".($language ne "russian"?"New query:":"Новый запрос:")."</B> <INPUT TYPE=\"text\" NAME=search VALUE=\"$search\" SIZE=64>\n<BR>"; 								


        print MAINFRAME $query->submit(-name=>'mode', -value=>$buttons{'search'}) . "\n";
      
        print MAINFRAME $output->hidden('-name'=>'mode',    
                                        '-value'=>'search');

	
	print MAINFRAME $output->hidden('stringsearch', $stringsearch) . "\n";
	print MAINFRAME $output->hidden('old_table', $old_table) . "\n";
	print MAINFRAME $output->hidden('table', $table) . "\n";
	print MAINFRAME $output->hidden('flag', 1) . "\n";
    	print MAINFRAME $query->reset($buttons{'reset'}) . "\n";
    
#    print "Here $stringsearch";

############################

    &getFieldTypes($table); 
    &getTableDesign($table);
    
    $fields = "$table.*" unless($fields);
    
#print MAINFRAME "<br> fields is $fields";


    #
    # now lets ask the database...
    #----------------
    #----Добавлена строка "Выбрано % записей из %." Для этого ntuples_all узнаем до поиска.

if ($with_stat) {

$search =~ s/where/WHERE/i;
$search =~ s/from/FROM/i;
$search =~ s/select/SELECT/i;

    unless ($search =~ m/[ ,]$uniqOID[ ,]/) {
    ($chunk,$rmndr) = split ("SELECT", $search);
    ($fields,$rmndr) = split ("FROM", $rmndr);
    $fields = "$uniqOID, $fields";
    $search = join (' ',"SELECT",$fields,"FROM",$rmndr);
    }
    #am stupid in perl
    
    $search_all = "SELECT $uniqOID, $fields from $table";
    
#    ($search_all,$rmndr)=split("where",$search) if ($search =~ m/ where /);
    ($search_all,$rmndr)=split("WHERE",$search) if ($search =~ m/ WHERE /);
    $listResult_all=$dbconn->prepare($search_all);
    $listResult_all->execute || die("Search Failed SQL command:$search");
#$listResult_all->execute;
    @listResult_fname_all=@{$listResult_all->{NAME}};
    $listResult_data_all=$listResult_all->fetchall_arrayref;
    $ntuples_all=$listResult_all->rows;
    $nfields_all=$listResult_all->{NUM_OF_FIELDS};
    
    		
    			for ($j=1; $j < $nfields_all; $j++) {
  
                        $name_all = $listResult_fname_all[$j];
                        $align = "RIGHT";
                        $typ_all[$j] = $fieldtype{$name_all};
			
				if ($typ_all[$j] eq "int4" || ($typ_all[$j] eq "float4" || $typ_all[$j] eq "int2")) {
                       
 
					for ($i=0; $i < $ntuples_all; $i++) {
						$data_all[$i]=${${$listResult_data_all}[$i]}[$j];
					}


					$stat_all = Statistics::Descriptive::Full->new();
					$stat_all->add_data(@data_all);
					$sum_all[$j] = $stat_all->sum();
					#$min[$j] = $stat->min();
					#$max[$j] = $stat->max(); 
					$mean_all[$j] = $stat_all->mean();	
	    				#$variance[$j] = $stat->variance();
					#$median[$j] = $stat->median();
					#$stdev[$j] = $stat->standard_deviation();
					#$geom[$j] = $stat->geometric_mean();
					#$harm[$j] = $stat->harmonic_mean();
                		}
		   	}		   
    	
		
    $listResult=$dbconn->prepare($search);
    $listResult->execute || die("Search Failed SQL command:$search");
#    $listResult->execute;
    @listResult_fname=@{$listResult->{NAME}};
    $listResult_data=$listResult->fetchall_arrayref;
    $ntuples=$listResult->rows;
    $nfields=$listResult->{NUM_OF_FIELDS};

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

if ($language eq "russian") {
print MAINFRAME "<HR>";
print MAINFRAME "<B>Статистика по выборке предыдущего запроса:</B><BR>";
print MAINFRAME "(только по числовым полям)";	
print MAINFRAME "<BR> Число записей <B>$table</B>: выбрано <B>$ntuples</B> из <B>$ntuples_all</B><BR>";
}else{
print MAINFRAME "<HR>";
print MAINFRAME "<B>Stats on the last query:</B><BR>";
print MAINFRAME "(numeric fields only)";	
print MAINFRAME "<BR> Number of records <B>$table</B>: selected <B>$ntuples</B> of <B>$ntuples_all</B><BR>";
}

$prcnt=($ntuples/$ntuples_all) * 100 if ($ntuples_all);
printf MAINFRAME ("(".($language ne "russian"?"i.e.:":"т.е.:")."%7.2f \%)<br><p>",$prcnt) if ($ntuples_all);



           print MAINFRAME "<TABLE BORDER=1 WIDTH=100\%><TR>";
		
           print MAINFRAME "<TH BGCOLOR=".$headerbgcol."><FONT COLOR=".$headertxtcol." FACE=\"ARIAL\">";
	   print MAINFRAME "<I>".($language ne "russian"?"STATISTICS":"СТАТИСТИКА")."</I>";
	   print MAINFRAME "</FONT></TH>";
	   
	for ($j=1; $j < $nfields; $j++) {
		
		$name = $listResult_fname[$j];
		$typ = $fieldtype{$name};
		
		if ($typ eq "int4" || ($typ eq "float4" || $typ eq "int2")) {
                    if (!defined($fielddisplay{$listResult_fname[$j]}) || $fielddisplay{$listResult_fname[$j]} ne "hidden") {
                       print MAINFRAME "<TH BGCOLOR=".$headerbgcol."><FONT COLOR=".$headertxtcol." FACE=\"ARIAL\">";
         
                        if (defined $fielddispstring{$listResult_fname[$j]}) {
                            print MAINFRAME $fielddispstring{$listResult_fname[$j]};
                        } else {
                            print MAINFRAME $listResult_fname[$j];
                        }
                        print MAINFRAME "</FONT></TH>";
                    }
		}
	}
                	print MAINFRAME "</TR>";

  
                    for ($j=1; $j < $nfields; $j++) {
  
                        $name = $listResult_fname[$j];
                        $align = "RIGHT";
                        $typ[$j] = $fieldtype{$name};
			
				if ($typ[$j] eq "int4" || ($typ[$j] eq "float4" || $typ[$j] eq "int2")) {
                       
 
					for ($i=0; $i < $ntuples; $i++) {
						$data[$i]=${${$listResult_data}[$i]}[$j];
					}


					$stat = Statistics::Descriptive::Full->new();
					$stat->add_data(@data);
					$sum[$j] = $stat->sum();
					$min[$j] = $stat->min();
					$max[$j] = $stat->max(); 
					$mean[$j] = $stat->mean();	
	    				$variance[$j] = $stat->variance();
					$median[$j] = $stat->median();
					$stdev[$j] = $stat->standard_deviation();
					$geom[$j] = $stat->geometric_mean();
					$harm[$j] = $stat->harmonic_mean();
                		}
		   }
 
#-----------Печатаем статистику
			 print MAINFRAME "<TR><TD BGCOLOR=".$headerbgcol."FONT COLOR=WHITE>";
          		 print MAINFRAME "".($language ne "russian"?"Sum":"Сумма")."</FONT></TD>";
			
			 for ($j=1; $j < $nfields; $j++) {
			 	if ($typ[$j] eq "int4" || ($typ[$j] eq "float4" || $typ[$j] eq "int2")) {
			 		&printCell($sum[$j]);
			 	}
			 }
				print MAINFRAME "</TR>\n";
				
			 print MAINFRAME "<TR><TD BGCOLOR=".$headerbgcol2."FONT COLOR=WHITE>";
          		 print MAINFRAME "".($language ne "russian"?"in \% of total ":"Т.ж. в \% от общ. ")."</FONT></TD>";
			
			 for ($j=1; $j < $nfields; $j++) {
			 	if ($typ[$j] eq "int4" || ($typ[$j] eq "float4" || $typ[$j] eq "int2")) {
			 		&printCell2(($sum[$j]/$sum_all[$j]) * 100) if ($sum_all[$j]) ;
					#&printCell2($sum_all[$j]);
			 	}
			 }
				print MAINFRAME "</TR>\n";
				
			 print MAINFRAME "<TR><TD BGCOLOR=".$headerbgcol."FONT COLOR=WHITE>";
          		 print MAINFRAME "".($language ne "russian"?"Mean":"Среднее")."</FONT></TD>";
			
			 for ($j=1; $j < $nfields; $j++) {
			 	if ($typ[$j] eq "int4" || ($typ[$j] eq "float4" || $typ[$j] eq "int2")) {
			 		&printCell($mean[$j]);
			 	}
			 }
				print MAINFRAME "</TR>\n";
				
			 print MAINFRAME "<TR><TD BGCOLOR=".$headerbgcol2."FONT COLOR=WHITE>";
          		 print MAINFRAME "".($language ne "russian"?"in \% of total ":"Т.ж. в \% от общ. ")."</FONT></TD>";
			
			 for ($j=1; $j < $nfields; $j++) {
			 	if ($typ[$j] eq "int4" || ($typ[$j] eq "float4" || $typ[$j] eq "int2")) {
			 		&printCell2(($mean[$j]/$mean_all[$j]) * 100) if ($mean_all[$j]);
			 	}
			 }
				print MAINFRAME "</TR>\n";
				
			
			 print MAINFRAME "<TR><TD BGCOLOR=".$headerbgcol."FONT COLOR=WHITE>";
          		 print MAINFRAME "".($language ne "russian"?"Minimum":"Минимум")."</FONT></TD>";
			
			 for ($j=1; $j < $nfields; $j++) {
			 	if ($typ[$j] eq "int4" || ($typ[$j] eq "float4" || $typ[$j] eq "int2")) {
			 		&printCell($min[$j]);
			 	}
			 }
				print MAINFRAME "</TR>\n";
				
			 print MAINFRAME "<TR><TD BGCOLOR=".$headerbgcol."FONT COLOR=WHITE>";
          		 print MAINFRAME "".($language ne "russian"?"Maximum":"Максимум")."</FONT></TD>";
			
			 for ($j=1; $j < $nfields; $j++) {
			 	if ($typ[$j] eq "int4" || ($typ[$j] eq "float4" || $typ[$j] eq "int2")) {
			 		&printCell($max[$j]);
			 	}
			 }
				print MAINFRAME "</TR>\n";
				
				
			 print MAINFRAME "<TR><TD BGCOLOR=".$headerbgcol."FONT COLOR=WHITE>";
          		 print MAINFRAME "".($language ne "russian"?"Variance":"Дисперсия")."</FONT></TD>";
			
			 for ($j=1; $j < $nfields; $j++) {
			 	if ($typ[$j] eq "int4" || ($typ[$j] eq "float4" || $typ[$j] eq "int2")) {
			 		&printCell($variance[$j]);
			 	}
			 }
				print MAINFRAME "</TR>\n";
			 print MAINFRAME "<TR><TD BGCOLOR=".$headerbgcol."FONT COLOR=WHITE>";
          		 print MAINFRAME "".($language ne "russian"?"Median":"Медиана")."</FONT></TD>";
			
			 for ($j=1; $j < $nfields; $j++) {
			 	if ($typ[$j] eq "int4" || ($typ[$j] eq "float4" || $typ[$j] eq "int2")) {
			 		&printCell($median[$j]);
			 	}
			 }
				print MAINFRAME "</TR>\n";
				
			 print MAINFRAME "<TR><TD BGCOLOR=".$headerbgcol."FONT COLOR=WHITE>";
          		 print MAINFRAME "".($language ne "russian"?"St.deviation":"Ст.отклонение")."</FONT></TD>";
			
			 for ($j=1; $j < $nfields; $j++) {
			 	if ($typ[$j] eq "int4" || ($typ[$j] eq "float4" || $typ[$j] eq "int2")) {
			 		&printCell($stdev[$j]);
			 	}
			 }
			 print MAINFRAME "</TR>\n";
			 
			 #print MAINFRAME "<TR><TD BGCOLOR=".$headerbgcol."FONT COLOR=WHITE>";
          		 #print MAINFRAME "Геом.среднее</FONT></TD>";
			
			 #for ($j=1; $j < $nfields; $j++) {
			 	#if ($typ[$j] eq "int4" || ($typ[$j] eq "float4" || $typ[$j] eq "int2")) {
			 		#&printCell($geom[$j]);
			 	#}
			 #}
			 #print MAINFRAME "</TR>\n";
			 
			 #print MAINFRAME "<TR><TD BGCOLOR=".$headerbgcol."FONT COLOR=WHITE>";
          		 #print MAINFRAME "Гарм.среднее</FONT></TD>";
			
			 #for ($j=1; $j < $nfields; $j++) {
			 	#if ($typ[$j] eq "int4" || ($typ[$j] eq "float4" || $typ[$j] eq "int2")) {
			 		#&printCell($harm[$j]);
			 	#}
			 #}
			 #print MAINFRAME "</TR>\n";
			 
                print MAINFRAME "</TABLE>";
 
}
###############################
    #
    # terminate the form and our HTML file
    print MAINFRAME $query->endform;
    print MAINFRAME $query->end_html;
}

#--------------------

sub printCell {
print MAINFRAME "<TD BGCOLOR=".$tablebgcol." ALIGN=".$align."><FONT COLOR=".$tabletxtcol." FACE=\"ARIAL\">";
    if (length(@_)>0) {
           printf MAINFRAME ("%7.3f",@_);
    } else {
           print MAINFRAME "&nbsp";
    }
print MAINFRAME "</FONT></TD>";
}

sub printCell2 {
print MAINFRAME "<TD BGCOLOR=".$tablebgcol2." ALIGN=".$align."><FONT COLOR=".$tabletxtcol." FACE=\"ARIAL\">";
    if (length(@_)>0) {
           printf MAINFRAME ("%7.2f",@_);
    } else {
           print MAINFRAME "&nbsp";
    }
print MAINFRAME "</FONT></TD>";
}

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) = @_;
    $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
    local($name, $relTable, $relField) = @_;
    $cmd    = "SELECT DISTINCT $relField FROM $relTable ORDER BY $relField";
    $res    = $dbconn->prepare($cmd);
#    $res->execute || $log->debug("Information for Relation Popup failed: SQL error:$DBI::errstr");
    $res->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>" ;
    if ($values{$name}) {$popup .="\n<OPTION>" . $values{$name} . "\n";}

    #
    # scan all records and add the relnames to the popup unless it's the default option
    while(@array = $res->fetchrow_array) {
	    $option_rows = $option_rows+1; 
        $popup  .= "<OPTION>" . $array[0] . "\n" unless(xChop($values{$name}) eq xChop($array[0]));
    }
    $popup .= "<OPTION>\n" if ($option_rows > 1);
    $popup . "</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 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");
    $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_array) {
        $popup  .= "<OPTION>" . $array[0] . "\n" unless(xChop($values{$name}) eq xChop($array[0]));
    }

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


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 "russian"?"Tables of":"Таблицы базы")." $dbase:", -BGCOLOR=>$bgcol);
    print "<a href=\"/db.html\" TARGET=main>".($language ne "russian"?"databases":"список БД")."</a>";
    print "<H5>".($language ne "russian"?"Tables of":"Таблицы базы")." $dbase</H5><P>";

    #
    # now we ask $dbase for its tables
	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);   #rl
    $result->execute;                #rl

    #
    # and print a HREF for every record
    while(@array = $result->fetchrow_array) {
        ($table_name=$array[0]) =~ s/\W|_/ /o;
        $table_name = lc $table_name;
        $table_name =~ s/\b(\w)/\u$1/go;
#        print "<P><H4><A HREF=\"$scriptname?mode=plain&dbase=$dbase&table=" . $array[0] . "\" TARGET=body>[" . $table_name . "]</A>";
#        print "&nbsp;<A HREF=\"$scriptname?mode=info&dbase=$dbase&table=" . $array[0] . "\" TARGET=body>" . "$buttons{'info'}" . "</A></H4>\n";
        print "<P><H4><A HREF=\"$scriptname?mode=info&dbase=$dbase&table=" . $array[0] . "\" TARGET=body>[" . $table_name . "]</A>";
#	print "&nbsp;<A HREF=\"$scriptname?mode=search&dbase=$dbase&table=" . $array[0] . "\" TARGET=body>" . "$buttons{'list'}" . "</A></H4>\n";

    }

    print $out->end_html;
}


sub getFieldTypes {

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

	#
    # we request a list of all fieldnames, types and displayinfos for $table
    # the result then is stored in the ass. arrays %fieldtype, %fieldlength,
    # %fielddisplay, %fielddispstring, %fielddisporder, %fielddispcolumn, %fielddefault and %fieldeval
    # %fieldtype    = %fieldlength  = %fielddisplay =   %fielddispstring    =   %fielddisporder =   %fielddispcolumn    =   %fielddefault   =   %fieldeval  = undef;
 	if($dbasetype eq "oracle") {
	    $comm  = "select column_name, data_type, data_length from user_tab_columns where table_name = '$table'";
 	} else {
	    $comm  = "SELECT a.attname, t.typname, a.attlen, a.atttypmod FROM pg_class c, pg_attribute a, pg_type t  WHERE c.relname = \'$table\'";
	    $comm .= " and a.attnum > 0 and a.attrelid = c.oid and a.atttypid = t.oid";
	}
	$fieldresult=$dbconn->prepare($comm);             #rl
    $fieldresult->execute;                            #rl


    #
    # lets build our ass. arrays now
    while(@array = $fieldresult->fetchrow_array()) {
        $fieldtype{$array[0]}   = $array[1];  #rl 
        $fieldlength{$array[0]} = $array[2];  #rl
        $fieldlength{$array[0]} = $array[3]-4 if($fieldtype{$array[0]} eq "bpchar" && $dbasetype ne "oracle") ;
#		$dbconn->bind_param($idx, $value, { ora_type=>ORA_CLOB, ora_field=>$array[0] }) if($fieldtype{$array[0]} eq "CLOB" && $dbasetype eq "oracle");
	}
    &dBaseError($fieldresult, $comm."  (".$fieldresult->rows()." rows found)") if($fieldresult->rows() == 0);
    $fieldresult->execute;

    #
    # 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");
	$result->execute;
    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 fillValues {
    #
    # if there is a valid $oid try to fetch that record from $table
    # and copy it's contents into %values
    if ($oid) {
    	if($dbasetype eq "oracle") {
   	    	$cmd    = "SELECT * FROM $table WHERE $uniqOID='$oid'";
    	} else {
   	    	$cmd    = "SELECT xmin, $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 for Oracle...
    	if($dbasetype eq "oracle") {
    		$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
        # $qtable=$dbdconn->quote($table);
        $relations = $dbdconn->prepare("SELECT * FROM relation WHERE parent='$table'");
        $relations->execute();
        while(@array = $relations->fetchrow_array()) {
            $relationtuples = $relationtuples+1;
        }
		#$log->info("tuples: ". "SELECT * FROM relation WHERE parent='$table'" . $relationtuples);
		$relations->execute();
        $relations_data = $relations->fetchall_arrayref();
 
    #
    # 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}  = "";
            }
        }
    }

}


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
 	if($dbasetype eq "oracle") {
	    $comm       = "SELECT fieldname,fieldtype,xequation FROM virtual WHERE tablename='$table' ORDER BY xlevel"; #rl
	} else {
	    $comm       = "SELECT fieldname,fieldtype,xequation FROM virtual WHERE tablename='$table' ORDER BY level"; #rl
	}
	$vfields    = $dbdconn->prepare($comm); #rl
#    $vfields->execute || $log->debug("could not get Virtual Fields. SQL Error:$DBI::errstr");
    $vfields->execute;
    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: $@");
            }
        }
    }
}


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");
    $result->execute;
    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;
    }
}


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>";die("$message ERROR:$DBI::errstr")}
}


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


sub GetOrderBy {
    $orderby=$_[0];
    if ($orderby) {
        # a check for validity of data should go here;
        $order = "ORDER BY $orderby";
    } else {
        $order='';
    }
    return $order;
}


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");
	if(grep /$name/, @reserved) {
		return 1;
	} else {
		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") {
        $var=$dbconn->quote($var);
        return NULL unless $var;
    } elsif($fieldtype{$field} eq "int4" || $fieldtype{$field} eq "INTEGER" || $fieldtype{$field} =~ /LONG/) {
        return NULL unless defined $var;
        return $var if $mode eq "search";
#        $var = ($var ne '') ? "'$var'" : NULL;
    }
	$var=$dbconn->quote($var);
    return "$var" unless $mode eq "search";
    return $var;
}

sub demo {
print "Вы нажали кнопку!";
}