#!/usr/bin/perl
#$CONFIG_DIR = '/usr/local/etc/httpd/wdb';
$CONFIG_DIR = '/u/3/megera/WWW/conf';
$CONFIG_FILE = 'wdb-p95-1.0.conf';
#$debug = 1;
#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#.IDENTIFICATION  wdb-p95
#.LANGUAGE    Perl script which uses Pg.pm
#
#.PURPOSE     WWW Database Interface.
#
#.AUTHOR      Bo Frese Rasmussen [ST-ECF]   <bfrasmus@eso.org>
#             Doug Dunlop [EOL/ISTS] <dunlop@eol.ists.ca>
#
#.VERSION   1.0 14/06-1994  Creation
#.VERSION   1.1 11/10-1994  The following bugs where fixed :
#                   Query on 0 was ignored.
#                   Range query (..) f...ed up subsequent
#                   queries in the same form.
#                   Range queries on datatime fields didn't
#                   work.
#                   
#                   Dateformat config. option added.
#
#.VERSION   1.2 30/12-1994  Support for spec. null values added.
#                   'add_menu' function to allow extra menu
#                   options to be added from fdf.
#                   Fixed bug with continuation lines for
#                   field attributes.
#                   
#.VERSION   1.3a1   03/03-1995     'sameline' field attribute
#                      added.
#                      'html' field attribute added.
#                      Perl5 compatible.
#                      Query on computed fields. 
#                      Uses single quotes rather than
#                      double quotes around strings.
#
#.VERSION   1.3a2p  03/03-1995  Customized for use with Postgres95.
#
#.VERSION   1.4a1   10/11-1995  Modified to work with Postgres95 v1.0
#
#.VERSION   1.4.a2  10/25-1995  Added the ability to sort and page
#                   
#.VERSION   1.4.a3  11/02-1995  Exclusive use of CGI.pm for parameters;
#                               column sorts by header click; defined
#                               wdb_new_ and wdb_undef_ parameters.
#.VERSION   1.4.a4  11/14-1995  Changed to use new config file names
#.VERSION   1.4.b1  11/28-1995  More enhancements
#.VERSION   1.4.b2  11/30-1995  Fixed a bug in hidden field handling
#                               and added force_select attribute.          
#                   
#.COPYRIGHT (see end of file)
#------------------------------------------------------------------------------
$version       = "wdb-p95 v1.4b1(+patch)";
$rel_date      = "Jul-01-1996";
$short_version = "1.4";

#-------------------------------------------------------
# Prepare STDOUT and STDERR
#-------------------------------------------------------
open(STDERR,">&STDOUT") || die "Can't dup stdout: $!\n";
select(STDERR); $| = 1; # Make unbuffered.
select(STDOUT); $| = 1; # Make unbuffered.

#-------------------------------------------------------
# CGI library must be on the perl library path
#-------------------------------------------------------
use CGI;

$wdb_query = new CGI;
print $wdb_query->header;

### DEBUG ###
if ( $debug ) {
  print "<HR><h2>Variables from form</h2>\n";
  print $wdb_query->dump, "<HR><p>\n";
  print $wdb_query->query_string, "<HR><p>\n";
}
##############

#-------------------------------------------------------
# Get local configuration parameters.
#-------------------------------------------------------
if ( -f "$CONFIG_DIR/$CONFIG_FILE" ) {
 do "$CONFIG_DIR/$CONFIG_FILE" || die "Error reading configuration file
    $CONFIG_DIR/$CONFIG_FILE: $@\n";
} else {
    die "Configuration file '$CONFIG_DIR/$CONFIG_FILE' not found ?\n";
}

#------------------------------
# Parse info from Web Client
#------------------------------
( $void , $dbdir, $formname, $action ) = split( '/', $wdb_query->path_info(), 5 );

$WDB = ( $ENV{'SCRIPT_NAME'} ) ? $ENV{'SCRIPT_NAME'} : "/cgi-bin/wdb";

#-------------------------------------------------------------------------
# DEBUG stuff...
# If your are making changes to the wdb script you might find it usefull
# to have a test/development version and an installed version. Set the
# variable $debug in your configuration file.
# This will enable some extra debug output to be printed in the HTML
# pages and in a debug file. If you are making changes to wdb, please
# let me know.
#-------------------------------------------------------------------------
if ( $debug ) {
    if ( $action eq "form" ) { 
    open(DEBUG,"> $debugfile");
    printf DEBUG "*** $version : $dbdir / $formname ".`date`." ***\n\n";
    } else {
    open(DEBUG,">> $debugfile");
    }
    select(DEBUG); $| = 1; # Make unbuffered.
    select(STDOUT);

    foreach $env ( sort keys(%ENV) ) {
    printf DEBUG "$env = $ENV{$env}\n";
    }
}

#---------------------
# Main() ...
#---------------------
&ParseFile("$formdir/$dbdir/$formname.fdf");

&PrepareParams();

### DEBUG ###
if ( $debug ) {
  print "<HR><h2>Variables from form</h2>\n";
  print $wdb_query->dump, "<HR><p>\n";
}
##############

#------------------------------------------------
# Decide what to do and then do it
#------------------------------------------------
if ( $action eq "form" ) {
    &PrintForm;

} elsif ( $action eq "query" || $action eq "default") {
    &DoQuery;

} else {
    print $helptext;
    print "Unknown action in PATH_INFO\n";
    exit 2;
}
exit 1;

#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#.PURPOSE   Parse a form definition file ('fdf' file)
#
#.REMARKS
#
#.RETURNS   True, or not at all ....
#------------------------------------------------------------------------------
sub ParseFile 
{
  local( $file ) = @_;

  open( FDF, $file ) || die "Can't open $file: $!\n";

  $lineno = 0;
  while ( <FDF> ) {     
    $lineno++;

    #-----------------------------------------------------------------
    # Parse a line of the form : "key=value". Comments and unnessesary
    # blanks are skipped. (blanks in the middel of values are kept!)
    # The key should start at the 1. character on the line - lines 
    # starting with whitespace are interpreted as continuation lines.
    #-----------------------------------------------------------------
    next if /^#.*$/;
    ($key, $void, $val) = /^(\w+)\s*(=\s*((\s*\".*\"|\s*[^#\s\n]+)+))?\s*(#.*)?$/;
      # /^(\w+)\s*(=\s*((\s*[^#\"\s\n]+|\s*\".*\")+))?\s*(#.*)?$/;

    if ( ! $key ) {   # Continuation line ...
      ($val) = /^\s*((\s*[^#\s\n]+)+)\s*(#.*)?$/;
      next unless $val;
      if ( $old_attr_type eq 'form' ) {
        $form{$old_attr_key} .= "\n$val";
      } else {
        $field{$old_attr_key} .= "\n$val";
      }
      next;
    }

    #--------------------------------------------------
    # Begining of a new FIELD definition ?
    #--------------------------------------------------
    if ( $key eq "FIELD" ) {
      if ( $current ) {   # If not first field, check old field
        if ( ! $field{$current,'label'} ) {
          $field{$current,'label'} = $current;
        }
      }
      $current = $val;
      push( @fields, $val );
      next;
    }

    #--------------------------
    # Is it a FORM attribute ?
    #--------------------------
    if ( ! $current ) {   # Defs' before first field are form defs'
      $form{$key} = $val; 
      $old_attr_key = $key;
      $old_attr_type = 'form';
      next;
    }

    #--------------------------
    # It's a FIELD attribute.
    #--------------------------
    if ( $key eq "key" ) {
      unshift( @keys, $current);
    } else {
      #### CHANGED for Perl5 ###
      $val = 'TRUE' unless defined $val;
      ####
      $field{$current,$key} = $val;
      $old_attr_key   = "$current$;$key";
      $old_attr_type  = 'field';
    }
  }

  #--------------------------------------------------------
  # If a 'PERL' attribute exists in the form : Evaluate it
  #--------------------------------------------------------
  if ( $form{'PERL'} ) {
    eval $form{'PERL'};
    if ( $@ ) {
      print "Error in the forms PERL attribute :<p>\n $@\n";
      die "Exiting...\n";
    }
  }
}

#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#.PURPOSE   Handle various complexities of parameter passing and validation
#
#.REMARKS
#
#.RETURNS   None
#------------------------------------------------------------------------------
sub PrepareParams
{
  #----------------------------------------------------------
  # Handle delete and new parameter GET requests first
  #----------------------------------------------------------
  foreach $name ($wdb_query->param) {
    if (defined $wdb_query->param("wdb_new_$name")) {
      $wdb_query->param($name,$wdb_query->param("wdb_new_$name"));
      $wdb_query->delete("wdb_new_$name");  # don't pass
      print "new $name\n" if $debug;
    }
    if ( defined $wdb_query->param("wdb_undef_$name") ) {
      $wdb_query->delete($name);
      $wdb_query->delete("wdb_undef_$name");  # don't pass
      print "deleting $name\n" if $debug;
    }
  }
  
  #----------------------------------------------------------------
  # Eliminate all of the the blank parameters for shorter self_url
  #----------------------------------------------------------------
  @param = $wdb_query->param;
  foreach $param ( @param ) {
    $wdb_query->delete($param) if ($wdb_query->param($param) eq "");
  }

  #----------------------------------------------------------
  # Remove duplicate and undefined Order parameters
  #----------------------------------------------------------
  if (defined $wdb_query->param('Order0')) {
    $wdb_query->param('Order3',$wdb_query->param('Order2'));
    $wdb_query->param('Order2',$wdb_query->param('Order1'));
    $wdb_query->param('Order1',$wdb_query->param('Order0'));
    $wdb_query->delete('Order0');
  }

  if (lc $wdb_query->param('Order1') eq 'none') {
    $wdb_query->delete('Order1');
  }
  if ($wdb_query->param('Order2') eq $wdb_query->param('Order1') ||
      lc $wdb_query->param('Order2') eq 'none') {
    $wdb_query->delete('Order2');
  }
  if ($wdb_query->param('Order3') eq $wdb_query->param('Order1') ||
      $wdb_query->param('Order3') eq $wdb_query->param('Order2') ||
      lc $wdb_query->param('Order3') eq 'none') {
    $wdb_query->delete('Order3');
  }

  if (!defined $wdb_query->param('Order1')) {
    $wdb_query->param('Order1',$wdb_query->param('Order2'));
    $wdb_query->delete('Order2');
  }
  if (!defined $wdb_query->param('Order2')) {
    $wdb_query->param('Order2',$wdb_query->param('Order3'));
    $wdb_query->delete('Order3');
  }

  #------------------------------------------------
  # Put the parameters into easy to access hash
  #------------------------------------------------

  foreach $name ($wdb_query->param) {

    $in{$name} = join(" OR ",$wdb_query->param($name));

#    $in{$name} = $wdb_query->param($name);
#    print "$in{$name} $name \n"  if $debug;
  }
  $wdb_query->delete('skip'); # Never passed on
}

#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#.PURPOSE   Print an HTML query form 
#
#.REMARKS
#
#.RETURNS   True, or not at all ....
#------------------------------------------------------------------------------
sub PrintForm 
{

  #-----------------------------
  # Print HTML header stuff
  #-----------------------------
  $header = ( $form{'Q_HEADER'} ) ? "$form{'Q_HEADER'}" 
                    : "$form{'TITLE'} - Query Form";
  if ( $form{'DOCURL'} ) {
    $header = "<a href=\"$form{'DOCURL'}\">" . $header . "</a>";
  }

  print $wdb_query->start_html($form{'TITLE'});
  print "<H1>$header</H1>\n";

  if ( $form{'Q_HTML'} ) {
    print "$form{'Q_HTML'}\n";
  } else {
    print "Please enter qualifiers in the fields";
    print " below and press the '<b>Search</b>' button.\n";
  }
  print "<FORM ACTION=\"$WDB/$dbdir/$formname/query\" METHOD=\"POST\">";
  &write_menu;
  print "\n<pre>";

  #------------------------
  # Print fields
  #------------------------
  $max = 0;
  foreach $f ( @fields ) {
    if ( (!defined $field{$f,'no_query'}) && (!defined $field{$f,'hidden'}) ) {
      $max= length($field{$f,'label'}) if length($field{$f,'label'}) > $max;
     }
  }
  $format = "%-" . $max . "s";

  push (@sortkeys,'none');
  foreach $f ( @fields ) {
    next if defined $field{$f,'hidden'};

    if ( defined $field{$f,'sortkey'}
         && ! defined $field{$f,'no_query'} ) {
      push(@sortkeys, $f);
    } 

    if ( defined $field{$f,'no_query'} ) {
      if ( ! defined $field{$f,'no_tab'}
           && ! defined $field{$f,'hidden'} 
           && ! defined $field{$f,'forcetab'} ) { 
        push( @extrafields, $f );
      }
      next;
    }
    print "\n" if ( $notfirstfield++ && ! defined $field{$f,'sameline'} );
    print &eval_attr( $f,'html') if defined $field{$f,'html'};

    #---------------------------------
    # Checkbox : In tabular output ? 
    #---------------------------------
    print "<INPUT type=checkbox ";
    if (lc $in{'requery'} eq 'on') {
      print "checked" if (lc $in{"tab_$f"} eq 'on');
    } else {
      print "checked" unless (defined $field{$f,'no_tab'});
    }
    print " name=tab_$f><b>";

    #---------------------------------
    # Label
    #---------------------------------
    if ( $field{$f,'help'} ) {
      print DEBUG "help field : $field{$f,'help'}\n" if $debug;
      $help = &eval_attr( $f,'help');
      print DEBUG "help : $help\n" if $debug;
      print "<a href=\"";
      print $form{'DOCURL'} if ( $help =~ /^#.*/ );
      print $help . "\">";
      print $field{$f,'label'};
      print "</a>";
    } else {
      print $field{$f,'label'};
    }

    if ( ! defined $field{$f,'sameline'} ) {
      print "." x ($max - length($field{$f,'label'})) ;
      print " :";
    }
    print "</b>";

    #--------------------------------------------------
    # Query field : Selection box or Text input field.
    #--------------------------------------------------


    if ( $field{$f,'enum_multiple'} ) {
      print " <SELECT name=\"$f\" size=6 multiple>";
      foreach ( split(',',$field{$f,'enum_multiple'}) ) {
        ( $value, $title ) = /^\s*(.*)=(.*)$/;
        $selected = ($in{$f} eq $value ? "selected": "");
        print "<OPTION value=\"$value\" $selected> $title\n";
      }
      print "</SELECT>";
     } else {
 if ( $field{$f,'enum'} ) {
      print " <SELECT name=\"$f\">";
      foreach ( split(',',$field{$f,'enum'}) ) {
        ( $value, $title ) = /^\s*(.*)=(.*)$/;
        $selected = ($in{$f} eq $value ? "selected": "");
        print "<OPTION value=\"$value\" $selected> $title\n";
      }
      print "</SELECT>";
    } else {
      if ( $field{$f,'length'} > (55-$max) ) {
        $length = (55-$max) ;
      } else {
        $length = $field{$f,'length'};
      }
      if ( $field{$f,'default'} && $in{'requery'} ne 'on') {
        $default = eval $field{$f,'default'};
        if ( $@ ) {
          print "Error in $f"."'s  'default' attribute :<p>\n $@\n";
          die "Exiting...\n";
        }
      } else {
        $default = "";
      }
      $default = $in{$f} if defined $in{$f};
      print " <INPUT name=\"$f\" size=$length value=\"$default\" >";
    }
    #-------------
    # Unit label
    #-------------
    print " $field{$f,'unitlabel'}" if ( $field{$f,'unitlabel'} );
  }
 }
  #------------------------------
  # Print the rest of the page.
  #------------------------------
  print "</pre> ";
  if ( @extrafields ) {
    print "<a href=\"$WDB_HTML/wdb_query_help.html#ctrl\">";
    print "Extra columns on tabular output</a> : ";
    print " <SELECT name=\"extra_columns\" size=8 multiple>\n";
    foreach $ef ( @extrafields ) {
      print "<option value=$ef> $field{$ef,'label'}\n";
    }
    print "</SELECT>\n";
  }
  if (defined $form{'ORDER'}) {

    foreach $sk ( @sortkeys ) {
      $sortkeys{$sk} = $field{$sk,'label'};
    }

    $sortkeys{'none'} = 'None'; # for convienience

    print "<br><b>Order by: </b> ";
    print $wdb_query->popup_menu('Order1', \@sortkeys, $sortkeys[0], \%sortkeys);
    print " then ";
    print $wdb_query->popup_menu('Order2', \@sortkeys, $sortkeys[0], \%sortkeys);
    print " then ";
    print $wdb_query->popup_menu('Order3', \@sortkeys, $sortkeys[0], \%sortkeys);
  }
  print "<hr>\n";

  if (defined $form{'ASK_FULL'}) {
    print "<INPUT type=checkbox name=full_screen_mode>
    Use full-screen output even if more than one row is returned.<br>\n";
  }

  if (defined $form{'ROW_COUNT'}) {
    print "Return tables with a maximum of <INPUT VALUE=$form{'ROW_COUNT'} 
           SIZE=3 NAME=max_rows_returned> rows per page. (max: $MAXROWCOUNT)\n";
  }

  &write_menu;
  &html_tail;
  $wdb_query->end_html;
}

#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#.PURPOSE   Retrieve a query, execute it, and print the result.
#
#.REMARKS
#
#.RETURNS     
#------------------------------------------------------------------------------
sub DoQuery 
{
  # Timeout not implemented yet.
  #$SIG{'SIGALARM'} = 'timeout';
  #$SIG{'SIGIO'} = 'timeout';

  #--------------------------
  # Load database interface.
  #--------------------------
  if ( -f "$CONFIG_DIR/$DBI_FILE" ) {
    do "$CONFIG_DIR/$DBI_FILE" ||
      die "Error loading database interface file $CONFIG_DIR/$DBI_FILE :\n$@\n";
  } else {
    die "Database interface file '$CONFIG_DIR/$DBI_FILE' not found ?\n";
  }

  #--------------------------
  # Print HTML Header stuff.
  #--------------------------

  if ( $action eq "query" ) {
    $header = ( $form{'R_HEADER'} ) ? "$form{'R_HEADER'}" : "$form{'TITLE'} - Query Result";
  } else {
    $header = ( $form{'D_HEADER'} ) ? "$form{'D_HEADER'}" : "$form{'TITLE'} - Default List";
  }

  if ( $form{'DOCURL'} ) {
    $header = "<a href=\"$form{'DOCURL'}\">" . $header . "</a>";
  }

  print "<TITLE>$form{'TITLE'}</TITLE>\n";
  print "<H1>$header</H1>\n";
  if ( $action eq "query" ) {
    print "$form{'R_HTML'}\n" if ( $form{'R_HTML'} );
  } else { # ($action eq "default")
    if ( $form{'D_HTML'} ) {
      print "$form{'D_HTML'}\n";
    } else {
      print "<H4>Press the 'Query' button to change qualifications.</h4>\n";
    }
  }
  &write_menu;

  #--------------------------------------------------
  # Compose select and where list for the SQL select
  #--------------------------------------------------
  foreach $f ( @fields ) {
    if (defined $in{"tab_$f"} || 
        defined $field{$f,'forcetab'} || 
        defined $field{$f,'hidden'} || 
        defined $field{$f,'force_select'} || 
        defined $in{'full_screen_mode'} ||
        ($action eq 'default' && defined $field{$f,'default'})) {
      unless (defined $field{$f,'computed'}) {
        if ( defined &dbi_fieldnames ) {
          push(@select, ($field{$f,'column'})  ?  $field{$f,'column'} : $f);
          push( @select_fields, "$f" );
        } else {
          push( @select, "$field{$f,'column'} $f" ); 
        }
      }
    }

    if ( $field{$f,'column'} ) {
      $col = $field{$f,'column'};
    } else {
      $col = $f;
    }

    if ( $action eq "default" ) { 
      if ( $field{$f,'default'} && ! $in{$f} ) {
        $in{$f} = &SGMLtoASCII( &eval_attr($f,'default',0) );
      }
    }

    # Ignore '%' fields (from enum fields)
    $wdb_query->param($f,""), $in{$f} = "" if $in{$f} eq '%';

    if ( defined $in{$f} && $in{$f} ne "" ) {

      if ( defined $field{$f,'computed'} ) { 
        print DEBUG "Evaluating computed field : $f = $in{$f}\n";
        print DEBUG "- Compute : $field{$f,'to_db'}\n";
        $ret = &eval_attr($f,'to_db',$in{$f});
        print DEBUG " = $ret\n";
        next; # Don't query on computed fields.
      }

      print DEBUG "Parsing $f = '$in{$f}'\n" if $debug;

      foreach $qual ( split( /\s*\|\s*|\s*\&\s*|\s+OR\s+|\s+or\s+|\s+AND\s+|\s+and\s+/, $in{$f} ) ) {

        print DEBUG "      qual = '$qual'\n" if $debug;
        ( $oper, $val ) = $qual =~ /^\s*(<=|>=|!=|<|>|==|=|~|!~)?(.*)$/;

        undef $val2;
        ( $val1, $val2 ) = split( /\.\./,$qual,2 ) unless $oper;                    
        if ( $val2 ) {
          print DEBUG "   range: '$val1' -> '$val2'\n" if $debug;

          if (   $field{$f,'type'} eq 'char' 
              || $field{$f,'type'} eq 'datetime'
              || $field{$f,'type'} eq 'float' ) {
            push( @or_where, "$col >= '"
              . &eval_attr($f,'to_db',$val1)
              . "' AND "
              . "$col <= '"
              . &eval_attr($f,'to_db',$val2) . "'");
          } else {
            push( @or_where, "$col >= '"
              . &eval_attr($f,'to_db',$val1)
              . "' AND " 
              . "$col <= '"
              . &eval_attr($f,'to_db',$val2) . "'");
          }
        } elsif ( defined $val ) {
        if ($val eq 'NULL') {
            $val = 'isnull';
            push( @or_where, "$col $val"); } 
        elsif ($val eq 'NOTNULL') {
            $val = 'notnull';
            push( @or_where, "$col $val");
          }
          else {
            $val = &eval_attr($f,'to_db',$val);
            if ( ! $oper ) {
              $oper = "==" if ($field{$f,'enum'} || $field{$f,'enum_multiple'});
            } 

            if ( $oper ne '==' ) {
              $val =~ s/^\s*//; # strip white space out at start & end
              $val =~ s/\s*$//;
            }
            print DEBUG "      val = '$val'\n" if $debug;

            if ( $field{$f,'type'} eq 'char' ) {
              $val  =~ s/"/""/g;
              $val  =~ s/'/''/g;
              if ( ! $oper ) {    # Default 
                $oper = "~";
                $val  =~ s/([a-zA-Z])/[\U$1\L$1]/g;
              } elsif ( $oper eq "=" ) {
                $oper = "~";
              } elsif ( $oper eq "==" ) {
                $oper = "=";
              } elsif ( $oper eq "~" ) {
                $val  =~ s/([a-zA-Z])/[\U$1\L$1]/g;
              }
              $val =~ s/\*/.*/g if $oper eq "~";
              push( @or_where, "$col $oper '$val'");

            } elsif ( $field{$f,'type'} eq 'datetime'  ) {
              $oper = "=" unless $oper;    # Defaul operand is '='
              $oper = "=" if $oper eq "==";
#             $val =~ s/\*/%/g if $oper eq "~";
              push( @or_where, "$col $oper '$val'");

            } elsif ( $field{$f,'type'} eq 'float'  ) {
              $oper = "=" unless $oper;       # Defaul operand is '='
              $oper = "=" if $oper eq "==";
              push( @or_where, "$col $oper $val");

            } elsif ( $field{$f,'type'} eq 'int'  ) {
              $oper = "=" unless $oper;       # Defaul operand is '='
              $oper = "=" if $oper eq "==";
              push( @or_where, "$col $oper $val");


            } elsif ( $field{$f,'type'} eq 'bool'  ) {
              $oper = "=" unless $oper;       # Defaul operand is '='
              $oper = "=" if $oper eq "==";
              push( @or_where, "$col $oper '$val'");

            } elsif ( $field{$f,'type'} eq 'oid'  ) {
              $oper = "=" unless $oper;       # Defaul operand is '='
              $oper = "=" if $oper eq "==";
              push( @or_where, "$col $oper $val");

            } else {
              $oper = "=" unless $oper;       # Defaul operand is '='
              $oper = "=" if $oper eq "==";
              push( @or_where, "$col $oper '$val'");
            }
          }
        }
      }
      print DEBUG "     WHERE = ".join(" OR ",@or_where)."\n" if $debug;

      if ( @or_where > 1 ) {
        push( @where, "(". join(" OR ",@or_where) . ")" );
      } else {
        push( @where, @or_where );
      }
      @or_where = ();
    }
  }

  push( @where, $form{'CONSTRAINTS'}) if $form{'CONSTRAINTS'};
  push( @where, $form{'JOIN'}) if $form{'JOIN'};

  $selectlist = join(', ',@select);
  $wherelist  = join(' AND ', @where );
  $wherelist  = "WHERE ".$wherelist if $wherelist;

  #-------------------------------------------------------------------
  # Make ordering hierarchical so Order1 is required to use Order2 etc.
  #-------------------------------------------------------------------

  if ($in{'Order1'} && $in{'Order1'} ne 'None' && $in{"tab_$in{'Order1'}"}) {
    $wherelist .= " ORDER BY " . $in{'Order1'};

    if ($in{'Order2'} && $in{'Order2'} ne 'None' && $in{"tab_$in{'Order2'}"}) {
      $wherelist .= ", " . $in{'Order2'};

      if ($in{'Order3'} && $in{'Order3'} ne 'None' && $in{"tab_$in{'Order3'}"}){
        $wherelist .= ", " . $in{'Order3'};
      }
    }
  }
    
  #-------------------------------
  # Open database and select data.
  #-------------------------------

  &dbi_connect( $form{'HOST'}, $form{'PORT'}, $form{'DATABASE'}, $user, $pswd );

  $rowcount = $in{'max_rows_returned'} if $in{'max_rows_returned'};
  $rowcount = $MAXROWCOUNT if $rowcount > $MAXROWCOUNT;
    
  &dbi_rowcount( $rowcount );
  &dbi_dateformat( $DATEFORMAT ) if ( $DATEFORMAT );
  &dbi_fieldnames( @select_fields ) if defined &dbi_fieldnames;

  if ( $debug ) {
    print DEBUG "\n**** QUERY ****\n";
    print DEBUG "use $form{'DATABASE'}\n";
    print DEBUG "SELECT $selectlist FROM $form{'TABLE'}\n";
    print DEBUG "$wherelist \n\n";
  }
    
  #------------------------------
  # **** Do the SQL Query ******
  #------------------------------
  &dbi_dosql( "SELECT $selectlist FROM $form{'TABLE'} $wherelist");

  #-------------------------------------------------------------
  # Get the number of matches and see if it is more than a page.
  # If it is more than a page set up URLs to get other pages
  #-------------------------------------------------------------
  $num_matched = &dbi_rowsmatched();
  if ( $num_matched > $rowcount ) {
    $next_strt = $in{'skip'} + $rowcount;
    $next_strt = 0 if $next_strt >= $num_matched;
    $prev_strt = $in{'skip'} - $rowcount;
    $prev_strt = $num_matched - $rowcount if $prev_strt < 0;
    $strt = $in{'skip'} + 1;
    $strt = 0 if $strt < 0;
    $stop = $in{'skip'} + $rowcount;
    $stop = $num_matched if $stop > $num_matched;
      
    if ($strt > 1 ) {
      $prev_url = $wdb_query->self_url . "&skip=$prev_strt";
      $prev_href = "<a href=\"$prev_url\"> <img src=\"$IMAGEDIR/p95-up.gif\" vspace=2></a>";
    }
      
    if ($stop < $num_matched) {
      $next_url = $wdb_query->self_url . "&skip=$next_strt";
      $next_href = "<a href=\"$next_url\"> <img src=\"$IMAGEDIR/p95-dn.gif\" vspace=3></a>";
    }
  }

  $i = 0;
  while ( ($i < $in{'skip'}) && (%myrow = &dbi_nextrow) ) { $i++ } # Skip to desire rows
  $numrows=0;

  #------------------------------------------
  # No data returned so print SQL query only
  #------------------------------------------
  if ( ! (%myrow = &dbi_nextrow ) ) {
    print "<p><h2>No data returned !</h2>\n";
    print "Please go 'Back' to the query form and re-specify your query.\n";
    print "<p><hr>\n";
    print "<h3>Your Query :</h3>\n";
    foreach $f ( @fields ) {
      if ( defined $in{$f} && $in{$f} ne "" ) {
        print "<em>$field{$f,'label'}</em> : $in{$f}<br>\n";
      }
    }
    print "<p><hr>\n";
    print "<h3>SQL Query used.</h3>\n";
    $query = "SELECT $selectlist FROM $form{'TABLE'} $wherelist<br>\n";
    $query =~ s/\b(FROM|WHERE|AND|OR|ORDER BY)\b/<br>$1/gi;
    print "$query";
    &html_tail;
    $wdb_query->end_html;
    return;
  }
    
  #----------------
  # Print all rows.
  #----------------

#  $numrows++;
  $output_mode='full';
  $output_mode='table' unless defined $in{'full_screen_mode'};

  print "$prev_href" if defined $prev_href;

  &PrintTabHead if $output_mode eq 'table';

  do {
    $numrows++;
    if ( $output_mode eq 'full' ) {# Other rows Full screen mode output
      &PrintVars(%myrow);
    } else {                         # Other rows Table mode output
      &PrintTabVars(%myrow);
    }
  } while( (%myrow = &dbi_nextrow) && $numrows < $rowcount );
  print "</table>\n" if $output_mode eq 'table';
    
  &wdb_usage if defined &wdb_usage;   # Update usage statistics (if defined)

  &dbi_disconnect;
    
  #----------------------------------------------------------------------
  # If the number of matches exceeds a page then put a link to next page.
  #----------------------------------------------------------------------
  print "$next_href" if defined $next_href;
  print "<hr><em>A total of $num_matched rows were retrieved</em>\n" 
    if $output_mode eq 'table';
    
  if ( $num_matched > $rowcount ) {
    print "<em>and you are currently viewing rows $strt to $stop.</em>\n";
  }

  #----------------------------------------------------------------------
  # If the FORM defines SQL then show the SQL query in a popup menu
  #----------------------------------------------------------------------
  if (defined $form{'SQL'} && lc($form{'SQL'}) eq 'on') {
    $query = "SELECT $selectlist FROM $form{'TABLE'} $wherelist\n";
    $query =~ s/\b(FROM|WHERE|AND|OR|ORDER BY)\b/\n$1/gi;
    $query =~ s/\b(.{30,45}),/$1,\n/g;  # break into pieces
        
    @query = split(/\n/,$query);
    print $wdb_query->startform;
    print "<b>SQL Query:</b> ", $wdb_query->popup_menu('SQL',\@query);
    print $wdb_query->endform;
  }

  &html_tail;

  ### DEBUG ###
  if ( $debug ) {
    print "<h2>Query</h2>\n";
    print "use $form{'DATABASE'}<br>\ngo<br>\n";
    print "SELECT $selectlist FROM $form{'TABLE'}<br>\n";
    print "$wherelist <br>\n";
    print "<hr>\n";
  }
  ##############
  $wdb_query->end_html;
}

#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#.PURPOSE       Print variables in 'full-screen' format.  
# 
#.REMARKS 
#
#.RETURNS
#------------------------------------------------------------------------------
sub PrintVars 
{
  local (%val) = @_;

  #----------------------------
  # Find max length of titles.
  #----------------------------
  $max = 0;
  foreach $f ( @fields ) {
    if ( &FieldInFull ( $f ) ) {
      $max = length($field{$f,'label'}) if length($field{$f,'label'}) > $max;
    }
  }
  $format = "%-" . $max . "s";

  #-------------
  # Print header
  #-------------
  if ( $form{'RECTOP'} ) {
    $rectop = eval $form{'RECTOP'};
    if ( $@ ) {
      print "Error in the 'RECTOP' attribute :<p>\n $@\n";
      die "Exiting...\n";
    }
    print "<h2>$rectop</h2>\n";
  }
  print "<dl>\n";

  #-----------------------
  # Now print each field.
  #-----------------------
  foreach $f ( @fields ) {
    if ( &FieldInFull ( $f ) ) {
      next if defined $field{$f,'hidden'};    # Ignore hidden fields
      next if defined $field{$f,'no_full'};   # Ignore no_full fields

      print DEBUG "html attribute for $f = $field{$f,'html'} \n";

#     print "<br>\n" if ( ! defined $field{$f,'sameline'} );
      print "</dl>".&eval_attr($f,'html')."<dl>" if defined $field{$f,'html'};
      print "<dt>\n" if ( ! defined $field{$f,'sameline'} );

      print " <TT><b>";
      print $field{$f,'label'};
      print "." x ($max - length($field{$f,'label'}))
        if ( ! defined $field{$f,'sameline'} );
      print "</b></TT> : ";
      $value = &Value( $f, $val{$f} );
      print " $value"; 
### Oleg
#      print " $field{$f,'unitlabel'}" if ( $field{$f,'unitlabel'} );

#     print "<br>\n";
    }
    }
  print "</ul>\n";
}

#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#.PURPOSE   Print column headers for tabular output.
#
#.REMARKS
#
#.RETURNS     
#------------------------------------------------------------------------------
sub PrintTabHead 
{
  local( $len );

  print "<Table border=1>\n<tr>\n";

  foreach $f ( @fields ) {
    if ( &FieldInTab( $f ) ) {
      $len = $field{$f,'tablen'};

      #----------------------------------------------------------------
      # When the field is a sortkey then we make it a sort/unsort link
      #----------------------------------------------------------------
      if ($field{$f,'sortkey'}) {
        $sorted = "";
        $sort_param = "&Order0=$f";

        #----------------------------------------------------------------
        # already sorted on this sortkey? flag it and then link unsorts
        #----------------------------------------------------------------
        for ($i = 1; $i <= 3; $i++) {
          if ($f eq $in{"Order$i"}) {
            $sorted = "<font size=-2>[$i]</font>";
            $sort_param = "&" . "wdb_undef_Order$i=$f";
          }
        }
        print "<th> <a href=\"" . $wdb_query->self_url . $sort_param;
        print "\">$field{$f,'label'}</a> $sorted </th> \n";

      } else {
        print "<th>  $field{$f,'label'} </th> \n";
      }
    }
  }

  #-----------------------
  # Now do the unitlabels
  #-----------------------
  print "</tr>\n<tr>\n";

  foreach $f ( @fields ) {
    if ( &FieldInTab( $f ) ) {
      if ( $output_mode eq 'table') {
        $len = $field{$f,'tablen'};
### Oleg
### Broaden a selection. This requires more work !!!
      print "<th>";
      if ( defined $wdb_query->param( $f ) && $in{$f} ne "") {
        print "<a href=\"" . $wdb_query->self_url . "&wdb_undef_$f=".&cgi_encode($val{$f});
        print "\">Any</a>";
###        print "<th> ", ($field{$f,'unitlabel'} ? $field{$f,'unitlabel'} : "&nbsp"), " </th> \n";
      }
        print "$sorted </th> \n";
      }
    }
  }
  print "</tr>\n<tr> </tr>\n"; # blank row for looks
}

#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#.PURPOSE   Print a row in tabular output format.
#
#.REMARKS
#
#.RETURNS     
#------------------------------------------------------------------------------
sub PrintTabVars 
{
  local (%val) = @_;

  print "<tr>\n";
  foreach $f ( @fields ) {
    if ( &FieldInTab( $f ) ) {
      $value = &Value( $f, $val{$f} );
      if ($field{$f,'type'} eq 'char') {
        print "<td>$value</td>\n";
      } elsif ($field{$f,'type'} eq 'bool') {
        print "<td align=center>$value</td>\n";
      } else {
        print "<td align=right>$value</td>\n";
      }
    }
  }
  print "</tr>\n";
}

#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#.PURPOSE   Decides if a field should be included in tabular output.
#
#.REMARKS
#
#.RETURNS   0 or 1 for yes or no.  
#------------------------------------------------------------------------------
#sub FieldInTab
#{
#  local ($f) = @_;    # Field name
#
#  return 0 if defined $field{$f,'hidden'}; # always suppress hidden
#  return 1 if defined $field{$f,'forcetab'}; # always show forcetab
#  return 1 if ($in{"tab_$f"} eq 'on'); # show if user requests it
#  return 1 if $in{'extra_columns'} =~ /(\\0|^)$f(\\0|$)/;
#
#  if ( $action eq "default") {      # show default field for default query
#    return 1 if defined $field{$f,'default'};
#  }
#  return 0 if defined $field{$f,'no_tab'}; # always suppress no_tab
#  return 0;     # otherwise don't show it in the table
#}
sub FieldInTab
{
    local ($f) = @_;    # Field name

    return 1 if defined $field{$f,'forcetab'};
    return 1 if $in{"tab_$f"};
    return 1 if $in{'extra_columns'} =~ /(\\0|^)$f(\\0|$)/;
    if ( $key_args || $action eq "default" || $ENV{'REQUEST_METHOD'} eq 'GET'){
        return 0 if defined $field{$f,'hidden'};
        return 1 if ! defined $field{$f,'no_query'}   
                 && ! defined $field{$f,'no_tab'};
    }
    return 0;
}




#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#.PURPOSE       Decides if a field should be included in full output.
#
#.REMARKS
#
#.RETURNS       0 or 1 for yes or no.
#------------------------------------------------------------------------------
sub FieldInFull
{
  local ($f) = @_;    # Field name

  return 0 if defined $field{$f,'hidden'};
  return 0 if defined $field{$f,'no_full'};
  return 1;
}

#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#.PURPOSE   Compute output value of field (eval enums, pictures etc. ..)
#
#.REMARKS
#
#.RETURNS   New value;
#------------------------------------------------------------------------------
sub Value 
{
  local( $f, $val ) = @_;
  local( $newval, $oldval );

  print DEBUG "Value : $f : $val " if $debug;

  $oldval = $val;

  if ( $field{$f,'from_db'} ) {
    print DEBUG "(from_db)" if $debug;
    $val = eval $field{$f,'from_db'};
    if ( $@ ) {
      print "Error in $f 's 'from_db' attribute :<p>\n $@\n";
      print "Please report this error.\n";
      die "Exiting...\n";
    }
  }

  if ( $field{$f,'enum'} ) {
    print DEBUG "(enum)" if $debug;
#    ( $newval ) = $field{$f,'enum'} =~ /^.*$oldval=([^,]*)/;
    $field{$f,'enum'} =~ /(^|,)$oldval=([^,]*)(,|$)/;
    $newval = $2;
    
#    $val = $newval if ( $newval );
    $val =~ s/$oldval/$newval/ if ( $newval );
  }
  if ( $field{$f,'enum_multiple'} ) {
    print DEBUG "(enum_multiple)" if $debug;
#    ( $newval ) = $field{$f,'enum_multiple'} =~ /^.*$oldval=([^,]*)/;
    $field{$f,'enum_multiple'} =~ /(^|,)$oldval=([^,]*)(,|$)/;
    $newval = $2;
    
#    $val = $newval if ( $newval );
    $val =~ s/$oldval/$newval/ if ( $newval );
  }


  if ( $val eq 'NULL' || 
       (defined $SPEC_NULL{$field{$f,'type'}} && 
         $SPEC_NULL{$field{$f,'type'}} eq $val) ) {
    $val = $NULL_VALUE;
    if ( $output_mode eq 'table' && $field{$f,'tablen'} ) {
      $val = sprintf("%-$field{$f,'tablen'}.$field{$f,'tablen'}s", $val);
    } else {
      $val = sprintf("%-$field{$f,'length'}s", $val);
    }
    print DEBUG "(null)" if $debug;
    print DEBUG "= $val\n" if $debug;
    return $val;
  }

  #-------------------------------
  # Adjust output length of value
  #-------------------------------
  if ( $output_mode eq 'table' && $field{$f,'tablen'} ) {
    $val = sprintf("%-$field{$f,'tablen'}.$field{$f,'tablen'}s", $val);
  } else {
    $val = sprintf("%-$field{$f,'length'}s", $val);
  }

  if ( $field{$f,'url'}  && $output_mode eq 'table' ) {
    print DEBUG "(url)" if $debug;
    $url = &eval_attr( $f,'url');
    $val = "<a href=\"$url\">$val</a>" if $url;
  }

  if ( $field{$f,'full_url'}  && $output_mode eq 'full' ) {
    print DEBUG "(url)" if $debug;
    $url = &eval_attr( $f,'full_url');
    $val = "<a href=\"$url\">$val</a>" if $url;
  }
    
  print DEBUG "= $val\n" if $debug;
  return  $val;
}

#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#.PURPOSE   Evaluate an attribute using 'eval' - with error handling etc.
#
#.REMARKS   Dies on error.
#
#.RETURNS   The return value of the 'eval'
#------------------------------------------------------------------------------
sub eval_attr
{
  local($f, $attr, $val) = @_;
  local($ret);

  if ( $field{$f,$attr} ) {
    $ret = eval $field{$f,$attr};
    if ( $@ ) {
      print "Error in $f"."'s  '$attr' attribute :<p>\n $@\n";
      print "Please report this error.\n";
      die "Exiting...\n";
    }
  } else {
    $ret = $val;
  }

  return $ret;
}

#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#.PURPOSE   Generate the "menu" for the form, and result pages.
#
#.REMARKS
#
#.RETURNS   nothing
#------------------------------------------------------------------------------

sub write_menu
{
  print "<hr>\n";
  if ( $action eq "form" ) {
    print "<INPUT TYPE=\"image\" alt=\"[Search]\" VALUE=\"Search\" src=\"$IMAGEDIR/search_btn.gif\">";
    print " <A HREF=\"$QUERY_HELP\">";
    print "<img alt=\"[Help]\" src=\"$IMAGEDIR/help_btn.gif\"></A>";
  } else {
    $self_form = "$WDB/$dbdir/$formname/form?".$wdb_query->query_string;
    print " <a href=\"$self_form&requery=on\">";
    print "<img alt=\"[Query]\" src=\"$IMAGEDIR/query_btn.gif\"></A>";
    print " <A HREF=\"$TABLE_HELP\">";
    print "<img alt=\"[Help]\" src=\"$IMAGEDIR/help_btn.gif\"></A>";
  }
  if ( $MAIN_MENU ) {
    print " <a href=\"$MAIN_MENU\">";
    print "<img alt=\"[Home]\" src=\"$IMAGEDIR/home_btn.gif\"></A>";
  }
  if ( $user_menu) {
    print $user_menu;
  }
  print "<hr><p>";
}

sub add_menu
{
  local ($text, $href, $img) = @_;

  $user_menu .= " <a href=\"$href\">";
  if ( $img ) {
    $user_menu .= "<img alt=\"[$text]\" src=\"$img\">";
  } else {
    $user_menu .= "[$text]";
  }
  $user_menu .= "</a>";
}

#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#.PURPOSE       Convert SGML special Character codings into ASCII
#
#.REMARKS
#
#.RETURNS       The converted string
#------------------------------------------------------------------------------

sub SGMLtoASCII
{
  local ($str) = @_;
  
  $str =~ s/&gt;/>/g;
  $str =~ s/&lt;/=/g;
  
  return( $str );
}

#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#.PURPOSE   Encodes a string so it doesn't cause problems in URL.
#
#.REMARKS
#
#.RETURNS   The encoded string
#------------------------------------------------------------------------------

sub cgi_encode
{
  local ($str) = @_;
  
  $str = &escape($str,'[\x00-\x20"#%/+;<>?\x7F-\xFF]');
  $str =~ s/ /+/g;
  
  return( $str );
}

# ===========================================================================
# escape(): Return the passed string after replacing all characters matching
#           the passed pattern with their %XX hex escape chars.  Note that
#           the caller must be sure not to escape reserved URL characters
#           (e.g. / in pathnames, ':' between address and port, etc.) and thus
#           this routine can only be applied to each URL part separately. E.g.
#
#           $escname = &escape($name,'[\x00-\x20"#%/;<>?\x7F-\xFF]');
#
sub escape
{
  local($str, $pat) = @_;
         
  $str =~ s/($pat)/sprintf("%%%02lx",unpack('C',$1))/ge;
    
  return($str);
}

# ===========================================================================
# unescape(): Return the passed URL after replacing all %NN escaped chars
#             with their actual character equivalents.
#
sub unescape
{
    local($url) = @_;

    $url =~ s/%(..)/pack("C",hex($1))/ge;
    return $url;
}
__END__

#.COPYRIGHT NOTICE
# ==========================================================================
# Copyright Bo Frese Rasmussen 1994 - All Rights Reserved
# Copyright European Southern Observatory(ESO) 1994 - All Rights Reserved
# Copyright Space Telescope - European Coordinating Facility(ST-ECF) 1994 
# - All Rights Reserved
# 
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose is hereby granted without fee, provided
# that the above copyright notice appear in all copies and that both that
# copyright notice, this permission notice, and the following disclaimer
# appear in supporting documentation, and that the names of the copyright
# holders, not be used in advertising or publicity pertaining to
# distribution of the software without specific, written prior
# permission.
# 
# BO FRESE RASMUSSEN, EUROPEAN SOUTHERN OBSERVATORY, AND OTHER
# CONTRIBUTORS OF THIS SOFTWARE DISCLAIM ALL WARRANTIES WITH REGARD TO
# THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
# FITNESS FOR ANY PARTICULAR PURPOSE.  IN NO EVENT SHALL BO FRESE
# RASMUSSEN, EUROPEAN SOUTHERN OBSERVATORY OR ANY OTHER CONTRIBUTOR BE
# LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
# DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA, OR PROFITS,
# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE, OR OTHER TORTIOUS ACTION,
# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
# SOFTWARE.
#------------------------------------------------------------------------------
# The escape and unescape functions are taken from the wwwurl.pl package
# developed by Roy Fielding <fielding@ics.uci.edu> as part of the Arcadia
# project at the University of California, Irvine. It is distributed
# under the Artistic License (included with your Perl distribution
# files).
# ---------------------------------------------------------------------------