#!/usr/bin/perl -I/home/klaus/Work/WWWdb
#!/usr/bin/perl
#!/usr/bin/speedy -- -r10 -t600
#!/usr/bin/perl -d:DProf
# -*-perl-*-
# -----------------------------------------------------------------------------
#
#   Copyright (c) 1999-2002 by Klaus Reger <K.Reger@wwwdb.org>
#
#   You may distribute under the terms of either the GNU General Public
#   License or the Artistic License, as specified in the Perl README file.
#
#   THIS IS BETA SOFTWARE!
#
#   THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
#   IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
#   WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
#   $Id: WWWdb.cgi,v 1.49 2003/04/16 11:25:21 k_reger Exp $
#
# -----------------------------------------------------------------------------
# Program-Data
# -----------------------------------------------------------------------------
# Project  :
# System   :
# Program  :
# Module   : $RCSfile: WWWdb.cgi,v $
# Version  : $Revision: 1.49 $
# Date     : $Date: 2003/04/16 11:25:21 $
# State    : $State: Exp $
#
# Description:
#   This script allows, to insert, update and delete records of
#   a Database over the WWW
#
#
# State-Flows:
# ---------------------------------------------------------------------------
# By Default, the following states are implemented
#
# State  SubState Exits   LeadsTo Comment
# Init   Ok       New     Init    Insert Record, Clear form, Jump back
#        Error    New     Init    Show Err-Messages
#        -        Qry     Qry     Selection of date, internal navigation
#        -        Back    Init    Clear form, Jump back
# Qry    -        Sel_x   Work    Show sel. record
#        -        Back    Init    Clear form, Jump back
# Work   Error    Upd     Upd     Show Err-Messages
#        Ok       Upd     Init    Change Record, Clear form, Jump back
#        -        Del     Init    Del record, Clear form, Jump back
#        -        Back    Init    Clear form, Jump back
#
# -----------------------------------------------------------------------------
# Change-log (See at end of this file)
#
# --- Known Bugs -------------
# please look at the BUGS-File
# --- TODO -------------------
# please look at the TODO-File
# ----------------------------------------------------------------------------

use strict;
use locale;
# use diagnostics;

use POSIX qw();

use CGI::Carp qw(fatalsToBrowser);
use CGI::Cache;

use DB_File;

use DBIx::Recordset;            # SQL-access via recordsets

use Digest::MD5 qw(md5_hex);    # Create md5-hashes

use HTML::Entities;             # HTML-conversions (ü -> &uuml;)
use HTML::Template;             # HTML-Template

use vars qw($VERSION
            $cBgColorMGL
            $cBgImageMGL
            $hQryMGL
            $iCacheTimeoutMGL
            $iDevelopmentVersionMGL
            $lFieldLayoutMGL
            $oConfPoolGL
            $oDbSessionGL
            $oDbTargetGL
            $oFormMGL
            $oSessionGL
            $pDataSetMGL
            $pDbHdlMGL
            %hFieldErrorsMGL
            %hFormDataMGL
            %hTableInfoMGL
            %hSelectCacheMGL
            @pDataSetMGL
            %hCategoriesGL
            %hMessagesGL
            );

use WWWdb::Base;                # Base methods for WWWdb
use WWWdb::HTML;                # HTML-related methods for WWWdb
use WWWdb::Session;             # Session-related methods for WWWdb
use WWWdb::Plugin;              # Plugin-methods for WWWdb
use WWWdb::DbSession;           # Database-Session for WWWdb
use WWWdb::ConfigPool;          # Config-File-Pools for WWWdb
use WWWdb::ConfigFile;          # Config-Files for WWWdb

# use WWWdb::Monitor;             # Monitoring variables

=head1 NAME

WWWdb-API - Interface to WWWdb to use in your plugins

=head1 SYNOPSIS

ClearFields - clear all entry-fields

OkForm - Display a form similar to a popup-window

Error - show a error-frame and leave

MyExit - leave WWWdb in a clean way

MyUserVal - Get an entry of the config-file, but look for session-data before

MyVal - Get an entry of the config-file

MySetVal - Set an entry, defined in the config-file

Redirect - redirect the browser to another HTML-page

CreateReference - makes an internal WWWdb-HTML-reference

ResolveRefField - Resolve a Reference of an wwwdb_object

GetField - Get value of a Field in the HTML-Form

SetField - Sets the value of a HTML-field

AddError - Add an error-message to the internal list

DecodeHtml - decodes HTML-formatted entities to normal Text

EncodeHtml - encode normal text, to be HTML-save

SafeEncodeHtml - extended encoding of HTML-Tags

GetFieldTypeName - get the fieldtype-name of a given field

SQLSelectList - Get the SQL-SELECT-result as a list

SQLDo - executes the given SQL-statement

GetAttr - Get some internal WWWdb-attributes

=head1 DESCRIPTION

WWWdb-API is a interface to the WWWdb-application. This application
enables you to maintain the data of a database-table over the WWW. To
keep the data consistent, maybe you need to write some plugins, which
check data-integrity.

Because it is included in WWWdb, you should normally NOT include it in
your scripts. Your scripts are included in WWWdb, and this Library
gives you a interface to the internals of WWWdb.

=head1 FUNCTIONS

=cut



# --- This routine is called at compilation-time ----------------------------
sub BEGIN ()
{
    my $cBasePath;

    $VERSION                = '0.8.3';
    $iDevelopmentVersionMGL = 0;

    delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};   # Make %ENV safer

    if ($iDevelopmentVersionMGL &&
        &UnTaint($ENV{"HTTP_PRAGMA"}))
    {
        require Data::Dumper;               # Pretty-print data-structs for debug
        require CGI;

        require CGI::Debug;
        import  CGI::Debug(report       => ['errors', 'time',
                                            'params', 'cookies',
                                            'environment',
                                            'everything'],
                           on           => ['anything'],
                           to           => { browser => 1 },
                           header       => 'ignore',
                           set          => {
                               param_length => 512,
                               error_document => 'oups.html' }
                           );

        require Carp::Assert;

        # require CGI::Pretty;
        CGI->import(qw(:standard :html3 -debug)); # CGI-functionality

        $main::SIG{'__WARN__'} = \&MyDie;

    }
    else
    {
        require CGI;
        CGI->import(qw(:standard :html3)); # CGI-functionality
    }

    $main::SIG{'__DIE__'}  = \&MyDie;
    $main::SIG{'SEGV'}     = \&MyDie;
    $main::SIG{'BUS'}      = \&MyDie;

} # BEGIN


sub END()
{
   untie %hMessagesGL;
}




# --- Initializations -----------------------------------------------------------
sub InitVars()
{
   my $cKey;
   my $cCacheFileName;
   my $cCGIParamKey = "";

   $hQryMGL               = new CGI; # CGI-Query-Set
   $hQryMGL->autoEscape(undef);

   %hFormDataMGL          = ();
   %hTableInfoMGL         = ();
   %hSelectCacheMGL       = ();

   # Monitor::monitor(\%hFormDataMGL, 'hFormDataMGL');

   close STDERR;
   open(STDERR, ">" . &GetAttr("LogfileName")) or
      print STDERR ("Unable to open " . &GetAttr("LogfileName") . " for Output: $!\n");

   # Form-Parameters in Hash
   foreach $cKey ($hQryMGL->param)
   {
      # FIXME: This makes multiple selections appear, but makes
      #        trouble with some single fields
      $hFormDataMGL{$cKey} = join "\\,", $hQryMGL->param($cKey);
      # $hFormDataMGL{$cKey} = $hQryMGL->param($cKey);
      $cCGIParamKey .= "$cKey=" . $hQryMGL->param($cKey);
   }

   print STDERR $hQryMGL->Dump()
          if &GetAttr("DebugLvl") > 4;

   $cCGIParamKey = $hQryMGL->param? md5_hex($cCGIParamKey) : "0";
   # $cCGIParamKey =~ s/\W//g; # For tests only

   $cCacheFileName = sprintf ('%s/tmp/cache/%s/%s/%s/%s-%s-%s.html',
                              &UnTaint($ENV{"WWWDB_BASE_PATH"}),
                              &GetAttr("DbDriver"),
                              &GetAttr("SessionId"),
                              &GetAttr("ConfigPath"),
                              &MyParam("WWWdbState"),
                              &GetAttr("UrlParams"),
                              $cCGIParamKey),

   $cCacheFileName =~ s/[!\"\\;=&,\']/_/g;

   $iCacheTimeoutMGL = 0;

   &Plugin::_UndefAllPlugins();

   {
      if (&GetAttr("DebugLvl"))
      {
         foreach (keys %ENV)
         {
            print STDERR "ENV->$_ = $ENV{$_}\n";
         }
      }

      my $cBasePath = (&UnTaint($ENV{"WWWDB_BASE_PATH"})?
                       &UnTaint($ENV{"WWWDB_BASE_PATH"}):
                       &UnTaint($ENV{"DOCUMENT_ROOT"}) . "/WWWdb");

      foreach (# the Pre-plugin functionality
               "WWWdb/Pre",

               # Pre-Domain
               ("WWWdb/Pre" .
                (&UnTaint($ENV{"WWWDB_DOMAIN"})?
                 &UnTaint($ENV{"WWWDB_DOMAIN"}):
                 "WWWdb")),

               # Database-related scripts
               ("WWWdb/Db/" .
                (&UnTaint($ENV{"WWWDB_DATABASE"})?
                 &UnTaint($ENV{"WWWDB_DATABASE"}):
                 "Default")),

               # The application-script
               (&UnTaint($ENV{"WWWDB_CONFIG_FILE"})?
                &UnTaint($ENV{"WWWDB_CONFIG_FILE"}):
                "WWWdb/Index"),

               # Post-Domain
               ("WWWdb/Post" .
                (&UnTaint($ENV{"WWWDB_DOMAIN"})?
                 &UnTaint($ENV{"WWWDB_DOMAIN"}):
                 "WWWdb")),

               # the Post-plugin functionality
               "WWWdb/Post")
      {
         my $cConfigFile = &UnTaint($_);

         # If the entry is a directory, use the Index.pl script
         $cConfigFile .= "/Index"
             if(-d sprintf("%s/lib/%s", $cBasePath, $cConfigFile));


         # --- include here your own application-code in the .pl-Source ----------------
         {
            my $cPerlSource = &UnTaint(sprintf("%s/lib/%s.pl",
                                               $cBasePath,
                                               $cConfigFile));

            if (-f $cPerlSource)
            {
               if (-r $cPerlSource)
               {
                  if(eval
                     {
                        do $cPerlSource;
                     })
                  {
                     print STDERR "do $cPerlSource\n"
                         if &GetAttr("DebugLvl") > 2;
                  }
                  else
                  {
                     print STDERR "do $cPerlSource failed\n"
                         if &GetAttr("DebugLvl") > 2;
                  }
               }
               else
               {
                  die(sprintf(i18n("Sorry, but the plugin-source %s ".
                                   "is not readable!"),
                           br() x 2 .
                           (big(b($cPerlSource))) .
                           br() x 2));
               }
            }
         }
      }
   }

   # Actualize the Sym-Table-Cache
   &Plugin::_Init_SymTableCache();

   $Data::Dumper::Indent = 1;      # mild pretty print

   # my $hConfDataMGL = ();
   $cBgColorMGL  = undef;
   $cBgImageMGL  = undef;
   $oFormMGL     = undef;
   $oSessionGL   = undef;
   $oConfPoolGL  = undef;

   {
      my $cPathOfConfigFile =
          &GetAttr("ConfigPath");

      # Remove last element of Path
      $cPathOfConfigFile =~ s./[^/]+..;

      #    ConfigFileName                    ReadOnly  MustExist
      my @lConfigFileData =
          (["WWWdb/Pre",                            1, 0],
           ["WWWdb/Pre" . &GetAttr("WWWdbDomain"),  1, 0],
           [&GetAttr("ConfigPath"),                 0, 1],
           ["WWWdb/Db/" . &GetAttr("DbDriver"),     1, 1],
           ["WWWdb/Post" . &GetAttr("WWWdbDomain"), 1, 0],
           ["WWWdb/Post",                           1, 0]);

      my $cConfigFileEntry;

      $oConfPoolGL = ConfigPool->new("DebugLvl" => &GetAttr("DebugLvl"));

      foreach $cConfigFileEntry (@lConfigFileData)
      {
         my $oConfigFile;
         my $cConfigFilename = sprintf("%s/lib/%s.rc",
                                       &GetAttr("BaseDir"),
                                       $cConfigFileEntry->[0]);

         if((! -f $cConfigFilename) && $cConfigFileEntry->[2])
         {
           die(sprintf(i18n("Sorry, but the config-file %s does not exist!"),
                           br() x 2 .
                           (big(b($cConfigFilename))) .
                           br() x 2));
         }

         if((! -r $cConfigFilename) && $cConfigFileEntry->[2])
         {
            die(sprintf(i18n("Sorry, but the config-file %s is not readable!"),
                           br() x 2 .
                           (big(b($cConfigFilename))) .
                           br() x 2));
         }

         $oConfigFile = ConfigFile->new
             ($cConfigFilename,
              "ReadOnly"  => $cConfigFileEntry->[1],
              "MustExist" => $cConfigFileEntry->[2],
              "DebugLvl"  => 0
              );

         $oConfPoolGL->addConfigFile($oConfigFile);

      }
   }

   $oConfPoolGL->Dump()
       if &GetAttr("DebugLvl");


   $iCacheTimeoutMGL = &MyVal('Cache', 'Timeout', 0);

   if ($iCacheTimeoutMGL)
   {
      &CGI::Cache::SetFile($cCacheFileName, $iCacheTimeoutMGL);
      &CGI::Cache::Start();
   }
   else
   {
      $hQryMGL->cache("no");
   }
}




# --- Main-Routine -----------------------------------------------------------
sub Main()
{
   my $cBtn;

   # set real uid to effective uid
   # $< = $>;
   # set real gid to effective gid
   # $( = $);

   &InitVars();

   &InitDb();
   &InitForm();

   &DebugFormData()
       if &GetAttr("DebugLvl") > 2;

   printf STDERR "Config-file: %s\n", &GetAttr("ConfigPath")
       if &GetAttr("DebugLvl") > 2;

   &MyParam("WWWdbLastUrlParam", &GetAttr("UrlParams"))
       if &GetAttr("UrlParams") > 2;

   printf STDERR "URL-Params: %s\n", &MyParam('WWWdbLastUrlParam')
       if &GetAttr("DebugLvl") > 2;

   $cBtn = &GetAttr("LastBtn");

   # Another language was choosen
   if ($cBtn =~ /^Btn_SelLang$/)
   {

      # in anonymous-mode: change the session-id
      if($oSessionGL->getState("IsAnonymous"))
      {
         my $iNewSessionId;

         # get the anonymous-session-id for the new language
         $iNewSessionId = $oDbSessionGL->SqlSelect
             ("SELECT
                  s1.session_id
               FROM
                  wwwdb_state s1,
                  wwwdb_state s2
               WHERE
                  s1.key_name    = '[WWWdb] Lang' AND
                  s1.key_value   = ?              AND
                  s2.key_name    = 'IsAnonymous'  AND
                  s2.key_value  != ''             AND
                  s1.session_id  = s2.session_id",
              &GetField("_SelLang"))->[0]->[0];

         &Redirect($iNewSessionId, "WWWdb:Index")
             if $iNewSessionId;
      }
      # change the preferences
      else
      {

         $oSessionGL->setState("[WWWdb] Lang",
                               &GetField("_SelLang"));

# FIXME: This does not work here :-( don't know why (yet)
#         print &Redirect(&GetAttr("SessionId"),
#                         (&GetAttr("ConfigFile") .
#                          ";" .
#                          &MyParam('WWWdbLastUrlParam')));

         &OkForm("", i18n("Language will change " .
                          "after pressing the OK-button!"));
         &MyExit();
      }
   }

   # Search for a word
   elsif ($cBtn =~ /^Btn_Search$/ || &GetField("_Search"))
   {

      {
         &Redirect(&GetAttr("SessionId"),
                   ("WWWdb:Nav;sword=*" .
                    &GetField("_Search") .
                    "*"));
      }
   }

   Plugin->new("PreDoAction")->Call();

   &HavePermissionToRun();

   # decide what to do next
   &FindActionToDo();

   &MyExit();
}


# --- Initialize data in form ------------------------------------------------
sub InitDb ()
{
   my $cKey;
   my @lDateScanFormats = &MyListVal('DB', 'DateScanFormats');

   # set params for DBIx::Recordset
   &MyParam("!Database", &MyVal('DB', 'Database') )
       if !defined($hFormDataMGL{"!Database"});

   &MyParam("!Username", &MyVal('DB', 'Username'))
       if !defined($hFormDataMGL{"!Username"});

   &MyParam("!Password", &MyVal('DB', 'Password'))
       if !defined($hFormDataMGL{"!Password"});

   # --- Database-specific options -------------------------------------------
   $oDbSessionGL = DbSession->new
       (&MyVal('DB', 'Driver', 'Default'), # FIXME: Replace Default
        &MyParam("!Database"),
        &MyParam("!Username"),
        &MyParam("!Password"),
        "DbHost"          => &MyVal('DB', 'Host', "localhost"),
        "DebugLvl"        => &GetAttr("DebugLvl"),
        "Lang"            => &GetAttr("BaseLang"),
        "DatePrintFormat" => i18n(&MyVal('DB', 'DatePrintFormat',
                                         "%Y-%m-%d %H:%M:%S")),
        (@lDateScanFormats ?
         ("DateScanFormats" => \@lDateScanFormats):
         undef));

   # check for a target database
   if (&MyVal('TargetDB', 'Database'))
   {
      # set params for DBIx::Recordset
      &MyParam("!Database", &MyVal('TargetDB', 'Database'));
      &MyParam("!Username", &MyVal('TargetDB', 'Username'));
      &MyParam("!Password", &MyVal('TargetDB', 'Password'));

      $oDbTargetGL = DbSession->new
          (&MyVal('DB', 'Driver', 'Default'),
           &MyParam("!Database"),
           &MyParam("!Username"),
           &MyParam("!Password"),
           "DbHost"          => &MyVal('TargetDB', 'Host', "localhost"),
           "DebugLvl"        => &GetAttr("DebugLvl"),
           "Lang"            => &GetAttr("BaseLang"),
           "DatePrintFormat" => i18n(&MyVal('TargetDB', 'DatePrintFormat',
                                            "%Y-%m-%d %H:%M:%S")),
           (@lDateScanFormats ?
            ("DateScanFormats" => \@lDateScanFormats):
            undef));
   }
   else
   {
      $oDbTargetGL = $oDbSessionGL;
   }

   &MyParam("!DataSource", $oDbTargetGL->getDataSource());

   # make a standard connection to the database
   $pDbHdlMGL = $oDbSessionGL->getDbHandle();

   &Error(sprintf(i18n("The Id-Field (which defines a global unique " .
                       "key for every record in the database " .
                       "is not set!") .
                  "<BR><BR>" .
                  i18n("Insert the correct name of the id-field " .
                       "in the config-file " .
                       "under the section %s with:") .
                  "<BR>" .
                  "%s",
                  b("[DB]"),
                  b("IdField = <name><BR>")))
    if !&GetAttr("RecIdField");

}


# --- initialize data for DBIx::Recordset -----------------------------------
sub InitDBIxRecordset()
{
   *DBIx::Recordset::LOG   = \*STDERR;
   $DBIx::Recordset::Debug = &GetAttr("DebugLvl")? 3: 1;

   &MyParam('$max', &MyVal('Browser', 'MaxRows', 5));
   &MyParam('$valuesplit', ",");
   &MyParam('$compconj',   "and");
   &MyParam('!DBIAttr', {LongReadLen => 256 * 1024,
                         LongTruncOk => 1});

   &MyParam('$start', "0")
       unless &MyParam('$start');

   &MyParam("!Table", &MyVal('Data', 'Table'));

   &MyParam("!Order", &MyVal('Data', 'Order', ''))
       unless defined &MyParam('!Order');

   # 0 -> undef = SQL:NULL
   # 1 -> undef fields are ignored,
   # 2 -> undef or empty fields are ignored
   &MyParam("!IgnoreEmpty", "0"); # FIXME: IgnoreEmpty

}


# --- Initialize form-data --------------------------------------------------
sub InitForm ()
{
   my $cKey;
   my $cBtn;

   $oSessionGL = Session->new($pDbHdlMGL,
                              "Id"       => &GetAttr("SessionId"),
                              "Length" => 16,
                              "DebugLvl" => &GetAttr("DebugLvl")) or
       die i18n("Could not get the session-id!");

   # the Id we already have is invalid
   # let's take the id from $oSessionGL
   if(&GetAttr("SessionId") ne $oSessionGL->getId())
   {

      &Redirect($oSessionGL->getId(), "WWWdb:Index");

   }

   # What was the last submit-button, that triggered this page
   foreach $cKey (keys %hFormDataMGL)
   {

      # Check the pressed Button (handle images also)
      if ($cKey =~ /^(Btn.*?)(\.[xy])?$/)
      {
         printf STDERR i18n("Button %s pressed") . "<BR>\n", $1
             if &GetAttr("DebugLvl") > 1;

         $cBtn = $1;
         &MyParamDelete($1);
         &MyParam("WWWdbLastBtn", $1);
      }
   }

   &MyParam("WWWdbState", "Init")
          if !defined($hFormDataMGL{"WWWdbState"});
   &MyParam("WWWdbSubState", "")
          if !defined($hFormDataMGL{"WWWdbSubState"});

#   &MyParam("WWWdbLastUrlParam", &GetAttr("UrlParams"))
#       if (!defined($hFormDataMGL{"WWWdbLastUrlParam"}));

   $cBgColorMGL = &MyUserVal('GUI', 'BgColor', undef);
   $cBgImageMGL = &MyVal('GUI', 'BgImage', undef);

   &setLanguage(&GetAttr("BaseDir") . "/locale",
                &GetAttr("Lang"));

} # sub InitForm


sub setLanguage($)
{
   my $cLocaleDir = shift;
   my $cLang      = shift;
   my $cPath      = "$cLocaleDir/$cLang";

   tie(%hMessagesGL, "DB_File", $cPath, O_RDONLY, 0644) ||
       die ("Cannot open language file $cPath");
}


# --- Check if this application has the permission to run ------------------
sub HavePermissionToRun () # Db Session
{
   my $cAttribs;
   my $iObjectId  = &GetObjectId();
   my $bInSSlMode = &UnTaint($ENV{"HTTPS"})? 1: 0;
   my $bNeedSSl   = 0;
   my $cUseSSl    = &MyVal('WWWdb', 'UseSSL', "NEVER");


   $cAttribs = ($oDbSessionGL->SqlSelect
                ("SELECT
                    attribs
                  FROM
                    wwwdb_object
                  WHERE
                    id_object = ?",
                 defined $iObjectId? $iObjectId: 0))->[0]->[0];

   switch: for ($cUseSSl)
   {
      /^ALWAYS$/i && do {

         $bNeedSSl = 1;
         last switch;
      };

      /^STAY$/i && do {

         $bNeedSSl   = ((&IsAttribOK($cAttribs, "IsSSL" => 0) !=
                         &IsAttribOK($cAttribs, "IsSSL" => 1)) ||
                        $bInSSlMode);
         last switch;
      };

      /^APP_ONLY$/i && do {

         $bNeedSSl   = (&IsAttribOK($cAttribs, "IsSSL" => 0) !=
                        &IsAttribOK($cAttribs, "IsSSL" => 1));

         last switch;
      };

      do {

         $bNeedSSl = 0;
         last switch;
      };
   }

   if($cAttribs && defined $oSessionGL)
   {
      if((&IsAttribOK($cAttribs, "IsAdmin" => 0) !=
          &IsAttribOK($cAttribs, "IsAdmin" => 1)) &&
         (!$oSessionGL->getState("ActualLogin")))
       {
          &Error(sprintf(i18n("Please %s first!"),
                         &ResolveRefField("wwwdb://WWWdb:System:Login",
                                          i18n("login"))));
      }
   }

   if(!&IsAttribOK($cAttribs))
   {
      if($cAttribs =~ "ActualLogin")
      {
         &Error(sprintf(i18n("Please %s first!"),
                        &ResolveRefField("wwwdb://WWWdb:System:Login",
                                         i18n("login"))));
      }
      else
      {
         &Error(i18n("Sorry, you are not permitted, to run this application!"));
      }
   }

   printf STDERR ("bNeedSSl: %d bInSSlMode: %d\n",
                  $bNeedSSl, $bInSSlMode);

   # Do we have to change the encryption?
   if($bNeedSSl != $bInSSlMode)
   {

      $ENV{"HTTPS"} = $bNeedSSl;

      &Redirect(&GetAttr("SessionId"),
                &GetAttr("ConfigFile") . ";" .
                &GetAttr("UrlParams"));
   }

}



# --- Show, what params came from last post ----------------------------------
sub DebugFormData() # Form CGI
{
   my $cEntry;

   printf STDERR (p("Form-data:"), hr({-noshade => 1,
                                       -size => 1}));

   foreach $cEntry (sort keys %hFormDataMGL)
   {
      printf STDERR "$cEntry=".&MyParam($cEntry)."<BR>\n";
   }
   printf STDERR  hr({-noshade => 1,
                      -size => 1});

} # sub DebugFormData



# --- Now let's look, what to do  --------------------------------------------
sub FindActionToDo() # Control
{
   my $bBtnFound = 0;
   my $cBtn;
   my $cDefaultButton;
   my $cEntry;
   my $cKey;
   my $cParamBtnName;
   my $cSection;
   my $oBtnPlugin;

   $cBtn = &GetAttr("LastBtn");

   # look for a param in the uri
   if(!$cBtn)
   {

      my $cUrlParams = &GetAttr("UrlParams");
      my @lUrlParams = split ";", $cUrlParams;

      foreach (@lUrlParams)
      {
         my $iId = 0;

         $iId = $1
             if (/^id=([^;]+)/);

         if ($iId)
         {
            $cBtn = "BtnSelect" . $iId;
            # &MyParam("BtnSelect" . $iId, $iId);
            &MyParam("WWWdbLastBtn",
                     "BtnSelect" . $iId);
         }
      }
   }

   # try to assign a default-button
   unless ($cBtn)
   {
       my %hBtnMap = ("Init" => "BtnQry",
                      "Work" => "BtnUpd");

       if(defined $hBtnMap{&MyParam("WWWdbState")})
       {

           printf STDERR "State:%s, Btn:%s\n",
           &MyParam("WWWdbState"),
           $hBtnMap{&MyParam("WWWdbState")};

           $cBtn = &MyParam("WWWdbState")
               if (&MyVal("State ". $hBtnMap{&MyParam("WWWdbState")},
                          &MyParam("WWWdbState")) ne "-");
       }
   }

   # Change the sort-order
   if ($cBtn =~ /^BtnSort(.*)$/)
   {
      my $cCurrOrder = &MyParam("!Order");
      my $cNewOrder  = $1;

      if (&GetField("_ResetSort"))
      {
         $cCurrOrder = "";
      }

      if ($cCurrOrder =~ m/$cNewOrder desc$/)
      {
         $cCurrOrder =~ s/ desc$//;
         &MyParam("!Order", $cCurrOrder);
      }
      # reverse sort_order if it ends with the same field
      elsif ($cCurrOrder =~ m/$cNewOrder$/)
      {
         &MyParam("!Order", $cCurrOrder . " desc");
      }
      # re-arrange the sort-order
      else
      {
         $cCurrOrder = ""
             if $cCurrOrder =~ m/$cNewOrder/;

         &MyParam("!Order", ($cCurrOrder? "$cCurrOrder, ": "") . $cNewOrder);
      }

      &MyParamDelete($cBtn);

      $cBtn = "BtnQry";
      &MyParam($cBtn, "Query");
      &MyParam("WWWdbLastBtn", $cBtn);
   }
   # catch dynamic generated Buttons
   elsif ($cBtn =~ /^BtnSelect(.+)$/)
   {
      my @lKeyValues = split /,/, $1;
      my @lKeyFields  = split /, /, &GetAttr("RecIdField");
      my $iInd;

      # scan multiple primary-keys
      for ($iInd = 0; $iInd <= $#lKeyValues; $iInd ++)
      {
         # Set Record-Id
         &MyParam("Fld" . $lKeyFields[$iInd],
                  $lKeyValues[$iInd]);

      }

      &MyParamDelete($cBtn);

      $cBtn = "BtnSelect";
      &MyParam($cBtn, "Select");
   }

   $oBtnPlugin = Plugin->new("$cBtn",
                             "HasPrePost" => 1,
                             "HasMy"      => 1)
       if $cBtn;

   # First look for all default-Buttons
   foreach $cDefaultButton ("BtnNew",
                            "BtnDel",
                            "BtnQry",
                            "BtnUpd",
                            "BtnSelect",
                            "BtnCancel",
                            "BtnExit",
                            "BtnHelp",
                            "BtnOk")
   {
      if ($cBtn eq $cDefaultButton)
      {
         $bBtnFound = 1;

         $oBtnPlugin->Call();
         Plugin->new($cBtn . "Redisplay")->Call();
      }
   }

   if(!$bBtnFound)
   {
      # Scan all sections
      foreach $cSection ($oConfPoolGL->getSectionNames())
      {
         # Scan all parameters of section
       PARAM:
         foreach $cParamBtnName ($oConfPoolGL->getEntryNames($cSection))
         {

            # only interested in the Btn... = ... -Parameters
            next
                if ($cParamBtnName !~ /^Btn.*/);

            if ($cBtn eq $cParamBtnName)
            {
               $bBtnFound = 1;

               $oBtnPlugin->Call();
            }
         } # foreach $cParam
      } # foreach $cSection
   }

   if (!$bBtnFound)
   {
      # Try to start cBtn's plugin
      $oBtnPlugin->Call()
          if defined $oBtnPlugin;

      # We are in (special) browse mode
      if(&MyParam("WWWdbState") eq "Qry")
      {
         &BtnQry();
      }
      else
      {
         # Any other "unknown" mode
         &GenPage();
      }
   }

   &MyParamDelete($cBtn);

   &SaveState();

}



# --- Insert-Button pressed --------------------------------------------------
sub BtnNew () # Trigger
{
   &MyParam("WWWdbState", "Init");

   if (!&GetAttr("RecordOk")) {
      &GenPage();
   }
   else {

      &NewRecord();
   }

}


sub BtnNewRedisplay() # Trigger
{
  if (&GetAttr("RecordOk"))
  {
     &ClearFields();

     # confirm insertion eventually
     if(!&MyUserVal("GUI", "DontConfirmAfterInsert", ""))
     {
        &OkForm("", i18n("Record inserted!"));
     }
     else
     {
        &GenPage();
     }
  }
}


# --- OK-button pressed ------------------------------------------------------
sub BtnOk () # Trigger
{
   &GenPage();
}


# --- Delete-button pressed --------------------------------------------------
sub BtnDel () # Trigger
{
  &MyParam("WWWdbState", "Init");
  &DelRecord();
}

sub BtnDelRedisplay () # Trigger
{
   &ClearFields();
   &MyParamDelete("BtnDel");

   # confirm insertion eventually
   if(!&MyUserVal("GUI", "DontConfirmAfterDelete", ""))
   {
      &OkForm("", i18n("Record deleted!"));
   }
   else
   {
      &GenPage();
   }
}



# --- Query-button pressed ---------------------------------------------------
sub BtnQry () # Trigger
{
   &MyParam("WWWdbState", "Qry");
   &QryData();
}


# --- Update-button pressed --------------------------------------------------
sub BtnUpd () # Trigger
{
   &MyParam("WWWdbState", "Work");

   if (!&GetAttr("RecordOk")) {
      &GenPage();
   }
   else {

      &UpdRecord();
      &MyParam("WWWdbState", "Init");
   }

}

sub BtnUpdRedisplay () # Trigger
{
   if (!&GetAttr("RecordOk")) {
      # Update Button has to be changed to Select, as like the record
      # has been selected in the last cycle
      &MyParamDelete("BtnUpdate");
      &MyParam("BtnSelect", "Select");

      &MyParam("WWWdbState", "Work");

      &GenPage();
   }
   else
   {

      &ClearFields();

      # eventually confirm update
      if(!&MyUserVal("GUI", "DontConfirmAfterUpdate", ""))
      {
         &OkForm("", "Record changed!");
      }
      else
      {
         &GenPage();
      }
   }
}


# --- This button was generated dynamically ----------------------------------
sub BtnSelect () # Trigger
{
   &MyParam("WWWdbState", "Work");

   &FetchRecord();
}

sub BtnSelectRedisplay () # Trigger
{
   &GenPage();
}


# --- Cancel-button pressed --------------------------------------------------
sub BtnCancel () # Trigger
{
   &MyParam("WWWdbState", "Init");
}


sub BtnCancelRedisplay () # Trigger
{
   &ClearFields();
   &GenPage();
}


# --- Exit-button pressed --------------------------------------------------
sub BtnExit () # Trigger HTML
{
    &Redirect(&GetAttr("SessionId"), "WWWdb:Index");
}


# --- Help-button pressed ----------------------------------------------------
sub BtnHelp () # Trigger HTML
{
   &Redirect(&GetAttr("SessionId"),
             ("WWWdb:Tools:ShowDoc;id=,help," .
              lc(&GetAttr("State")) .
              "-mode"));
}


# --- closure for %hCategories
sub _GetCatInfo {

   # --- Create a navigation-list in first column ---------------------------
   sub GetCatInfo() # HTML Nav
   {
      my $cEntry;
      my $cLinkKey;
      my $cResult;
      my $cUrlParams = &GetAttr("UrlParams");
      my $iActualId;
      my $iCategory = 0;
      my $iInd;
      my $lRecord;
      my @lCatPath = ();
      my @lFields;
      my @lIdChain;
      my @lIdNames;
      my @lUrlParams = split ";", $cUrlParams;
      my $iLevel;
      my $iSortNr;
      my $iId;

      return %hCategoriesGL
          if %hCategoriesGL;

      # FIXME: Use GetObjectId
      return
          unless defined $oDbSessionGL;

      # Generate a path upwards
      $cResult = "";

      # the url-param overloads the value of the form
      foreach (@lUrlParams)
      {

         $iCategory = $1
             if (/^cat=(\d+)/);
      }

      $cLinkKey = ("wwwdb://" .
                   ($iCategory?  "WWWdb:Nav": &GetAttr("ConfigFile")) .
                   ($cUrlParams? (";" . $cUrlParams): ""));

      # get category-info
      $iCategory = $oDbSessionGL->SqlSelect
          ("SELECT
                cat.id_category
            FROM
                wwwdb_category cat,
                wwwdb_obj_cat  oc,
                wwwdb_object   obj
            WHERE
                cat.id_category = oc.id_category AND
                oc.id_object    = obj.id_object  AND
                obj.ref_link    = ?",
           $cLinkKey)->[0]->[0]
              unless $iCategory;

      # we had no success ... lets try it without the url-parameters
      unless ($iCategory)
      {

         $cLinkKey = ("wwwdb://" .
                      &GetAttr("ConfigFile"));

         # get category-info
         $iCategory = ($oDbSessionGL->SqlSelect
                       ("SELECT
                             cat.id_category
                         FROM
                             wwwdb_category cat,
                             wwwdb_obj_cat  oc,
                             wwwdb_object   obj
                         WHERE
                             cat.id_category = oc.id_category AND
                             oc.id_object    = obj.id_object  AND
                             obj.ref_link    = ?",
                        $cLinkKey))->[0]->[0];
      }

      push @lCatPath, $iCategory
          if $iCategory;

      push @lCatPath, &MyVal('WWWdb', 'DefaultCat', 0)
          if &MyVal('WWWdb', 'DefaultCat', 0);

      # this are the default-categories
      push @lCatPath, 10000, 1;

      # Try the categories in the sequence <found>, default-user, default-sys
      foreach (@lCatPath)
      {

         # get category-info
         $cEntry = ($oDbSessionGL->SqlSelect
                    ("SELECT
                        cat.id_category,
                        cat.id_cat_of_cat,
                        cat.name,
                        cat.id_chain,
                        cat.name_chain,
                        cat.sort_nr,
                        cat.attribs,
                        tr1.trans_text   AS name_tra,
                        tr2.trans_text   AS name_chain_tra
                      FROM
                        wwwdb_category    cat,
                        wwwdb_translation tr1,
                        wwwdb_translation tr2
                      WHERE
                        cat.id_category       = ?           AND
                        cat.name_txt_id       = tr1.id_text AND
                        cat.name_chain_txt_id = tr2.id_text AND
                        tr1.lang              = ?           AND
                        tr2.lang              = tr1.lang
                      ORDER BY
                        cat.sort_nr",
                     $_,
                     &GetAttr("Lang")))->[0];

         if (defined $cEntry)
         {
            $iCategory = $_;
            last;
         }
      }

      die sprintf i18n("No wwwdb_category record with id=%s found! " .
                       " Please insert."),
          $iCategory
              unless defined $cEntry;

      @lFields  = @{$cEntry};

      @lIdChain = split /,/, $lFields[3];
      @lIdNames = split /,/, ($lFields[8] eq "?" ?
                              $lFields[4]:
                              $lFields[8]);

   #   pop @lIdChain;
   #   pop @lIdNames;

      for ($iInd = 0; $iInd < (@lIdChain); $iInd++)
      {
         $hCategoriesGL{$iInd}{-999}{$lIdChain[$iInd]} = $lIdNames[$iInd];
      }

      # subcategories of this (and upper) category
      {
         # use -999 as a non-existent dummy-value when we are on top
         my $iParentCat   = ((@lIdChain > 1)?
                             $lIdChain[-2]:
                             -999);

         # read sub-categories from database
         $lRecord = $oDbSessionGL->SqlSelect
             ("SELECT
                   ca0.id_category,
                   ca0.name,
                   ca0.sort_nr,
                   ca0.attribs,
                   tra.trans_text as tra_name,
                   ca0.id_cat_of_cat
               FROM
                   wwwdb_category     ca0,
                   wwwdb_category     ca1,
                   wwwdb_translation  tra
               WHERE
                   ca1.id_category        = ca0.id_category    AND
                   (ca0.id_cat_of_cat      = ?  OR
                    ca0.id_cat_of_cat      = ?)                AND
                   (ca1.nr_of_subcats + ca0.nr_of_objs) > 0    AND
                   ca0.name_txt_id        = tra.id_text        AND
                   tra.lang               = ?
               ORDER BY
                   ca0.sort_nr",
              $iCategory,
              $iParentCat,
              &GetAttr("Lang"));

         # generate them
         foreach (@$lRecord)
         {
            my $lFields;
            my $iDelta;

            @lFields = @{$_};

            next
                if(!&IsAttribOK($lFields[3],
                                "IsHidden" => 0));

            if($lFields[5] == $iParentCat)
            {

               $iDelta = -1;
            }
            else
            {
               $iDelta = 0;
            }

            $hCategoriesGL{$iInd + $iDelta}{$lFields[2]}{$lFields[0]} =
                ($lFields[4] eq "?" ?
                 $lFields[1]:
                 $lFields[4]);
         }
      }

      foreach $iLevel (sort {$a <=> $b} keys %hCategoriesGL)
      {

         foreach $iSortNr (sort {$a <=> $b} keys %{$hCategoriesGL{$iLevel}})
         {

            foreach $iId (sort {$a <=> $b} keys %{$hCategoriesGL{$iLevel}{$iSortNr}})
            {
               print STDERR "**" x $iLevel . "$iLevel>$iSortNr>$iId iId => " . $iId .
                   " $hCategoriesGL{$iLevel}{$iSortNr}{$iId}\n";
            }

         }
      }

      return %hCategoriesGL;

   }

}


# --- obsolete Create a navigation-list in first column ---------------------
sub FirstColumn() # HTML Nav
{
   my $cResult = "";

   $cResult .= &HierarchyForm();

   $cResult .= &SubCategoriesForm();

   $cResult .= &LoginForm();

   $cResult .= &SearchForm();

   $cResult .= &LangForm();

   return $cResult;
}


# --- Form for the hierarchy-information ------------------------------------
sub HierarchyForm()
{
   my %hCategories = &GetCatInfo();
   my $iLevel;
   my $iSortNr;
   my $iId;
   my $cResult;
   my $iIgnoreLevel;
   my $iNrOfEntries =0;

   my $oHtmlTableHier  = HTML::Table->new
       (BorderPar      => 0,
        CellpaddingPar => 0);

   # find highest level of hierarchy
   LEVEL:
   foreach $iLevel (sort {$b <=> $a} keys %hCategories)
   {
      foreach $iSortNr (keys %{$hCategories{$iLevel}})
      {
         if($iSortNr == -999)
         {
            $iIgnoreLevel = $iLevel + 1;
            last LEVEL;
         }
      }
   }

   my @lLevel = (sort {$a <=> $b} keys %hCategories);

   # remove last hierarchy, because it is used by SubCategoriesForm
   # $iIgnoreLevel = pop @lLevel;

   foreach $iLevel (@lLevel)
   {
      foreach $iSortNr (sort {$a <=> $b} keys %{$hCategories{$iLevel}})
      {

         # Skip the hier-entries of the lowest two levels
         next
             if ((($iSortNr == -999) &&
                 ($iLevel  >= $iIgnoreLevel - 1)) ||
                 ($iLevel  >= $iIgnoreLevel));

         foreach $iId (sort {$a <=> $b} keys %{$hCategories{$iLevel}{$iSortNr}})
         {
            print STDERR "HHH" x $iLevel . "$iLevel.$iSortNr.$iId iId => " . $iId .
                " $hCategories{$iLevel}{$iSortNr}{$iId}\n";

            $oHtmlTableHier->Element
                (HTML::Table::APPEND,
               HTML::TableRow->new());

            $oHtmlTableHier->Element
                (HTML::Table::CURRENT, $iLevel + 1, $iLevel + 1,
                 small(b(&ResolveRefField
                         (sprintf("wwwdb://WWWdb:Nav;cat=%s",
                                  $iId),
                          $hCategories{$iLevel}{$iSortNr}{$iId}))));

            $oHtmlTableHier->Element
                (HTML::Table::CURRENT,
               HTML::Table::CURRENT)->setColspanPar(99);

            $iNrOfEntries ++;
         }

      }
   }

   $cResult .= &FormTempl(i18n("Hierarchy:"),
                          $oHtmlTableHier->HtmlCode())
       if $iNrOfEntries;

   return $cResult;

}


# --- Form for the current access-path --------------------------------------
sub PathForm(;$$$)
{
   my $cPreTextPI   = shift || " [";
   my $cDelimTextPI = shift || "] [";
   my $cPostTextPI  = shift || "] ";

   my %hCategories = &GetCatInfo();
   my $iLevel;
   my $iSortNr = -999;
   my $iId;
   my $cResult;

   my @lLevel = (sort {$a <=> $b} keys %hCategories);

   foreach $iLevel (sort {$a <=> $b} keys %hCategories)
   {
      foreach $iSortNr (keys %{$hCategories{$iLevel}})
      {
         foreach $iId (sort {$a <=> $b} keys %{$hCategories{$iLevel}{$iSortNr}})
         {
            $cResult .=
                (($cResult? $cDelimTextPI: "") .
                 &ResolveRefField
                 (sprintf("wwwdb://WWWdb:Nav;cat=%s",
                          $iId),
                  $hCategories{$iLevel}{$iSortNr}{$iId}))
                    if $iSortNr == -999;

         }

      }
   }

   $cResult = &ResolveRefField("wwwdb://WWWdb:Index", "WWWdb")
       unless $cResult;

   return $cPreTextPI . $cResult . $cPostTextPI;

}


# --- Form for the actual subcategories -------------------------------------
sub SubCategoriesForm()
{
   my $cBullet;
   my $cResult;
   my $iId;
   my $iLevel    = undef;
   my $iMaxLevel = undef;
   my $iNrOfSubcats = 0;
   my $iSortNr;
   my %hCategories = &GetCatInfo();

   my $oHtmlTableSubCat  = HTML::Table->new
       (BorderPar      => 0,
        CellpaddingPar => 0);

   # find highest level of hierarchy
   LEVEL:
   foreach $iLevel (sort {$b <=> $a} keys %hCategories)
   {
   print STDERR "CCC: iLevel = $iLevel\n";
      foreach $iSortNr (keys %{$hCategories{$iLevel}})
      {
         print STDERR "CCC: iSortNr = $iSortNr\n";
         if($iSortNr == -999)
         {
            $iMaxLevel = $iLevel + 1;
            last LEVEL;
         }
      }
   }

   print STDERR "CCC: iMaxLevel = $iMaxLevel\n";

   $cBullet = (&GenImage(&MyVal('Layout Table', 'Bullet1stCol', ""),
                            "", 0) or
                  &MyVal('Layout Table', 'Bullet1stCol', "-"));

   foreach $iSortNr (sort {$a <=> $b} keys %{$hCategories{$iMaxLevel}})
   {
      next
          if ($iSortNr == -999);

      foreach $iId (sort {$a <=> $b} keys %{$hCategories{$iMaxLevel}{$iSortNr}})
      {
         print STDERR "CCC" x $iMaxLevel . "$iMaxLevel.$iSortNr.$iId iId => " . $iId .
             " $hCategories{$iMaxLevel}{$iSortNr}{$iId}\n";

         $oHtmlTableSubCat->Element
             (HTML::Table::APPEND,
            HTML::TableRow->new());

         $oHtmlTableSubCat->Element
             (HTML::Table::CURRENT, $iMaxLevel, $iMaxLevel + 1, $cBullet);

         $oHtmlTableSubCat->Element
             (HTML::Table::CURRENT, $iMaxLevel + 1, $iMaxLevel + 1,
              small(b(&ResolveRefField
                      (sprintf("wwwdb://WWWdb:Nav;cat=%s",
                               $iId),
                       $hCategories{$iMaxLevel}{$iSortNr}{$iId}))));

         $oHtmlTableSubCat->Element
             (HTML::Table::CURRENT,
            HTML::Table::CURRENT)->setColspanPar(99);

         $iNrOfSubcats ++;
      }

   }

   $cResult .= &FormTempl(i18n("Sub-categories:"),
                          $oHtmlTableSubCat->HtmlCode())
       if $iNrOfSubcats;

   return $cResult;
}



# --- Form for searching the site -------------------------------------------
sub SearchForm()
{
   my $cResult = "";
   my $cHeader = "";


   $cHeader = i18n("Site-Search:");

   $cResult .= (textfield (-name      => "Fld_Search",
                           -maxlength => "100",
                           -size      => "10",
                           -tabindex  => 9999));

   $cResult .= "&nbsp;";

   $cResult .= &SubmitButton("Btn_Search",
                             &EncodeHtml(i18n("Search")));

   $cResult = &FormTempl($cHeader, $cResult);

   return $cResult;
}

# --- Form for user-login --------------------------------------------------
sub LoginForm()
{
   my $cResult = "";
   my $cHeader = "";

   if(&IsAttribOK("ActualLogin") &&
      defined $oSessionGL        &&
      !$oSessionGL->getState("IsAnonymous"))
   {
      my $cUserName;
      my $cPassword;

      ($cUserName, $cPassword) = split /,/, $oSessionGL->getState("login");

      $cHeader = sprintf(i18n("Logged in as %s"),
                         b($cUserName));

      $cResult .= ((&ResolveRefField("wwwdb://WWWdb:System:Logout",
                                       i18n("Logout"))));
   }
   else
   {
      $cHeader = i18n("Not logged in.");
      $cResult .= ((&ResolveRefField("wwwdb://WWWdb:System:Login",
                                       i18n("Login"))));
   }

   $cResult = &FormTempl($cHeader, center($cResult));

   return $cResult;
}

# --- Form for language-selection -------------------------------------------
sub LangForm()
{
   my $cResult = "";
   my $lLang;
   my $cHeader = "";

   $lLang = $oDbSessionGL->SqlSelect
       ("SELECT
             key_value, label, sort_nr
         FROM
            wwwdb_lookup
         WHERE
            lang     = 'en'          AND
            key_name = 'lang_select'
         ORDER BY
            sort_nr");

   # Select the language
   if (@$lLang > 1)
   {
      my $cLang;
      my %hLabels = ();
      my @lListValues = ();

      $cHeader = i18n("Language-Select:");


      # Split the Value,Label list in two Arrays
      foreach $cLang (@$lLang)
      {
         push @lListValues, $cLang->[0];
         $hLabels{$cLang->[0]} = $cLang->[1];
      }

      $cResult .= (scrolling_list(-name      => "Fld_SelLang",
                                  -values    => \@lListValues,
                                  -labels    => \%hLabels,
                                  -default   => &GetAttr("Lang"),
                                  -override  => 1,
                                  -size      => "1"));

      $cResult .= &SubmitButton("Btn_SelLang",
                                &EncodeHtml("<<"));


   }

   $cResult = &FormTempl($cHeader, center($cResult));

   return $cResult;
}



# --- Generate a HTML-Container for some Data -------------------------------
sub FormTempl($$)
{
   my $cHeaderPI  = shift;
   my $cContentPI = shift;
   my $cResult = "";

   if($cContentPI)
   {
      my $oTemplate = HTML::Template->new
          (filename => (&GetAttr("BaseDir") .
                        &MyVal('WWWdb', "NavTemplate",
                               "/lib/WWWdb/Templ/Tmpl_WWWdbNav.html")),
           die_on_bad_params => 0);


      # fill in some parameters
      $oTemplate->param(HEADER       => $cHeaderPI,
                        CONTENT      => $cContentPI);

      $cResult = $oTemplate->output;
   }
}




=head2 ClearFields - clear all entry-fields

=over 2

=item B<DESCRIPTION>

Clears all entry-fields in the Form which were defined via
[Layout\ Field\ ...] entries.

=item B<SYNOPSIS>

ClearField();

=item B<RETURN VALUE>

None.

=item B<EXAMPLE>

 # Clear all fields to blank
 &ClearFields();

=item B<SEE ALSO>

SetField

=back

=cut

# --- Clear all user Fields --------------------------------------------------
sub ClearFields() # CGI Form
{
   my $cEntry;

   foreach $cEntry (keys %hFormDataMGL)
   {
      if ($cEntry =~ /^Fld(.*)$/)
      {
         &MyParamDelete($cEntry);
         &MyParamDelete($1);
      }
   }
}

# --- generate a error-message ------------------------------------------------
sub DbiErrorAndExit ($) # Db HTML
{

   my $cSqlOperationPI = shift;

   printf STDERR $pDataSetMGL->LastSQLStatement() . "<BR>\n"
       if &GetAttr("DebugLvl") > 3;

   if( $pDataSetMGL->DBHdl()->err)
   {
      &Error(sprintf(i18n("Database Error occured during %s!") . "<BR>" .
                     i18n("    SQL-Error: (%d) %s") . "<BR>" .
                     i18n("    Statement: %s") . "<BR>",
                     $cSqlOperationPI,
                     $pDataSetMGL->DBHdl()->err,
                     $pDataSetMGL->DBHdl()->errstr,
                     $pDataSetMGL->LastSQLStatement()));
   }
}


# --- Query-data and display the result --------------------------------------
sub QryData() # (HTML Db Recordset ConfigFile CGI Plugin)
{
   my $bSortKeys = 0;
   my $cBgColor2;
   my $cBgColor;
   my $cField;
   my $cKey;
   my $cLastRecId;
   my $cName;
   my $cNavBtnsOrMsg;
   my $cOp;
   my $cQrySelType;
   my $cRecIdFields;
   my $cValue;
   my $iInd;
   my $iNrOfColouredLine;
   my $iNrOfRows;
   my $oHtmlTableApp;
   my $oTableHeaderPlugin;
   my $pRecord;
   my @lNames;
   my %hOPlugins;

   $cBgColor2         = &MyVal('Qry', 'BgColor2', "#dddddd");
   $iNrOfColouredLine = &MyVal('Qry', 'NrOfColLine', 2);
   $cQrySelType       = &MyVal('Qry', 'SelType', 'Btn');

   $cRecIdFields      = &GetAttr("RecIdField");

   $oTableHeaderPlugin = Plugin->new("TableHeader",
                                     "HasPrePost" => 1,
                                     "HasMy"      => 1);

   $oHtmlTableApp  = HTML::Table->new
       (BorderPar      => &MyVal('Qry', 'BorderWidth', '0'),
    BgColorPar     => &MyUserVal('Layout Table',
                                     'BgColor',
                                     $cBgColorMGL),
        CellpaddingPar => 0,
    WidthPar       => "100%",
    HeightPar      => "100%");

   # add id-field to the query
   &MyParam("!Fields",
            ((&MyVal('Qry', 'Distinct')? "DISTINCT ":  "") .
             &MyVal('Data', 'QryFields') .
             ", ".
             $cRecIdFields ));

   &InitDBIxRecordset();

   # Here the User can manipulate form-data
   Plugin->new("PreCreateForm")->Call();

   &DebugFormData();

   # create recordset
   *pDataSetMGL = DBIx::Recordset->Setup(\%hFormDataMGL);

   # Get the type-info for the fields
   &GetAllFieldInfo(&MyVal('Data', 'Table'), $pDataSetMGL);

   # construct selection-criteria
   foreach $cKey (keys %hFormDataMGL)
   {

      if ($cKey =~ "^Fld.*" and &MyParam($cKey) ne "")
      {

         # get the fieldname
         ($cField = $cKey) =~ s/^Fld//;

         # we got an operator
         if(&MyParam("\*$cField"))
         {
            &MyParam($cKey,
                     &MyParam("\*$cField") . " " .
                     &MyParam("$cField"));

         }

         # now scan the search-operator
         if(&MyParam($cKey) =~ /^(<>|>=|<=|<|>|!=|=|like)\s*(.*)$/)
         {
            ($cOp, $cValue) = ($1, $2);
         }
         else # no search-operator
         {
            # * is replaced with LIKE
            if (&MyParam($cKey) =~ /\*/)
            {
               ($cValue = &MyParam($cKey)) =~ s/\*/%/g;
               $cOp     = "like";

            }
            else
            {
               $cOp    = "=";
               $cValue = &MyParam($cKey);
            }
         }

         # make this field ready for querying the database
         &MyParam($cKey, $cValue);

         &ConvertDataForDb("Form2Db", $cField);
         $cValue = &MyParam($cKey);

         if($cValue)
         {
            # if an empty-value is detected use " "
            if (($cValue eq "''") or
                ($cValue eq '""'))
            {
               $cValue = "";
            }

            &MyParam("\*$cField", $cOp);
            &MyParam("$cField", $cValue);

            printf STDERR sprintf(i18n("%s => Op: s(%s) Value: s(%s)") .
                                  "<BR>\n",
                                  $cField,
                                  $cOp,
                                  $cValue)
                if &GetAttr("DebugLvl") > 3;
         }
      } # if ($cKey =~ "Fld.*" and &MyParam($cKey) ne "")
   } # foreach $cKey (keys %hFormDataMGL)

   &InitDBIxRecordset();

   # Search for Data
   $pDataSetMGL->Search(\%hFormDataMGL);

   # catch DB-error
   &DbiErrorAndExit(i18n("data-querying"));

   {
      my $cEntry;
      my $iRowInd = 0;

      # show table-header like in field-list
      foreach $cEntry (split /, */,
                       "_link, " . &MyVal('Data', 'QryFields'))
      {
         my $cConfKey = "Layout Qry $cEntry";

         $hOPlugins{$cEntry} =
             Plugin->new("QryConv_${cEntry}");

         if (lc($cEntry) eq "_link")
         {

            if ($cQrySelType ne "None")
            {

                $oHtmlTableApp->Element
                    (0, $iRowInd, 0,
                     p(font({-SIZE=>2},
                            checkbox(-name      => "Fld_ResetSort",
                                     -checked   => 0,
                                     -value     => 1,
                                     -override  => 1,
                                     -label     => " " . i18n("Reset")))).
                     &MyVal($cConfKey, "Text"));
            }
         }
         else
         {
            my $cBtnLabel = &MyVal($cConfKey, "Text", $cEntry);

            if(!$cBtnLabel)
            {
                $oHtmlTableApp->Element
                    (0, $iRowInd, 0, "&nbsp;");
            }
            else
            {

                $oHtmlTableApp->Element
                    (0, $iRowInd, 0,
                     p(font({-SIZE=>2},
                            &SubmitButton("BtnSort$cEntry",
                                          $cBtnLabel))));
                $bSortKeys = 1;
            }
         }
         $iRowInd ++;
      }

   }

   $oHtmlTableApp->Element(0, 0, 0, &MyVal("Layout Qry _link", "Text"))
       unless $bSortKeys;

   $iInd = 0;
   while ($pRecord = $pDataSetMGL[$iInd])
   {
       $iInd ++;

       my $iRow = 0;
       # Show different colors for the different rows
       $cBgColor = ((($iInd - 1) % $iNrOfColouredLine)?
                    $cBgColorMGL:
                    "$cBgColor2");

       foreach $cName (split /, */,
                       "_link, " . &MyVal('Data', 'QryFields'))
       {
           my $cConfKey = "Layout Qry $cName";
           my %hAttribs = ();
           my $cTabEntry;

           # $cName = lc($cName);

           $hAttribs{"BgColorPar"} = $cBgColor
               if $cBgColor;

           # we need this field for generating a selector for the record
           if ($cName eq "_link")
           {
               my @lKeyFields = split /, /, &GetAttr("RecIdField");

               # scan multiple primary-keys
               foreach (@lKeyFields)
               {
                   $_ = $$pRecord{$_};
               }

               $cLastRecId = join ",", @lKeyFields;
               $cLastRecId =~ s/ /%20/g;
               $cLastRecId =~ s/://g; # Normally 3A but this works no
               $cLastRecId =~ s/\//%2F/g;

               if($cQrySelType eq "Check")
               {

                   $cTabEntry =
                       font({-SIZE=>2},
                            checkbox(-name    => "Chb" . $$pRecord{$cName},
                                     -checked => $$pRecord{$cName},
                                     -value   => i18n(&MyVal($cConfKey,
                                                             "Value",
                                                             "1")),
                                     -label   => &EncodeHtml(i18n($iInd))));

               }
               elsif($cQrySelType eq "Link")
               {
                   $cTabEntry = &GenField("Qry",
                                          "_link",
                                          ("wwwdb://" .
                                           &GetAttr("ConfigFile") .
                                           ";id=" .
                                           $cLastRecId));
               }
               elsif($cQrySelType eq "None")
               {
                   $cTabEntry = "";
                   next;
               }
               else
               {
                   $cTabEntry =
                       font({-SIZE=>2},
                            &SubmitButton("BtnSelect" . $cLastRecId,
                                          &EncodeHtml(i18n($iInd))));
               }
           }
           # not the selector
           else
           {
               my $cValue;

               # use the default-plugin, if available. If not take
               # simply the field-value
               $cValue = ($hOPlugins{$cName}->IsDefined("Default")?
                          $hOPlugins{$cName}->Call($$pRecord{$cName},
                                                   %{$pRecord}):
                          $$pRecord{$cName});

               $hAttribs{"AlignPar"} = &MyVal($cConfKey, "Align", "")
                   if &MyVal($cConfKey, "Align", "");
               $hAttribs{"ValignPar"} = &MyVal($cConfKey, "VAlign", "")
                   if &MyVal($cConfKey, "VAlign", "");
               $hAttribs{"NowrapPar"} = "NOWRAP"
                   if &MyVal($cConfKey, "NoWrap", "");
               $hAttribs{"BorderPar"}  = &MyVal('Layout Table', 'Border', '0')
                   if &MyVal('Layout Table', 'Border', '0');

               if($cValue)
               {

                   $cTabEntry = &GenField("Qry",
                                          $cName,
                                          ($cValue .
                                           "\\," .
                                           $$pRecord{&GetAttr("RecIdField")}));

                   # FIXME: Check why we need ... $$pRecord{&GetAttr("RecIdField")
               }
               else
               {

                   $cTabEntry = "&nbsp;"
                       if !$cTabEntry;
               }
           }

           $oHtmlTableApp->Element
               ($iInd, $iRow, HTML::TableCol->new(%hAttribs));

           $oHtmlTableApp->Element
               ($iInd, $iRow, 0, $cTabEntry);

           $iRow ++;
       }
   } # while ($pRecord = $pDataSetMGL[$iInd++])

   $iNrOfRows = $iInd;

   # bottom area
   {
       $iInd ++;

       # No record was found
       if ($iNrOfRows == 0)
       {

          # "remove" sort-buttons
          foreach (0 .. $oHtmlTableApp->getMaxCol())
          {
             $oHtmlTableApp->Element(0, $_, 0, "");
          }

          # Message, that no data was found
          $cNavBtnsOrMsg = Plugin->new("NoRecordFound",
                                       "HasMy" => 1)->Call();
       }
       # exactly one record found, show directly
       elsif ($iNrOfRows == 1 && !&MyVal('Qry', 'ForceBrowse', ))
       {
          # Throw away the generated form
          $oHtmlTableApp = undef;

          # "emulate" the Select-Button
          &Redirect(&GetAttr("SessionId"),
                    &GetAttr("ConfigFile") . ";id=$cLastRecId");
       }
       else
       {
          # due to security-reasons thes fields are deleted
          foreach $cKey ("!DataSource", "!Database", "!Username", "!Password")
          {
             &MyParamDelete($cKey);
          }

          # Remove all unneccessary hidden-fields
          foreach $cKey (sort keys %hFormDataMGL)
          {
             if (($cKey =~ /^Btn.*/) ||
                 ($cKey =~ /^Fld_.*/) ||
                 ($cKey =~ /^_.*/))
             {
                &MyParamDelete($cKey);
             }

          }

          # all hidden fields will be generated here too
          $cNavBtnsOrMsg = $pDataSetMGL->PrevNextForm
              ({-first => i18n('|< Begin'),
                -prev  => i18n('<< Back'),
                -next  => i18n('Forward >>'),
                -last  => i18n('End >|')},
               \%hFormDataMGL);


       }

       # WORKAROUND: extract form-commands from $cNavBtnsOrMsg
       $cNavBtnsOrMsg =~ s/<\/?form.*?>//gi;

       $oHtmlTableApp->Element($iInd, 0, 0, center($cNavBtnsOrMsg));
       $oHtmlTableApp->Element
           ($iInd, 0)->setColspanPar($oHtmlTableApp->getMaxCol());

       $iInd ++;
       $oHtmlTableApp->Element($iInd, 0, 0, &FormButtons());
       $oHtmlTableApp->Element
       ($iInd, 0)->setColspanPar($oHtmlTableApp->getMaxCol());

   }

   &GenHtmlForm($oTableHeaderPlugin->Call(&MyParam("!Order")?
                                          (i18n("Search-result ordered by ") .
                                           i18n(&MyParam("!Order"))):
                                          i18n("Search-result")),
                $oHtmlTableApp->HtmlCode(),
                undef);
} # sub QryData

# -- Plugin, if no record was found -----------------------------------
sub NoRecordFound()
{
   my $cResult =
       (br() x 2 .
        p(b(small(i18n("Sorry! No data is available " .
                       "for your search-criteria!")))) .
        br() x 2);

   return $cResult;
}

sub FormButtons() # HTML (ConfigFile)
{
   my $cParam;

   my $cResult = "";

   $cResult .= ("<CENTER>\n");

   # Work with selected Record
   if (&MyParam("WWWdbState") eq "Work") {

      $cResult .= &AddSubmitButton("Work", "BtnUpd", i18n("Update.png"));
      $cResult .= &AddSubmitButton("Work", "BtnDel", i18n("Delete.png"));

      $cResult .= &UserButtonsOfState("Work", ("BtnUpd", "BtnDel"));
   }
   # Initial state
   elsif(&MyParam("WWWdbState") eq "Init") {

      $cResult .= &AddSubmitButton("Init", "BtnQry", i18n("Query.png"));
      $cResult .= &AddSubmitButton("Init", "BtnNew", i18n("Insert.png"));

      $cResult .= &UserButtonsOfState("Init", ("BtnQry", "BtnNew"));

   }
   # Query-mode
   elsif(&MyParam("WWWdbState") eq "Qry") {

      $cResult .= &UserButtonsOfState("Qry", ());
   }

   # Buttons, that appear in every state

   $cResult .= &AddSubmitButton("All", "BtnCancel", i18n("Cancel.png"));
   $cResult .= &AddSubmitButton("All", "BtnExit",   i18n("Exit.png"));
   $cResult .= &AddSubmitButton("All", "BtnHelp",   i18n("Help.png"));

   $cResult .= &UserButtonsOfState("All", ("BtnCancel", "BtnExit", "BtnHelp"));

   $cResult .= ("</CENTER>\n");

   return $cResult;
}

# --- scan the config-file for user-defined buttons in this state ------------
sub UserButtonsOfState ($\@) # CGI Html
{
   my $cStatePI = shift;
   my @lcDefaultButtonsPI = @_;

   my $cParamBtnName;
   my $cDefaultButton;
   my $cSection;
   my $cResult = "";

   # Scan all sections
   foreach $cSection ($oConfPoolGL->getSectionNames())
   {

      # only the [State ...] sections are interesting
      if($cSection eq "State $cStatePI")
      {
         # Scan all parameters of section
       PARAM:
         foreach $cParamBtnName ($oConfPoolGL->getEntryNames($cSection))
         {

            # only the Btn... = ... -Parameters are interesting
            next
                if ($cParamBtnName !~ /^Btn.*/);

            # Default-Buttons are handled explicitly
            foreach $cDefaultButton (@lcDefaultButtonsPI)
            {
               next PARAM
                   if($cParamBtnName eq $cDefaultButton);

            } # foreach $cDefaultButton

            $cResult .= &AddSubmitButton("$cStatePI", "$cParamBtnName");

         } # foreach $cParam
      } # if($cSection eq "State $cStatePI"
   } # foreach $cSection

   return $cResult;
}


# --- add a single Button if allowed in config-file
sub AddSubmitButton () # HTML
{
   my ($cStatePI, $cBtnNamePI, $cDefaultPI) = @_;

   my $cBtnLabel;
   my $cResult = "";


   $cBtnLabel = &MyVal("State $cStatePI", "$cBtnNamePI");

   # show button only, if label is ne "-"
   if ("$cBtnLabel" ne "-")
   {
      $cBtnLabel = $cDefaultPI
          if (!$cBtnLabel);

      $cResult .= &SubmitButton($cBtnNamePI, $cBtnLabel);
   }

   return $cResult;

}


sub SubmitButton($$)
{
   my ($cBtnNamePI, $cLabelPI) = @_;

   my $cFilename = "";
   my $cResult;
   my $cLabel = i18n($cLabelPI);

   if($cLabelPI =~ /(.*)\.(png|jpg|gif)/)
   {
      $cFilename = (&GetAttr("BaseDir") .
                    "/lib/Images/Btn" .
                    i18n($cLabelPI));

      if (! -f $cFilename)
      {
         $cFilename = undef;
         $cLabel    = $1;

      }
      else
      {
         $cFilename = ("/" .
                       &GetAttr("ScriptName") .
                       "/lib/Images/Btn" .
                       i18n($cLabelPI));

      }
   }

   if ($cFilename)
   {
      $cResult = image_button(-name   => $cBtnNamePI,
                              -src    => $cFilename,
                              -border => "0");
   }
   else
   {
      $cResult = submit(-name  => $cBtnNamePI,
                        -label => i18n($cLabel)). "";

   }

   return $cResult;

}



# --- Check the whole record -------------------------------------------------
sub CheckRecord () # (DataRecord Plugin ConfigFile)
{

   my $cField;
   my $cTable;
   my @lFields = ();

   # empty the error-hash
   undef %hFieldErrorsMGL;

   my $oPluginEveryField =
       Plugin->new("Check_${cTable}_EveryField");

   $cTable = &MyVal('Data', 'Table');

   push @lFields, split ", ", &MyVal('Data', 'IdField');
   push @lFields, split ", ", &MyVal('Data', 'UpdFields');
   push @lFields, split ", ", &MyVal('Data', 'ExtraFields');

   foreach $cField (@lFields)
   {
      &InternalFieldCheck($cField);

      $oPluginEveryField->Call("$cField");

      Plugin->new("Check_${cTable}_${cField}")->Call();

   }

   Plugin->new("Check_$cTable")->Call();

   return;

} # sub CheckRecord




=head2 InternalFieldCheck - make default-checks

=over 2

=item B<DESCRIPTION>

FIXME: add dcos

=item B<SYNOPSIS>

=item B<RETURN VALUE>

None.

=item B<EXAMPLE>

 # The Record has not been found
 &OkForm("error", "Sorry, but the record couldn't be found!");

=item B<SEE ALSO>

Error

=back

=cut

# --- make internal checks ---------------------------------------------------
sub InternalFieldCheck($) # HTML
{
   my $cFieldNamePI = shift;

   my $cPattern;
   my $cValue = &GetField($cFieldNamePI);

   # make lowercase
   if (&MyVal("Layout Field $cFieldNamePI", 'ToLower'))
   {
      &SetField($cFieldNamePI,
                lc($cValue));
   }

   # make uppercase
   if (&MyVal("Layout Field $cFieldNamePI", 'ToUpper'))
   {
      &SetField($cFieldNamePI,
                uc($cValue));
   }

   # check the Mandatory-Flag
   if (&MyVal("Layout Field $cFieldNamePI", 'Mandatory'))
   {
      &AddError("$cFieldNamePI",
                sprintf(i18n("No value for field %s, please complete!"),
                        (i18n($cFieldNamePI))))
          if(!$cValue);
   }

   $cPattern = &MyVal("Layout Field $cFieldNamePI", 'MustMatch');

   # check the MustMatch-Flag
   if ($cPattern && ($cValue ne ""))
   {

      printf STDERR "MATCHING: '$cPattern' with '$cValue'\n";

      if($cValue !~ /$cPattern/)
      {
         my $cErrMessage;

         $cErrMessage  = (i18n($cFieldNamePI) .
                          ": " .
                          &MyVal("Layout Field $cFieldNamePI",
                                 'MustMatch_Errmsg',
                                i18n("didn't meet the " .
                                     "right format, please correct!")));

         &AddError("$cFieldNamePI", $cErrMessage);
      }
   }

}


# --- convert data between html-form and a format, the database can understand
sub ConvertDataForDb($;$) # Db (Plugin)
{
   my $cDirectionPI = shift;
   my $cFieldPI     = shift;

   my $cField;
   my $cTable;
   my @lFields;
   my %hConvPlugins = ();

   if (defined($cFieldPI))
   {
       @lFields = $cFieldPI;
   }
   else
   {
      push @lFields, split ", ", &MyVal('Data', 'IdField');
      push @lFields, split ", ", &MyVal('Data', 'UpdFields');
      push @lFields, split ", ", &MyVal('Data', 'ExtraFields');
   }

   print STDERR "ConvertDataForDb Fields: @lFields\n"
       if &GetAttr("DebugLvl") > 3;

   $cTable = &MyVal('Data', 'Table');

   foreach $cField (@lFields)
   {
      my $cFieldType;
      my $cFunctName;
      my $cEvalCode;
      my $cFieldValue;
      my $cResult = undef;

      $cFieldType = &GetFieldTypeName($cField);

      # assert($cFieldType) if DEBUG
      $cFunctName = sprintf("DbSession::%s_%s",
                            $cFieldType,
                            $cDirectionPI);

      $cFieldValue = &GetField($cField);

      if(!defined $hConvPlugins{"$cFunctName"})
      {
         $hConvPlugins{"$cFunctName"} = eval "defined(&$cFunctName)" || 0;
         printf STDERR ("defined $cFunctName = %s\n",
                        $hConvPlugins{"$cFunctName"});
      }

      $cEvalCode = "$oDbTargetGL->$cFunctName(" . $oDbTargetGL . ", $cFieldValue)";
      $cResult = ($hConvPlugins{"$cFunctName"}?
                  eval {$oDbTargetGL->$cFunctName($cFieldValue);}:
                  $cFieldValue);

      if (defined $cResult)
      {
         print STDERR "Field: $cFunctName(), $cField, $cFieldValue -> $cResult\n"
             if &GetAttr("DebugLvl") > 2;

         # this happens, when no plugin is defined, or the first param
         # is not correctly shifted
         # *** This may be a dirty Hack - better solutions are welcome ***
         $cResult =~ s/DbSession=HASH(.*) //;

         &SetField($cField, $cResult);
      }
   }

   return;
}



# --- get the values of the fields and store them as HTML-parameters ---------
sub ExtractFieldsFromRecordset() # HTML CGI Recordset
{

   my $cKey;
   my $cField;

   foreach $cKey (keys %hFormDataMGL)
   {

      if ($cKey =~ /^Fld(.*)/ )
      {

         # get fieldname
         $cField = $1;
         &MyParam($cKey, &MyParam($cField))
             if $cField;

      } # ($cKey =~ /^Fld(.*)/
   } # foreach $cKey (keys %hFormDataMGL)

}


# --- get the HTML-parameters and store them as fields for te recordset ------
sub CreateFieldsForRecordset() # HTML CGI Recordset
{

   my $cKey;
   my $cField;

   foreach $cKey (keys %hFormDataMGL)
   {

      if ($cKey =~ "^Fld(.*)")
      {

         # get fieldnames
         $cField = $1;
         &MyParam("$cField", (&MyParam($cKey)?
                              &MyParam($cKey):
                              ""));

      } # if ($cKey =~ "Fld.*" and &MyParam($cKey) ne "") {
   } # foreach $cKey (keys %hFormDataMGL)

}


# --- insert a new record ----------------------------------------------------
sub NewRecord() # Db
{
   &InitDBIxRecordset();

   # create recordset
   *pDataSetMGL = DBIx::Recordset->Setup(\%hFormDataMGL);

   # Get the type-info for the fields
   &GetAllFieldInfo(&MyVal('Data', 'Table'), $pDataSetMGL);

   &ConvertDataForDb("Form2Db");

   # Insert Record here
   &CreateFieldsForRecordset();

   $pDataSetMGL->Insert(\%hFormDataMGL);

   # catch DB-error
   &DbiErrorAndExit(i18n("record-insertion"));

}


# --- delete record -------------------------------------------------------
sub DelRecord() # Db
{
   my @lKeyFields     = split /, /, &GetAttr("RecIdField");
   my %hKeysForDelete = ();

   &CreateFieldsForRecordset();

   # here something went wrong
   if (!&GetAttr("RecId"))
   {
      die(i18n("internal error -> Record-ID missing!!"));
   }

   &InitDBIxRecordset();

   # scan multiple primary-keys
   foreach (@lKeyFields)
   {
      $hKeysForDelete{$_} = &GetField($_);
   }

   # create Recordset
   *pDataSetMGL = DBIx::Recordset->Setup(\%hFormDataMGL);

   $pDataSetMGL->Delete(\%hKeysForDelete);

   # catch DB-error
   &DbiErrorAndExit(i18n("record-deletion"));


}




# --- update a record ------------------------------------------------------
sub UpdRecord() # Db
{
   my @lKeyFields     = split /, /, &GetAttr("RecIdField");
   my %hKeysForUpdate = ();

   # scan multiple primary-keys
   foreach (@lKeyFields)
   {
      $hKeysForUpdate{$_} = &GetField($_);
   }

   &InitDBIxRecordset();

   # create recordset
   *pDataSetMGL = DBIx::Recordset->Setup(\%hFormDataMGL);

   # Get the type-info for the fields
   &GetAllFieldInfo(&MyVal('Data', 'Table'), $pDataSetMGL);

   &ConvertDataForDb("Form2Db");

   # here something went wrong
   if (!&GetAttr("RecId"))
   {
      die(i18n("internal error -> Record-ID missing!!"));
   }

   # Update Recordset here
   &CreateFieldsForRecordset();

   $pDataSetMGL->Update
       (\%hFormDataMGL,
        \%hKeysForUpdate);

   # catch DB-error
   &DbiErrorAndExit(i18n("record-update"));


}




# --- read one single record------------------------------------------------
sub FetchRecord() # Db CGI
{

   my $pRecord;
   my $plNames;
   my $cName;
   my @lKeyFields     = split /, /, &GetAttr("RecIdField");
   my %hKeysForSelect = ();

   # something went wrong
   if (!&GetAttr("RecId"))
   {
      die(i18n("internal error -> Record-ID missing!!"));
      &MyExit();
   }

   # get all fields for the selection
   &MyParam("!Fields", (&GetAttr("RecIdField") . ", " .&MyVal('Data', 'UpdFields')));

   # scan multiple primary-keys
   foreach (@lKeyFields)
   {
      $hKeysForSelect{$_} = &GetField($_);
   }

   &InitDBIxRecordset();

   # create recordset
   *pDataSetMGL = DBIx::Recordset->Setup(\%hFormDataMGL);

   # Record-Id=Value
   $pDataSetMGL->Select(\%hKeysForSelect);

   # catch DB-error
   &DbiErrorAndExit(i18n("record-re-select"));

   # Get the type-info for the fields
   &GetAllFieldInfo(&MyVal('Data', 'Table'), $pDataSetMGL);


   $plNames = $pDataSetMGL->Names;
   $pRecord = $pDataSetMGL[0];

   # distribute the found fields in HTML-form
   foreach $cName (@$plNames)
   {
      # &MyParam("Fld" . lc($cName), $$pRecord{lc($cName)});
      &MyParam("Fld" . $cName, $$pRecord{$cName});
   }

   # make data ready for interaction with user
   &ConvertDataForDb("Db2Form");


} # sub Fetch Record



# --- get info about field-types etc ----------------------------------------
sub GetAllFieldInfo ($$) # Db
{
   my $cTablePI      = shift; # not needed at the moment
   my $hFldInfoSetPI = shift;

   my $cType;
   my $hDB;
   my $hStmt;
   my $iInd;
   my $plTypes;
   my %hTypeNames;
   my @lLen;
   my $plNames;

   $hDB = $hFldInfoSetPI->DBHdl();

   $plNames   = $hFldInfoSetPI->AllNames();
   $plTypes   = $hFldInfoSetPI->AllTypes();

   foreach $iInd (0 .. $#{$plNames})
   {
      my $cFieldName = $plNames->[$iInd];
      my $iFieldType = $plTypes->[$iInd];

      # some drivers use their own db-specific type-coding
      $iFieldType = &DbSession::MapDatatype($iFieldType)
          unless defined &DbSession::NameOfType($iFieldType);

      printf STDERR ("TypeInfo %s -> (%s,%s): T: <%s>\n",
                     $cFieldName,
                     $plTypes->[$iInd],
                     $iFieldType,
                     &DbSession::NameOfType($iFieldType))
          if &GetAttr("DebugLvl") > 0;

      $hTableInfoMGL{$cFieldName}{"PRECISION"} = 0;
      $hTableInfoMGL{$cFieldName}{"TYPE"}      = $iFieldType;
      $hTableInfoMGL{$cFieldName}{"TYPE_NAME"} =
          &DbSession::NameOfType($iFieldType);
   }
}



=head2 OkForm - Display a form similar to a popup-window

=over 2

=item B<DESCRIPTION>

Generates a complete HTML-Form, to inform the user about an error,
a warning, an information or anything else.

=item B<SYNOPSIS>

OkForm($type, $text [, $btn])

 type  - error, die, yes-no or blank ("")
 text  - The text, you want to display
 btn   - (Optional) The name, you want to give the Ok-button

=item B<RETURN VALUE>

None.

=item B<EXAMPLE>

 # The Record has not been found
 &OkForm("error", "Sorry, but the record couldn't be found!");

=item B<SEE ALSO>

Error

=back

=cut

# --- show OK-Form ---------------------------------------------------------
sub OkForm ($$;$) # HTML
{

   my ($cTypePI, $cTextPI, $cBtnPI) = @_;

   my $cBtn         = $cBtnPI;
   my $cHeaderMsg;
   my $cText        = $cTextPI;
   my $cType        = lc($cTypePI);
   my $oHtmlTableApp;


   # error-messages get another header
   if ($cType eq "error")
   {
      $cHeaderMsg = i18n("Problem!!");
   }
   elsif ($cType eq "die")
   {
      $cHeaderMsg = i18n("Fatal Error!!");
   }
   elsif ($cType eq "yes-no")
   {
      # Here the User can manipulate form-data
      Plugin->new("PreCreateForm")->Call();

      $cHeaderMsg = i18n("Confirmation");
   }
   else
   {
      # Here the User can manipulate form-data
      Plugin->new("PreCreateForm")->Call();

      $cHeaderMsg = i18n("Information");
   }

   # Application-Table
   {
       $oHtmlTableApp  = HTML::Table->new
           (BorderPar  => &MyVal('Layout Table', 'Border', '0'),
            BgColorPar => &MyUserVal('Layout Table',
                                     'BgColor',
                                     $cBgColorMGL),
            WidthPar   => "100%",
            HeightPar  => "100%");

       # The text of the message
       $oHtmlTableApp->Element(0, 0, 0, p($cText));

       # create the buttons
       if ($cType eq "yes-no")
       {
           $oHtmlTableApp->Element
               (1, 0, 0,
                &SubmitButton("BtnYes",
                             &EncodeHtml(i18n("Yes"))),
                &SubmitButton("BtnNo" ,
                             &EncodeHtml(i18n("No"))));
       }
       else
       {
           $oHtmlTableApp->Element
               (1, 0, 0,
                &SubmitButton((defined($cBtnPI)? $cBtnPI: "BtnOk"),
                             &EncodeHtml(i18n("OK"))))
                   if $cBtnPI ne "-";
       }

       # center all lines
       foreach (0..1)
       {
       $oHtmlTableApp->Element($_)->setAlignPar("Center")
           if defined $oHtmlTableApp->Element($_);
       }
   }

   # all hidden fields
   $oHtmlTableApp->Element(HTML::Table::APPEND, 0, 0,
                           &GenPageHidden());

   if ($cType eq "die")
   {
      &InitHTMLForm();

      my $oTemplate = HTML::Template->new
          (filename => (&GetAttr("BaseDir") .
                        &MyVal('WWWdb', "Template",
                               "/lib/WWWdb/Templ/Tmpl_WWWdb.html")),
           die_on_bad_params => 0,
           debug => 1);

      $oTemplate->param('APPL' => $oHtmlTableApp->HtmlCode());
      $oTemplate->param('HIER_FORM' => &HierarchyForm());

      $oFormMGL->Element(0, &ScanDoc($oTemplate->output));

   }
   else
   {
      &GenHtmlForm(undef, $oHtmlTableApp->HtmlCode(), undef);

   }

} # sub OkForm

sub InitHTMLForm()
{
    my %hFormParam  = ();


    # set the params for the form
    $hFormParam{"ExpireHeadPar"}  = ($iCacheTimeoutMGL?
                                     "+" . $iCacheTimeoutMGL . "s":
                                     "now");

    $hFormParam{"MetaHtmlPar"}    = {"keywords" => "WWWdb", # FIXME: meta-keywords
                                  };
    $hFormParam{"AuthorHtmlPar"}  = &UnTaint($ENV{"SERVER_ADMIN"});
    $hFormParam{"TitleHtmlPar"}   = (i18n(&MyVal
                                          ("Header",
                                           "Title",
                                           "WWWdb")));
    $hFormParam{"BackgroundHtmlPar"} = ("/" .
                                        &GetAttr("ScriptName") .
                                        "/lib/".
                                        $cBgImageMGL)
    if $cBgImageMGL;
    $hFormParam{"BgColorHtmlPar"}    = $cBgColorMGL
    if $cBgColorMGL;

    foreach ("Link", "ALink", "VLink")
    {
       my $cValue = &MyVal('GUI', "$_" . "Color", undef);

       $hFormParam{$_ . "HtmlPar"}    = $cValue
           if defined $cValue;
    }

    $hFormParam{"ActionFormPar"}     =
        &CreateReference(&GetAttr("SessionId"),
                         (&GetAttr("ConfigFile")));

    $oFormMGL = HTML::Form->new(%hFormParam);

    return;

}

# --- Generate the HTML-code using some templates ---------------------------
sub GenHtmlForm ($$$) # HTML (ConfigFile)
{
    my $cTableHeaderPI = shift;
    my $cApplPI        = shift;
    my $cTableFooterPI = shift;

    my %hTemplParam = ();

    # HTML::Template supports only lowercase variables,
    # so we have to convert the standard_templates
    my %hPluginMap = ("formheader"      => "FormHeader",
                      "formfooter"      => "FormFooter",
                      "firstcolumn"     => "FirstColumn",
                      "preformheader"   => "PreFormHeader",
                      "preformfooter"   => "PreFormFooter",
                      "prefirstcolumn"  => "PreFirstColumn",
                      "postformheader"  => "PostFormHeader",
                      "postformfooter"  => "PostFormFooter",
                      "postfirstcolumn" => "PostFirstColumn",);

    &InitHTMLForm();

    my $oTemplate = HTML::Template->new
        (filename => (&GetAttr("BaseDir") .
                      &MyVal('WWWdb', "Template",
                             "/lib/WWWdb/Templ/Tmpl_WWWdb.html")),
         die_on_bad_params => 0,
         debug => &GetAttr("DebugLvl") + 100);

    if ($oTemplate->query(name => 'APPL'))
    {
       $hTemplParam{'APPL'} = $cApplPI;

    }

    printf STDERR "HDR: $cTableHeaderPI\n";
    printf STDERR "FTR: $cTableFooterPI\n";
    $hTemplParam{'TABLE_HEADER'} = "TableHeader";
    $hTemplParam{'TABLE_FOOTER'} = "TableFooter";

    if ($oTemplate->query(name => 'TABLE_HEADER'))
    {
       $hTemplParam{'TABLE_HEADER'} = $cTableHeaderPI;
    }

    if ($oTemplate->query(name => 'TABLE_FOOTER'))
    {
       $hTemplParam{'TABLE_FOOTER'} = $cTableFooterPI;
    }

    if ($oTemplate->query(name => 'PATH_FORM'))
    {
       $hTemplParam{'PATH_FORM'} = &PathForm(" ", " > ", " ");

    }

    if ($oTemplate->query(name => 'SUBCAT_FORM'))
    {
       $hTemplParam{'SUBCAT_FORM'} = &SubCategoriesForm();

    }

    if ($oTemplate->query(name => 'HIER_FORM'))
    {
       $hTemplParam{'HIER_FORM'} = &HierarchyForm();

    }

    if ($oTemplate->query(name => 'LOGIN_FORM'))
    {
       $hTemplParam{'LOGIN_FORM'} = &LoginForm();

    }

    if ($oTemplate->query(name => 'SEARCH_FORM'))
    {
       $hTemplParam{'SEARCH_FORM'} = &SearchForm();

    }

    if ($oTemplate->query(name => 'LANG_FORM'))
    {
       $hTemplParam{'LANG_FORM'} = &LangForm();

    }

    # find program parameters and fill them in
    my @lParams = $oTemplate->param();
    for my $cParam (@lParams)
    {
       if ($cParam =~ /^__plugin_(.*)__$/)
       {
          my $cPluginName = (defined $hPluginMap{$1}?
                             $hPluginMap{$1}:
                             $1);

          $hTemplParam{$cParam} =
              (Plugin->new("$cPluginName",
                           "HasPrePost" => 0,
                           "HasMy"      => 1)->Call());
       }
    }

    # fill in some parameters
    $oTemplate->param(\%hTemplParam);

    # Resolve WWWdb-links
    $oFormMGL->Element(0, &ScanDoc($oTemplate->output));

    print STDERR Dumper($oFormMGL)
        if &GetAttr("DebugLvl") > 3;


}



# --- generate a page with all entry-fields hidden -------------------------
sub GenPageHidden () # HTML ConfigFile CGI
{
   my $cResult = "";

   foreach (keys %hFormDataMGL)
   {
      if (/^Fld[^_].*$/)
      {
         $cResult .= hidden(-name  => $_,
                            -value => &EncodeHtml(&MyParam($_))) . "\n";
      }
   }

#     foreach $cField (split ", ", &MyVal("Data", "UpdFields"))
#     {
#         $cResult .= hidden(-name  => "Fld" . $cField,
#             -value => &EncodeHtml(&MyParam("Fld" .
#                            $cField))) .
#                                "\n";
#     }

   return $cResult;           # FIXME: Why does this return results in wrong data?
} # sub GenPageHidden


# --- generate the HTML-page for entering all the data ---------------------
sub GenPage () # HTML (ConfigFile CGI)
{
   my $iInd;
   my $cHeaderText;
   my $iMaxCol;
   my $oHtmlTableApp;
   my $oErrTextCol = undef;
   my @lColsWithFullWidth = ();


   # Here the User can manipulate form-data
   Plugin->new("PreCreateForm")->Call();

   if(&MyParam("WWWdbState") eq "Init")
   {
      $cHeaderText = &MyVal("State Init", "Header",
                            i18n("Search-criteria / insert data"));
   }
   elsif(&MyParam("WWWdbState") eq "Work")
   {
      $cHeaderText = &MyVal("State Work", "Header",
                            i18n("Work on this record"));
   }
   elsif(&MyParam("WWWdbState") eq "Qry")
   {
      $cHeaderText = &MyVal("State Qry", "Header",
                            i18n("Browse or select data"));
   }


   # show table -------------------------------------------------------
   {
       my $cField;
       my $cFieldType;
       my $cPos;
       my $cPosKey;
       my $iCol;
       my $iIndPosKey;
       my $iLine;
       my $iLineOffset;
       my $iMaxLine;
       my $iPosCol;
       my $iPosLine;
       my $iPosSequence;
       my $iColSpan;
       my $iRowSpan;
       my $iSequence;
       my %hFieldInfo;
       my @lcFields;
       my @lcPosKey;
       my $cTableBackground;

       # read all fields of the configuration-file and calculate their
       # positions in the HTML-table
       {

           my $cSection;
           my $cParam;
           my $cValue;
           my $cCurrPos;

           $cCurrPos = "000.000.000.000";

           # scan all sections
           foreach $cSection ($oConfPoolGL->getSectionNames())
           {

               # scan all parameters
               foreach $cParam ($oConfPoolGL->getEntryNames($cSection))
               {
                   if (($cSection   =~ /^Layout\s+(Label|Field)/) and
                       (lc($cParam) eq "pos"))
                   {
                       my $cField;
                       my $cFieldType;
                       my $cDummy;

                       ($cDummy, $cFieldType, $cField) = split(" ", $cSection);

                       # calculate position and insert in hash
                       &MakeNewPosEntry
                           ($cFieldType,
                            $cField,
                            $oConfPoolGL->getValue($cSection, $cParam),
                            $cCurrPos,
                            \%hFieldInfo);

                       $cCurrPos = $hFieldInfo{"$cField.$cFieldType"}{"Pos"};

                   }
               }
           }
       }

       # Now we have a correct sequence of the fields ...
       @lcPosKey = sort keys %{$hFieldInfo{"Pos"}};

       $iMaxLine  = 0;
       $iMaxCol   = 0;

       # let's count the maximum lines and columns
       foreach $cPosKey (@lcPosKey)
       {
           ($iLine, $iCol) = split /\./, $cPosKey;

           $iMaxLine = $iLine if ($iMaxLine < $iLine);
           $iMaxCol  = $iCol  if ($iMaxCol < $iCol);
       }

       # Now we have to look for all fields in the table, which have
       # been "forgotten" in the config-file

       {
           # We dont need no Record-ID
           # push @lcFields, split ", ", &MyVal('Data', 'IdField');
           push @lcFields, split ", ", &MyVal('Data', 'UpdFields');
           push @lcFields, split ", ", &MyVal('Data', 'ExtraFields');

           # fill the array
           foreach $cField (@lcFields)
           {
               my $cFieldPos;
               my $iSequence;
               my $iWidth;

               # is this field configured?
               $cFieldPos = &MyVal("Layout Field $cField", "Pos", "");

               # NO!
               if(!$cFieldPos)
               {

                   $iMaxLine ++;

                   # Append the label in the first column at the last row
                   &MakeNewPosEntry("Label",
                                    $cField,
                                    "$iMaxLine.0.0",
                                    "$iMaxLine.0.0",
                                    \%hFieldInfo);

                   # Append the field in the second column at the last row
                   &MakeNewPosEntry("Field",
                                    $cField,
                                    "$iMaxLine.1.0",
                                    "$iMaxLine.1.0",
                                    \%hFieldInfo);

                   # Maybe we have to correct the max. column
                   $iMaxCol = 1 if $iMaxCol < 1;
               }

           } # foreach $cFieldType ("Field", "Label")

       } # foreach $cField ...


       # again we need the correct order of the fields ...
       @lcPosKey = sort keys %{$hFieldInfo{"Pos"}};
       $iIndPosKey = 0;

       $cTableBackground = &MyVal('Layout Table', 'Background', "");

       $cTableBackground = &GenImage($cTableBackground)
           if $cTableBackground;

       $oHtmlTableApp  = HTML::Table->new
           (BorderPar     => &MyVal('Layout Table', 'Border', '0'),
            BackgroundPar => $cTableBackground,
            BgColorPar    => &MyUserVal('Layout Table',
                                        'BgColor',
                                        $cBgColorMGL),
            WidthPar      => "100%",
            HeightPar     => "100%");

       $oHtmlTableApp->Element(HTML::Table::APPEND, 0, 0,
                               b(&EncodeHtml(i18n($cHeaderText))));
       $oHtmlTableApp->Element
           (HTML::Table::CURRENT, 0)->setAlignPar("Center");

       # mark for enlarging later
       push @lColsWithFullWidth, $oHtmlTableApp->Element(0, 0);

       # show standard error-text
       if (%hFieldErrorsMGL)
       {
           $oHtmlTableApp->Element
               (HTML::Table::APPEND, 0, 0,
                font({-color => 'Red',
                      -size => 3},
                     b(&EncodeHtml
                       (i18n("While checking your input-data some problems " .
                             "were detected and marked. <BR>" .
                             "Some explanation of the problems, you have " .
                             "to solve first is on the bottom of this page")))));

           push (@lColsWithFullWidth,
                 $oHtmlTableApp->Element(HTML::Table::CURRENT, 0));
       }

       # Now we are ready to construct the table!!!
       $iLineOffset = $oHtmlTableApp->getMaxRow() - 1;

       foreach (@lcPosKey)
       {
           my $cCellType;

           ($cField, $cCellType) =
               split /\./, $hFieldInfo{"Pos"}{$_};

           # splits $_ and converts to integer
           ($iPosLine, $iPosCol, $iPosSequence, $iRowSpan, $iColSpan) =
               map {int($_)} split /\./, $_;

           # make a new column-object
           {
               my $cConfKey;
               my $oColumn;
               my $cBackground;
               my %hAttribs = ();

               $cConfKey = "Layout $cCellType $cField";


               $cBackground = &MyVal($cConfKey, 'Background', "");

               $cBackground = &GenImage($cBackground)
                   if $cBackground;

               $hAttribs{"BackgroundPar"} = $cBackground
                   if $cBackground;

               $hAttribs{"BgColorPar"} = &MyVal($cConfKey, "BgColor", $cBgColorMGL)
                   if &MyVal($cConfKey, "BgColor", $cBgColorMGL);
               $hAttribs{"AlignPar"} = &MyVal($cConfKey, "Align", "")
                   if &MyVal($cConfKey, "Align", "");
               $hAttribs{"ValignPar"} = &MyVal($cConfKey, "VAlign", "")
                   if &MyVal($cConfKey, "VAlign", "");
               $hAttribs{"NowrapPar"} = "NOWRAP"
                   if &MyVal($cConfKey, "NoWrap", "");

               $oColumn = HTML::TableCol->new(%hAttribs);

               $oHtmlTableApp->Element($iPosLine + $iLineOffset,
                                       $iPosCol,
                                       $oColumn);
           }


           $oHtmlTableApp->Element($iPosLine + $iLineOffset,
                                   $iPosCol,
                                   $iPosSequence,
                                   &GenField($cCellType,
                                             $cField,
                                             &MyParam("Fld$cField")));

           $oHtmlTableApp->Element
               ($iPosLine + $iLineOffset, $iPosCol)->setColspanPar($iColSpan)
                   if $iColSpan > 1;
           $oHtmlTableApp->Element
               ($iPosLine + $iLineOffset, $iPosCol)->setRowspanPar($iRowSpan)
                   if $iRowSpan > 1;
       }
   }

   $oHtmlTableApp->Element (HTML::Table::APPEND, 0, 0, "");

   $iInd = 0;
   # scan multiple primary-keys

   # With multiline-fields this makes problems, because some fields
   # are defined twice and appear like a array (here for example
   # all id_fields)
#   foreach (split /, /, &GetAttr("RecIdField"))
#   {
#      $oHtmlTableApp->Element
#       (HTML::Table::CURRENT,
#        0,
#        $iInd ++,
#        hidden(-name      => "Fld" . $_,
#               -value     => (&EncodeHtml
#                              (&MyParam("Fld" . $_)))));
#
#   }

   # Did an error occur?
   if (%hFieldErrorsMGL)
   {
      my $cField;
      my $cResult = "";

      $cResult .=
      font({-color => 'Red',
        -size => 3},
           b(&EncodeHtml
         (i18n("This is a list of the problems appeared:<BR>"))));

      foreach $cField (keys %hFieldErrorsMGL) {
      $cResult .=
          font({-color => 'Red',
            -size => 2},
           li(b(&EncodeHtml("$hFieldErrorsMGL{$cField}<BR>"))));

      }

      $oHtmlTableApp->Element(HTML::Table::APPEND, 0, 0, $cResult);

      push (@lColsWithFullWidth,
            $oHtmlTableApp->Element(HTML::Table::CURRENT, 0));
   }


   $oHtmlTableApp->Element(HTML::Table::APPEND, 0, 0,
                           &FormButtons());
   push (@lColsWithFullWidth,
         $oHtmlTableApp->Element(HTML::Table::CURRENT, 0));

   foreach (@lColsWithFullWidth)
   {
       $_->setColspanPar($oHtmlTableApp->getMaxCol());
   }

   &GenHtmlForm(undef, $oHtmlTableApp->HtmlCode(), undef);

} # sub GenPage


sub GenField($$$) # HTML (ConfigFile)
{
   my $cCellTypePI = shift;
   my $cFieldPI    = shift;
   my $cValuePI    = shift;

   my $cFieldType;
   my $cConfKey;
   my $cAttr;
   my $cResult = "";
   my @lValues;
   my @lAttr = ("H1=H1",
                "H2=H2",
                "H3=H3",
                "H4=H4",
                "H5=H5",
                "H6=H6",

                "Cite=CITE",
                "Code=CODE",
                "Del=DEL",
                "Em=EM",
                "Ins=INS",
                "Pre=PRE",
                "Strong=STRONG",
                "TT=TT",

                "Big=BIG",
                "Blink=BLINK",
                "Bold=B",
                "Italic=I",
                "NoBr=NOBR",
                "Small=SMALL",
                "Strike=STRIKE",
                "Sub=SUB",
                "Sup=SUP",
                );

   my $oPlugErrLabel =
       Plugin->new("ErrLabel",
                   "HasPrePost" => 1,
                   "HasMy"      => 1);

   @lValues = split /\\,/, $cValuePI;

   $cConfKey = "Layout $cCellTypePI $cFieldPI";

   $cFieldType = &MyVal($cConfKey, "Type",
                        ($cCellTypePI eq "Qry"?
                         "Label":
                         "Text"));


   # if the field is an id-field, it must be read-only
   if(&MyParam("WWWdbState") eq "Work")
   {
      foreach (split /, /, &GetAttr("RecIdField"))
      {
         if ($_ eq $cFieldPI)
         {
            $cFieldType = "Label"
                if $cFieldType ne "Hidden";

            last;
         }
      }
   }


   if ($cCellTypePI eq "Qry")
   {
      $cResult .= "<SMALL>";

      $cFieldPI = "_" .  $cFieldPI;

   }

   # switch on attributes
   foreach $cAttr (@lAttr)
   {
       my $cConfAttr;
       my $cHtmlAttr;

       ($cConfAttr, $cHtmlAttr) =  split /=/, $cAttr;

       # Attribute defined? Generate it!
       if(&MyVal($cConfKey, $cConfAttr, ""))
       {
           $cResult .= ("<$cHtmlAttr>");
       }
   }


   # Font-Attribute
   if(&MyVal($cConfKey, "Font", ""))
   {
       $cResult .= ("<FONT " .
                    &MyVal($cConfKey, "Font", "") .
                    ">");
   }

   if($cCellTypePI eq "Label")
   {
       my $cText;
       my $cRef = &MyVal($cConfKey, "Ref");
       my $cImg = &MyVal($cConfKey, "Image");

       if($cRef)
       {
           $cText = &ResolveRefField($cRef,
                                     i18n(&MyVal($cConfKey, "Text", $cRef)));
       }
       else
       {
           $cText = i18n(&MyVal($cConfKey, "Text", $cFieldPI));
       }


       if($cImg)
       {
           $cText = GenImage($cImg,
                             $cText,
                             &MyVal($cConfKey, "ImgBorder"));


       }
       # Text of label
       $cResult .= &EncodeHtml($cText);

   } # if($cCellTypePI eq "Label")
   else
   {
       $cResult .= &EncodeHtml($oPlugErrLabel->Call("Fld$cFieldPI"));

       if($cFieldType eq "HTML")
       {

           # include a HTML-Page
           if(-r &MyVal($cConfKey, "File"))
           {
               $cResult .= &InsertHtmlPage(&MyVal($cConfKey, "File"));
           }

       } # if($cCellTypePI eq "HTML")
       # Entry-Field for text
       elsif($cFieldType eq "Text")
       {
           $cResult .= (textfield (-name      => "Fld$cFieldPI",
                                   -maxlength => &MyVal($cConfKey,
                                                        "MaxLength",
                                                        "100"),
                                   -size      => &MyVal($cConfKey,
                                                        "Size",
                                                        "30"),
                                   -override  => 1,
                                   -value     => ($lValues[0]),
                                   &CommonInputAttr($cConfKey)));


       } # if($cFieldType eq "Text")
       # Password-field: input-data is not shown
       elsif($cFieldType eq "Password")
       {
           $cResult .= (password_field(-name      => "Fld$cFieldPI",
                                       -maxlength => &MyVal($cConfKey,
                                                            "MaxLength",
                                                            "100"),
                                       -size      => &MyVal($cConfKey,
                                                            "Size",
                                                            "30"),
                                       -value     => ($lValues[0]),
                                       -override  => 1,
                                       &CommonInputAttr($cConfKey)));


       } # if($cFieldType eq "Password")
       # enter data in more than one line
       elsif($cFieldType eq "Area")
       {
           $cResult .= (textarea(-name     => "Fld$cFieldPI",
                                 -rows     => &MyVal($cConfKey,
                                                     "Rows",
                                                     "4"),
                                 -columns  => &MyVal($cConfKey,
                                                     "Size",
                                                     "30"),
                                 -override => 1,
                                 -wrap     => &MyVal($cConfKey,
                                                     "Wrap",
                                                     "VIRTUAL"),
                                 -default  => ($lValues[0]),
                                 &CommonInputAttr($cConfKey)));


       } # if($cFieldType eq "Area")
       # enter data in more than one line
       elsif($cFieldType eq "File")
       {
           $cResult .= (filefield(-name      => "Fld$cFieldPI",
                                  -size      => &MyVal($cConfKey,
                                                       "Size",
                                                       "80"),
                                  -maxlength => &MyVal($cConfKey,
                                                       "MaxLength",
                                                       "128000"),
                                  -accept    => &MyVal($cConfKey,
                                                       "Accept",
                                                       "text/*"),
                                  -override  => 0,
                                  -default   => ($lValues[0]),
                                  &CommonInputAttr($cConfKey)));


       } # if($cFieldType eq "Area")
       elsif($cFieldType eq "Btn")
       {
           $cResult .= &SubmitButton("Btn$cFieldPI",
                                     &EncodeHtml(i18n(&MyVal($cConfKey,
                                                             "Label",
                                                             $cFieldPI))));

       } # if($cFieldType eq "Btn")
       # Hidden field, which is not shown on the screen
       elsif($cFieldType eq "Hidden")
       {
           $cResult .= hidden(-name      => "Fld$cFieldPI",
                              -override  => 1,
                              -value     => ($lValues[0]));

       } # if($cFieldType eq "Hidden")
       elsif($cFieldType eq "Label")
       {
           $cResult .= hidden(-name      => ("Fld" .
                                             $cFieldPI),
                              -override  => 1,
                              -value     => ($lValues[0]))
               unless $cCellTypePI eq "Qry";

           $cResult .= (&MyVal($cConfKey, "SafeText", "")?
                        &EncodeHtml(($lValues[0])):
                        &SafeEncodeHtml(($lValues[0])));

       } # if($cFieldType eq "Label")
       elsif($cFieldType eq "Ref")
       {
           $cResult .= &ResolveRefField($lValues[0],
                                        &MyVal($cConfKey, "Value", "->"));

       } # if($cFieldType eq "Ref")
       elsif($cFieldType eq "RecordRef")
       {
           $cResult .= a({href =>
                              &CreateReference(&GetAttr("SessionId"),
                                               (&GetAttr("ConfigFile") .
                                                ";BtnSelect=" .
                                                $lValues[1]))},
                         &EncodeHtml(i18n($lValues[0])));

       } # if($cFieldType eq "RecordRef")
       # Selection-List with more possible values
       elsif(($cFieldType eq "Select") or
             ($cFieldType eq "Radio"))
       {
           my %hLabels = undef;
           my @lListValues = undef;

           if (0) # FIXME: kick out ....
           {
           my $cValLabel;
           my @lValLabel;

           @lValLabel = &MyListVal($cConfKey, "Values", "");

           # if this is a SQL-Statement, then execute it
           if ($lValLabel[0] =~ /^select/i)
           {
               my $pResult;

               $pResult = $oDbTargetGL->SqlSelect
                   (i18n(join "\n", @lValLabel));
               # (i18n(join "\n", @lValLabel)); FIXME

               @lValLabel = @{$pResult};
           }
           else
           {
               # splits the xxxx\\,yyy into [xxxx, yyyy]
               @lValLabel = map {[split /\\,/]} @lValLabel;
           }

           # make an "undefined" label e.g. for searching
           unshift @lValLabel, ["", i18n("Undefined")]
               unless &MyVal($cConfKey, "NoUndef", ""),;

           # Split the Value,Label list in two Arrays
           foreach $cValLabel (@lValLabel)
           {
               # $cValLabel = i18n($cValLabel);

               # do we have a value and a label?
               if (ref $cValLabel)
               {
                   push @lListValues, $cValLabel->[0];
                   $hLabels{$cValLabel->[0]} = i18n($cValLabel->[1]);
               }
               else
               {
                   push @lListValues, $cValLabel;
                   $hLabels{$cValLabel} = i18n($cValLabel);
               }
           }
           }

           my @lResult = &GetSelectboxValues($cFieldPI);

           @lListValues = @{$lResult[0]};
           %hLabels     = %{$lResult[1]};

           $hSelectCacheMGL{$cFieldPI} = \%hLabels;

           if($cFieldType eq "Select")
           {

               $cResult .= (scrolling_list(-multiple  => (&MyVal($cConfKey,
                                                                 "Multiple",
                                                                 "")? "true": "0"),
                                           -name      => "Fld$cFieldPI",
                                           -values    => \@lListValues,
                                           -labels    => \%hLabels,
                                           -override  => 1,
                                           -size      => &MyVal($cConfKey,
                                                                "Rows",
                                                                "1"),
                                           -default   => \@lValues,
                                           &CommonInputAttr($cConfKey)));

           } #if($cFieldType eq "Select")
           # Selection with Radio-buttons
           elsif($cFieldType eq "Radio")
           {
               $cResult .= (radio_group(-name      => "Fld$cFieldPI",
                                        -values    => \@lListValues,
                                        -labels    => \%hLabels,
                                        -override  => 1,
                                        -default   => $lValues[0],
                                        &CommonInputAttr($cConfKey)));

           } #if($cFieldType eq "Select")
       } # if($cFieldType eq "Select") or ($cFieldType eq "Radio"))
       # Check-Button
       elsif($cFieldType eq "Checkbutton")
       {
           $cResult .= (checkbox(-name      => "Fld$cFieldPI",
                                 -checked   => $lValues[0],
                                 -value     => i18n(&MyVal($cConfKey,
                                                           "Value",
                                                           "1")),
                                 -override  => 1,
                                 -label     => (&MyVal($cConfKey,
                                                       "Text",
                                                       i18n($cFieldPI))),
                                 &CommonInputAttr($cConfKey)));

       } #if($cFieldType eq "Select")
   } # else ($cCellTypePI eq "Label")

   # switch off Font-Attribute
   if(&MyVal($cConfKey, "Font", ""))
   {
       $cResult .= "</FONT>";
   }

   # switch off Attributes
   foreach $cAttr (reverse @lAttr)
   {
       my $cConfAttr;
       my $cHtmlAttr;

       ($cConfAttr, $cHtmlAttr) =  split /=/, $cAttr;

       if(&MyVal($cConfKey, $cConfAttr, ""))
       {
           $cResult .= "</$cHtmlAttr>";
       }

   }


   $cResult .= "</SMALL>"
       if $cCellTypePI eq "Qry";

   return $cResult;

}


sub GetSelectboxValues($)
{
    my $cFieldNamePI = shift;

    my $cConfKey = "Layout Field $cFieldNamePI";
    my $cValLabel;
    my %hLabels = ();
    my @lValLabel;
    my @lListValues = ();
    my @lResult     = ();

    @lValLabel = &MyListVal($cConfKey, "Values", "");

    # if this is a SQL-Statement, then execute it
    if ($lValLabel[0] =~ /^select/i)
    {
        my $pResult;

        $pResult = $oDbTargetGL->SqlSelect
            (i18n(join "\n", @lValLabel));
        # (i18n(join "\n", @lValLabel)); FIXME

        @lValLabel = @{$pResult};
    }
    else
    {
        # splits the xxxx\\,yyy into [xxxx, yyyy]
        @lValLabel = map {[split /\\,/]} @lValLabel;
    }

    # make an "undefined" label e.g. for searching
    unshift @lValLabel, ["", i18n("Undefined")]
        unless &MyVal($cConfKey, "NoUndef", ""),;

    # Split the Value,Label list in two Arrays
    foreach $cValLabel (@lValLabel)
    {
        # $cValLabel = i18n($cValLabel);

        # do we have a value and a label?
        if (ref $cValLabel)
        {
            push @lListValues, $cValLabel->[0];
            $hLabels{$cValLabel->[0]} = i18n($cValLabel->[1]);
        }
        else
        {
            push @lListValues, $cValLabel;
            $hLabels{$cValLabel} = i18n($cValLabel);
        }
    }

    push @lResult, \@lListValues;
    push @lResult, \%hLabels;

    return @lResult;
}


# --- set some common attributes for input-fields --------------------------
sub CommonInputAttr ($) # HTML
{
    my $cConfKeyPI = shift;

    my $cResult;

    $cResult = ((&MyVal($cConfKeyPI, "Disabled", "")?
                 " DISABLED ":
                 "") .
                (&MyVal($cConfKeyPI, "Readonly", "")?
                 " READONLY ":
                 "") .
                (&MyVal($cConfKeyPI, "Tabindex", "")?
                 " TABINDEX=".&MyVal($cConfKeyPI, "Tabindex", "0"):
                 "") .
                (&MyVal($cConfKeyPI, "Help", "")?
                 " TITLE=\"".i18n(&MyVal($cConfKeyPI, "Help", ""))."\"":
                 ""));

    return $cResult;

} # sub CommonInputAttr

# --- calculate a offset for positioninf of columns ------------------------
sub CalcOffset ($$) # Tool
{
    my ($iValuePI, $iOffsetPI) = @_;

    my $iResult = $iOffsetPI;

    # Handle the form +nnn
    if ($iOffsetPI =~ /\+(\d+)/)
    {
        $iResult = $iValuePI + $1;
    }

    return $iResult;
} # sub CalcOffset


# --- create a new position-entry for the table-definitions ----------------
sub MakeNewPosEntry ($$$$\%) # Tool
{
   my ($cFieldTypePI,
       $cFieldPI,
       $cFieldPosPI,
       $cCurrFieldPosPI,
       $hFieldInfoPIO) = @_;

   my $cNewPos;
   my $iCol;
   my $iLine;
   my $iSequence;
   my $iCurrCol;
   my $iCurrLine;
   my $iCurrSequence;
   my $iLineSpan;
   my $iColSpan;

   printf STDERR "MakeNewPosEntry: FieldTypePI, $cFieldPI, $cFieldPosPI\n"
       if &GetAttr("DebugLvl") > 2;

   ($iLine, $iCol, $iSequence) = split /\./, $cFieldPosPI;
   ($iCurrLine, $iCurrCol, $iCurrSequence) = split /\./, $cCurrFieldPosPI;



   # +xx-yy: from column xx span yy columns
   if($iLine =~ /(\+?\d+)\+(\d+)/)
   {
      $iLine  = &CalcOffset($iCurrLine, $1);

      # of course the actual line must be included!
      $iLineSpan = $2 + 1;

   }
   else
   {
      $iLine  = &CalcOffset($iCurrLine, $iLine);
      $iLineSpan = 1;
   }

   # when starting on a new line, columns must start at zero
   if($iCurrLine < $iLine) {
      $iCurrCol      = 0;
      $iCurrSequence = 0;
   }
   # when starting on a new column sequences must start at zero
   if($iCurrCol < $iCol) {
      $iCurrSequence = 0;
   }


   # +xx-yy: from column xx span yy columns
   if($iCol =~ /(\+?\d+)\+(\d+)/)
   {
      $iCol  = &CalcOffset($iCurrCol, $1);

      # of course the actual column must be included!
      $iColSpan = $2 + 1;

   }
   else
   {
      $iCol  = &CalcOffset($iCurrCol, $iCol);
      $iColSpan = 1;
   }

   # when starting on a new column sequences must start at zero
   if($iCurrCol < $iCol) {
      $iCurrSequence = 0;
   }

   $iSequence = &CalcOffset($iCurrSequence, $iSequence);

   $cNewPos = sprintf("%03d.%03d.%03d.%03d.%03d",
                      $iLine,
                      $iCol,
                      $iSequence,
                      $iLineSpan,
                      $iColSpan);

   printf STDERR "MakeNewPosEntry: $cNewPos\n"
       if &GetAttr("DebugLvl") > 2;

   $$hFieldInfoPIO{"$cFieldPI.$cFieldTypePI"}{'Pos'} = $cNewPos;

   # create data in hash for sort by position
   $$hFieldInfoPIO{'Pos'}{$cNewPos} = "$cFieldPI.$cFieldTypePI";

   printf STDERR "$cFieldPI.$cFieldTypePI = $cNewPos<BR>\n"
       if &GetAttr("DebugLvl") > 2;

   return $cNewPos;
} # sub MakeNewPosEntry


# --- Generate the form-header ---------------------------------------------
sub TableHeader($) # Plugin
{
   my $cTitlePI = shift;

   my $cResult = "";

   $cTitlePI = "&nbsp;"
       if !$cTitlePI;

   $cResult .=
       table({-WIDTH   => "100%",
              -BORDER  => 0},
             (TR(td(p({-ALIGN => "LEFT"},
                      h4((&EncodeHtml
                          (i18n(&MyVal("Header", "Title"))))))),
                 td(p({-ALIGN => "RIGHT"},
                      h4(&EncodeHtml(i18n($cTitlePI))))),
                 )));

   $cResult .= hr({-noshade => 1,
                   -size => 1});

   return $cResult;

}


# --- Generate the form-footer ---------------------------------------------
sub TableFooter($) # Plugin
{
   my $cTitlePI = shift;

   my $cResult = "";


   # generated by CVS
   my $cRevision = (($iDevelopmentVersionMGL?
                     i18n("Develop-"): "") .
                    'Version: ' .
                    $VERSION .
                    ', $Date: 2003/04/16 11:25:21 $ ');

   # make version-info looking nicer
   $cRevision =~ s/ ?\$ ?//g;
   $cRevision =~ s/Revision:/i18n("Version:")/e;
   $cRevision =~ s/Date:/&i18n(" Date:")/e;
   # remove the time
   $cRevision =~ s/ (\d\d:){2}\d\d//;

   $cResult .= (hr({-noshade => 1,
                    -size => 1}) .
                p({-ALIGN => "CENTER"},
                  small("($cRevision)")));

   return $cResult;
}


sub FormHeader ($) # Plugin
{
   my $cTitlePI = shift;


}

sub FormFooter ($) # Plugin
{
   my $cTitlePI = shift;


}


# --- save actual state in a file for debugging ----------------------------
sub SaveState () # CGI
{
   my $cKey;

   my $cStateFileName =
       (&GetAttr("BaseDir") .
        "/tmp/" .
        &GetAttr("ScriptName") .
        "_state.log");

   open MY_STATE, ">$cStateFileName" or
       die(sprintf(i18n("can't open %s!!"),
                   "$cStateFileName"));

   printf STDERR (p(i18n("saved state:"),  hr({-noshade => 1,
                                               -size => 1})))
       if &GetAttr("DebugLvl") > 2;

   # due to security-reasons thes fields are deleted
   foreach $cKey ("!DataSource", "!Database", "!Username", "!Password")
   {
      &MyParamDelete($cKey);
   }

   # Hash scanning ...
   foreach $cKey (sort keys %hFormDataMGL)
   {
      if (($cKey !~ /^Btn.*/) && ($cKey !~ /^_.*/))
      {

         print STDERR "$cKey='" . &MyParam($cKey) . "'\n"
             if &GetAttr("DebugLvl") > 2;

         print MY_STATE "$cKey=" . &MyParam($cKey) . "\n";

         $hQryMGL->param (-name  => $cKey,
                          -value => &MyParam($cKey));
      }
      else
      {
         &MyParamDelete($cKey);
      }

   }

   close MY_STATE;

   chmod 0666, $cStateFileName;

} # sub SaveState



# --- Wrapper for param, which keeps %hFormDataMGL in an actual state ------
sub MyParam($;$) # CGI
{
   my ($cNamePI, $cValuePI) = @_;
   my $cResult = undef;

   # assign the value
   if (defined($cValuePI)) {

      printf STDERR "ACHTUNG!!!!! $cNamePI=$cValuePI<BR>\n"
          if !$cNamePI && &GetAttr("DebugLvl");

      $hQryMGL->param(-name  => $cNamePI,
                      -value => $cValuePI);

      $hFormDataMGL{$cNamePI} = $cValuePI;

      $cResult = $cValuePI;
   }
   # get the Value
   else
   {
      $cResult = (defined($hFormDataMGL{$cNamePI})?
                  $hFormDataMGL{$cNamePI}:
                  undef);
   }

   return $cResult;
}

# --- Wrapper for delete, which keeps %hFormDataMGL in an actual state -----
sub MyParamDelete($) # CGI
{
   my $cNamePI = shift;


   $hQryMGL->delete($cNamePI);
   delete $hFormDataMGL{$cNamePI};

}


# --- insert HTML-page -----------------------------------------------------
sub InsertHtmlPage($) # HTML
{
   my $cHtmlFilePI = shift;
   my $cResult = "";

   open TEMPLATE, "<$cHtmlFilePI" or
       die(sprintf(i18n("Can't open HTML-File %s!"),
                           "$cHtmlFilePI"));

   while (<TEMPLATE>)
   {
      $cResult .= &EncodeHtml($_);
   }

   close TEMPLATE;

   return $cResult;
} # sub InsertHtmlPage


# --- my own die-Handler ---------------------------------------------------
sub MyDie # HTML
{
    my $cMessagePI = shift;

    my $iRow;
    my $iCol;
    my $oHtmlTableStack;
    my @lCallInfo;
    my @lColsWithFullWidth = ();
    my $cMessage;
    my $cAdress     = &MyVal('WWWdb', 'MailWebmaster',
                                     ($ENV{"SERVER_ADMIN"}));
    my $cSubject    = "WWWdb-Bugreport";
    my $cBody       = "$cMessagePI\n";

    ($cMessage = $cMessagePI) =~ s/\n/\n<BR>/g;

    print STDERR "DIE: $cMessage\n";

    # this is for the table-stack (file, line, procedure)
    while (@lCallInfo = (caller($iRow++))[1..3])
    {
        $iCol = 0;

        # the stack-fields
        foreach (@lCallInfo)
        {
            print STDERR $_ . " ";
        }
        print STDERR "\n";
    }

    $oHtmlTableStack  = HTML::Table->new
        (BorderPar      => 1,
         BgColorPar     => &MyUserVal('Layout Table',
                                      'BgColor',
                                      $cBgColorMGL),
         WidthPar       => "100%",
         HeightPar      => "100%");

    $oHtmlTableStack->Element
        (HTML::Table::APPEND, 0, 0,
         b(i18n("Oops! The following problem occured within " .
                "<B>WWWdb</B>!")));
    push @lColsWithFullWidth, $oHtmlTableStack->Element
        (HTML::Table::CURRENT, 0);

    $oHtmlTableStack->Element(HTML::Table::APPEND, 0, 0,
                              ($_ . p(small($cMessage))));
    push @lColsWithFullWidth, $oHtmlTableStack->Element
        (HTML::Table::CURRENT, 0);

    $oHtmlTableStack->Element(HTML::Table::APPEND, 0, 0,
                              b(i18n("Call-Stack:")));
    push @lColsWithFullWidth, $oHtmlTableStack->Element
        (HTML::Table::CURRENT, 0);

    $oHtmlTableStack->Element(HTML::Table::APPEND,
                            HTML::TableRow->new());

    $iCol = 0;
    # Generate the table-header
    foreach (i18n("File"),
             i18n("Line"),
             i18n("Procedure"))
    {
        $oHtmlTableStack->Element(HTML::Table::CURRENT, $iCol++, 0,
                                  small(b($_)));
    }

    $iRow = 0;

    # this is for the table-stack (file, line, procedure)
    while (@lCallInfo = (caller($iRow++))[1..3])
    {

        $oHtmlTableStack->Element
            (HTML::Table::APPEND,
           HTML::TableRow->new(BgColorPar => ($iRow %2?
                                              "#eeeeee":
                                              "#ffffff")));

        $iCol = 0;

        # the stack-fields
        foreach (@lCallInfo)
        {
            $oHtmlTableStack->Element(HTML::Table::CURRENT, $iCol++, 0,
                                      small($_));
            $cBody .= " $_";
        }

        $cBody .= "\n";

    }

    foreach ("LastBtn",
             "Lang",
             "BaseLang",
             "State",
             "RecordOk",
             "ScriptName",
             "HostName",
             "DebugLvl",
             "BaseDir",
             "DbDriver",
             "DbHandle",
             "ConfigPath",
             "ConfigFile",
             "SessionId",
             "UrlParams",
             "LogfileName",
             "HTMLfileName",
             "RecIdField",
             "RecId",
             "ObjectId")
    {
        $cBody .= sprintf("%s = '%s'\n",
                          $_, &GetAttr($_));

    }

    # make this rows full-sized
    foreach (@lColsWithFullWidth)
    {
        $_->setColspanPar($oHtmlTableStack->getMaxCol());
    }


    $cSubject =~ s/ /%20/g;
    $cBody    =~ s/ /%20/g;
    $cSubject =~ s/\n/%0D/g;
    $cBody    =~ s/\n/%0D/g;

    $oHtmlTableStack->Element
        (HTML::Table::APPEND, 0, 0,
         a({HREF => "mailto:$cAdress?subject=$cSubject&body=$cBody"},
           i18n("Please send this bugreport!")));

    # make this rows full-sized
    $oHtmlTableStack->Element(HTML::Table::CURRENT, 0)->
        setColspanPar($oHtmlTableStack->getMaxCol());

    &Error($oHtmlTableStack->HtmlCode);

} # sub MyDie



=head2 Error - show a error-frame and leave

    =over 2

    =item B<DESCRIPTION>

FIXME: add docs

    - HTTP-link: http://<host>
    - WWWdb-link: wwwdb://<Config-file>[;<Par>=<Value> ...]

    =item B<SYNOPSIS>

    $http_ref = ResolveRefField($ref_field, $label);

=item B<RETURN VALUE>

    A correct HTML-Reference for the values, given as parameters.

    =item B<EXAMPLE>

    # Generate a Link to WWWdb:Index for the current session and db
    $hppt_ref = ResolveRefField("wwwdb://WWWdb:Index;Lang=de",
                                "Main-Index");

=item B<SEE ALSO>

=back

=cut

# --- Show an error frame --------------------------------------------------
    sub Error($) # HTML
{
    my $cMessagePI = shift;

    my $cMessage = $cMessagePI . "<BR><BR>";

    &OkForm("Die",
            "$cMessage");

    $iCacheTimeoutMGL = 0;

    &MyExit();
} # sub MyDie



=head2 MyExit - leave WWWdb in a clean way

=over 2

=item B<DESCRIPTION>

FIXME: add docs

    - HTTP-link: http://<host>
    - WWWdb-link: wwwdb://<Config-file>[;<Par>=<Value> ...]

=item B<SYNOPSIS>

    $hppt_ref = ResolveRefField($ref_field, $label);

=item B<RETURN VALUE>

    A correct HTML-Reference for the values, given as parameters.

=item B<EXAMPLE>

    # Generate a Link to WWWdb:Index for the current session and db
    $hppt_ref = ResolveRefField("wwwdb://WWWdb:Index;Lang=de",
                                "Main-Index");

=item B<SEE ALSO>

=back

=cut

# --- exit this program in a clean way -------------------------------------
    sub MyExit() # HTML Db
{
    my $iDebugLvl = &GetAttr("DebugLvl");

    # Update the DB now
  DBIx::Recordset::Undef("pDataSetMGL");

  Plugin::_UndefAllPlugins();

    if (defined $oFormMGL)
    {
        print $oFormMGL->HtmlCode();
    }

    $oSessionGL   = undef;
    $oDbSessionGL = undef;
    $oDbTargetGL = undef;

    close STDERR;

    # in debugging-mode generate the whole logfile into HTML
    if ($iDebugLvl)
    {
        open LOGFILE, "<" . &GetAttr("LogfileName") or
            die (sprintf("Can't open Log-file %s!",
                         &GetAttr("LogfileName")));

        print STDOUT "<SMALL><PRE>";

        while (<LOGFILE>)
        {
            print STDOUT "$_<BR>";
        }
        print STDOUT "</PRE></SMALL>";

        close LOGFILE;

    }

    # dump out the cache-file, when the timeout is set
    &CGI::Cache::Stop($iCacheTimeoutMGL? 1: 1);

    # expire this document
    &CGI::Cache::Expire()
        unless $iCacheTimeoutMGL;

    exit;

}


# --- generate label for fields containing errors --------------------------
sub ErrLabel($) # HTML Plugin
{
    my $cFieldPI = shift;

    return (defined($hFieldErrorsMGL{$cFieldPI})?
            font({-color => 'Red'},
                 b(" (*)")):
            "");
} # sub ErrLabel



=head2 MyUserVal - Get an entry of the config-file, but look for session-data before

=over 2

=item B<DESCRIPTION>

FIXME: add docs

    - HTTP-link: http://<host>
    - WWWdb-link: wwwdb://<Config-file>[;<Par>=<Value> ...]

=item B<SYNOPSIS>

    $hppt_ref = ResolveRefField($ref_field, $label);

=item B<RETURN VALUE>

    A correct HTML-Reference for the values, given as parameters.

=item B<EXAMPLE>

    # Generate a Link to WWWdb:Index for the current session and db
    $hppt_ref = ResolveRefField("wwwdb://WWWdb:Index;Lang=de",
                                "Main-Index");

=item B<SEE ALSO>

=back

=cut

# --- Wrapper for MyVal looking in the SessionId-Table before -------------------
    sub MyUserVal($$;$) # SessionId ConfigFile
{
    my ($cSectionPI, $cEntryPI, $cDefaultPI) = @_;

    my $cResult = undef;

    $cResult = $oSessionGL->getState("[$cSectionPI] $cEntryPI")
        if defined($oSessionGL);

    if (!defined $cResult)
    {
        $cResult = &MyVal($cSectionPI, $cEntryPI, $cDefaultPI)
        }

    return $cResult;
}



=head2 MyVal - Get an entry of the config-file

=over 2

=item B<DESCRIPTION>

FIXME: add docs

    - HTTP-link: http://<host>
    - WWWdb-link: wwwdb://<Config-file>[;<Par>=<Value> ...]

=item B<SYNOPSIS>

    $hppt_ref = ResolveRefField($ref_field, $label);

=item B<RETURN VALUE>

    A correct HTML-Reference for the values, given as parameters.

=item B<EXAMPLE>

    # Generate a Link to WWWdb:Index for the current session and db
    $hppt_ref = ResolveRefField("wwwdb://WWWdb:Index;Lang=de",
                                "Main-Index");

=item B<SEE ALSO>

=back

=cut


# --- Wrapper for val, to read single-entries of the config-file -----------
    sub MyVal($$;$) # ConfigFile
{
    my ($cSectionPI, $cEntryPI, $cDefaultPI) = @_;

    my $cResult = defined($cDefaultPI)? $cDefaultPI: "";

    if (defined($oConfPoolGL))
    {
        my $cResultConfigPool =
            $oConfPoolGL->getValue($cSectionPI, $cEntryPI);

        $cResult = $cResultConfigPool
            if (defined $cResultConfigPool);

    }

    return $cResult;
}



=head2 MySetVal - Set an entry, defined in the config-file

=over 2

=item B<DESCRIPTION>

FIXME: add docs

    - HTTP-link: http://<host>
    - WWWdb-link: wwwdb://<Config-file>[;<Par>=<Value> ...]

=item B<SYNOPSIS>

    $hppt_ref = ResolveRefField($ref_field, $label);

=item B<RETURN VALUE>

    A correct HTML-Reference for the values, given as parameters.

=item B<EXAMPLE>

    # Generate a Link to WWWdb:Index for the current session and db
    $hppt_ref = ResolveRefField("wwwdb://WWWdb:Index;Lang=de",
                                "Main-Index");

=item B<SEE ALSO>

=back

=cut

# --- Wrapper for val, to read single-entries of the config-file -----------
    sub MySetVal($$@) # ConfigFile
{
    my $cSectionPI = shift;
    my $cEntryPI   = shift;
    my @pValuePI   = @_;

    if (defined($oConfPoolGL))
    {
        $oConfPoolGL->setValue($cSectionPI, $cEntryPI, @pValuePI);
    }
}



# --- Wrapper for val, to read list-entries of the config-file -------------
sub MyListVal($$;$) # ConfigFile
{
    my ($cSectionPI, $cEntryPI, $cDefaultPI) = @_;

    my $cResult;
    my @lResult = ();

    if (defined($oConfPoolGL))
    {
        my $cResultConfigPool =
            $oConfPoolGL->getValue($cSectionPI, $cEntryPI);


        @lResult = split "\n", $cResultConfigPool;
    }

    return @lResult;
}

=head2 GetSelRadioLabel - Get the label from a Select-Field or Radio-Box

=over 2

=item B<DESCRIPTION>

    This function returns the value or values of an Selectbox or radiofield.

=item B<SYNOPSIS>

    $label = ResolveRefField($field[, $value]);

=item B<RETURN VALUE>

    If only the fieldname is passed, then the whole field/label-list
    is returned. If a valid value is passed too, then the corresponding
    label will be returned.

=item B<EXAMPLE>

    # Get the Label for the "status"-field
    $cLabel = &GetSelRadioLabel("status", $iStatus);

=item B<SEE ALSO>

=back

=cut

sub GetSelRadioLabel($;$)
{
    my $cFieldNamePI = shift;
    my $cValuePI     = shift;



    unless (defined $hSelectCacheMGL{$cFieldNamePI})
    {
        my @lListValues;
        my %hLabels;
        my @lResult = &GetSelectboxValues($cFieldNamePI);

        @lListValues = @{$lResult[0]};
        %hLabels     = %{$lResult[1]};

        $hSelectCacheMGL{$cFieldNamePI} = \%hLabels;
    }

    if(defined $cValuePI)
    {
        return $hSelectCacheMGL{$cFieldNamePI}->{$cValuePI};
    }
    else
    {
        return $hSelectCacheMGL{$cFieldNamePI};
    }
}


=head2 Redirect - redirect the browser to another HTML-page

=over 2

=item B<DESCRIPTION>

FIXME: add docs

    - HTTP-link: http://<host>
    - WWWdb-link: wwwdb://<Config-file>[;<Par>=<Value> ...]

=item B<SYNOPSIS>

    $hppt_ref = ResolveRefField($ref_field, $label);

=item B<RETURN VALUE>

    A correct HTML-Reference for the values, given as parameters.

=item B<EXAMPLE>

    # Generate a Link to WWWdb:Index for the current session and db
    $hppt_ref = ResolveRefField("wwwdb://WWWdb:Index;Lang=de",
                                "Main-Index");

=item B<SEE ALSO>

=back

=cut

    sub Redirect($$) # HTML
{
    my ($cSessionIdPI, $cConfigFilePI) = @_;

    $oFormMGL = undef;

    printf STDERR ("REDIRECT TO %s\n",
                   &CreateReference($cSessionIdPI, $cConfigFilePI))
        if &GetAttr("DebugLvl") > 2;

    print redirect(&CreateReference($cSessionIdPI, $cConfigFilePI))
        if &GetAttr("DebugLvl") < 10;

    $iCacheTimeoutMGL = 0;

    &MyExit();
}





=head2 CreateReference - makes an internal WWWdb-HTML-reference

=over 2

=item B<DESCRIPTION>

FIXME: add docs

    - HTTP-link: http://<host>
    - WWWdb-link: wwwdb://<Config-file>[;<Par>=<Value> ...]

=item B<SYNOPSIS>

    $hppt_ref = ResolveRefField($ref_field, $label);

=item B<RETURN VALUE>

    A correct HTML-Reference for the values, given as parameters.

=item B<EXAMPLE>

    # Generate a Link to WWWdb:Index for the current session and db
    $hppt_ref = ResolveRefField("wwwdb://WWWdb:Index;Lang=de",
                                "Main-Index");

=item B<SEE ALSO>

=back

=cut


sub CreateReference($$) # HTML
{
    my ($cSessionIdPI, $cConfigFilePI) = @_;

    my $cResult;

    # FIXME: use $ENV{"SERVER_PROTOCOL"}

    $cResult = sprintf("http%s://%s/%s%s/%s/%s",
                       &UnTaint($ENV{"HTTPS"})? "s": "",
                       &GetAttr("HostName"),
                       (&GetAttr("WWWdbDomain") eq "NULL"?
                        "":
                        &GetAttr("WWWdbDomain") . "/"),
                       $cSessionIdPI,
                       &GetAttr("DbDriver"),
                       $cConfigFilePI);

    return $cResult;

}





=head2 ResolveRefField - Resolve a Reference of an wwwdb_object

=over 2

=item B<DESCRIPTION>

    Resolve a Reference of an wwwdb_object to a correct HTTP-Url.
    This Reference can have one of the following forms:

    - HTTP-link: http://<host>
    - WWWdb-link: wwwdb://<Config-file>[;<Par>=<Value> ...]

=item B<SYNOPSIS>

    $hppt_ref = &ResolveRefField($ref_field, $label);

=item B<RETURN VALUE>

    A correct HTML-Reference for the values, given as parameters.

=item B<EXAMPLE>

    # Generate a Link to WWWdb:Index for the current session and db
    $hppt_ref = ResolveRefField("wwwdb://WWWdb:Index;Lang=de",
                                "Main-Index");

=item B<SEE ALSO>

=back

=cut

    sub ResolveRefField($$) # HTML
{
    my $cRefFieldPI = shift;
    my $cLabelPI    = shift;
    my $cResult;

    $cResult = "";

    # WWWdb-Link (wwwdb://xxx)
    if($cRefFieldPI =~ "wwwdb://(.*)")
    {
        $cResult = a({href => &CreateReference
                          (&GetAttr("SessionId"), $1)},
                     &EncodeHtml(i18n($cLabelPI)));
    }
    # normal http-Link
    elsif($cRefFieldPI =~ "https?://.*")
    {
        $cResult = a({href   => $cRefFieldPI,
                      target => "_wwwdb_new"},
                     &EncodeHtml(i18n($cLabelPI)));
    }
    # mail-reference
    elsif($cRefFieldPI =~ "mailto:.*")
    {
        $cResult = a({href => $cRefFieldPI},
                     &EncodeHtml(i18n($cLabelPI)));
    }
    # file-reference
    elsif($cRefFieldPI =~ "file:.*")
    {
        $cResult = a({href => $cRefFieldPI},
                     &EncodeHtml(i18n($cLabelPI)));
    }
    # Anything else as Text
    else
    {
        $cResult = b(&EncodeHtml(i18n($cRefFieldPI)));
    }

    return $cResult;
}

# --- Include a image --------------------------------------------------
sub GenImage($;$$)
{
    my $cSrcPI    = shift;
    my $cAltPI    = shift;
    my $cBorderPI = shift;

    my $cResult = "";
    my $cExt    = undef;
    my $cSrc    = ("/" .
                   &GetAttr("BaseDir") .
                   "/lib/" .
                   $cSrcPI);

    foreach ("", ".jpg", ".png", ".gif", ".JPG", ".PNG", ".GIF")
    {
        $cExt = $_;

        print STDERR "GRAFIK: $cSrc$_\n";

        last
            if -f "$cSrc$_";

        $cExt = undef;
    }

    if (defined $cExt)
    {
        if (defined $cAltPI)
        {
            $cResult = img({SRC    => ("/" .
                                       &GetAttr("ScriptName") .
                                       "/lib/" .
                                       $cSrcPI .
                                       $cExt),
                                           ALT    => $cAltPI,
                                           BORDER => $cBorderPI});
        }
        else
        {
            $cResult =("/" .
                       &GetAttr("ScriptName") .
                       "/lib/" .
                       $cSrcPI .
                       $cExt);
        }
    }
    else
    {
        $cResult = "";
    }

    return $cResult;

}

# --- Interface for internationalisation -------------------------------
{
sub i18n($)
{
   my $cMessage = shift;

   my $cResult;

   $cResult = $hMessagesGL{$cMessage} || $cMessage;

   printf STDERR ("i18n(%s) => '%s'\n",
                  $cMessage,
                  $cResult)
       if &GetAttr("DebugLvl") > 3;

   # This is for untranslated ones
   if($cResult =~ /^FIXME /)
   {
      $cResult =~ s/FIXME //;

      $cResult = "[$cResult]"
          if &GetAttr("DebugLvl") > 9;
   }

   $cResult = "($cResult)"
       if (&GetAttr("DebugLvl") > 9);


   return $cResult;
}
}


=head2 GetField - Get value of a Field in the HTML-Form

=over 2

=item B<DESCRIPTION>

    Gets the current value of the field $field_name in the html-form and
    returns it.

=item B<SYNOPSIS>

    GetField (field_name)

=item B<RETURN VALUE>

    A string, containig the value of the input-field representing the
    field in the html-form. If the field-name does not exist,
    the function returns an empty string "".

=item B<EXAMPLE>

    # get the customer-id (custnum)
    $iCustNumber = &WWWDb::GetField("custnum");

=item B<SEE ALSO>

    SetField

=back

=cut

# ------------------------------------------------------------------------------
sub GetField($) # Db-Record
{
    my $cFieldNamePI = shift;

    my $cResult = &MyParam("Fld$cFieldNamePI");

    print STDERR ">> GetField($cFieldNamePI)\n"
        if &GetAttr("DebugLvl");

    print STDERR "<< GetField($cResult)\n"
        if &GetAttr("DebugLvl");

    return $cResult;
}






=head2 SetField - Sets the value of a HTML-field

=over 2

=item B<DESCRIPTION>

    Sets the value of the field $field_name in the HTML-Form to the value
    $value. In CGI it is threated as a parameter and passed via POST, so
    you can use it in the next turn again.

=item B<SYNOPSIS>

    SetField (field_name, $value);

=item B<RETURN VALUE>

    None.

=item B<EXAMPLE>

    # Set the Customer-id to 42
    &WWWdb::SetField("custnum", 42);

=item B<SEE ALSO>

    GetField

=back

=cut

# ------------------------------------------------------------------------------
    sub SetField($$) # Db-Record
{
    my $cFieldNamePI = shift;
    my $cValuePI     = shift;

    print STDERR ">> SetField($cFieldNamePI, '$cValuePI')\n"
        if &GetAttr("DebugLvl");

    &MyParam("Fld$cFieldNamePI", $cValuePI);
    return;
}







=head2 AddError - Add an error-message to the internal list

=over 2

=item B<DESCRIPTION>

    Add an user-error-message to the internal error-message-list. This
    message is linked with the field $field_name. That means that
    this field is marked on the html-form and on the bottom of the form
    the $error_message is included in the list of errors.

=item B<SYNOPSIS>

    AddError ($field_name, $error_message);

=item B<RETURN VALUE>

    None.

=item B<EXAMPLE>

    # The field custnum must be filled
    if (&GetField("custnum"))
{
    &AddError("custnum", "Please enter a valid customer-number");
}

=back

=cut

#-------------------------------------------------------------------------------
    sub AddError($$) # Db-Record
{
    my $cFieldNamePI = shift;
    my $cErrorTextPI = shift;

    print STDERR ">> AddError($cFieldNamePI, $cErrorTextPI)\n"
        if &GetAttr("DebugLvl");

    $hFieldErrorsMGL{"Fld$cFieldNamePI"} = $cErrorTextPI;

    return;
}





=head2 DecodeHtml - decodes HTML-formatted entities to normal Text

=over 2

=item B<DESCRIPTION>

    Decodes HTML-formatted entities to normal Text. This means that, when
    you have HTML-Entities like &uuml;, but you want human-readable data,
    you have to convert it. This function does this conversion.


=item B<SYNOPSIS>

    $decoded_text = DecodeHtml($encoded_text);

=item B<RETURN VALUE>

    The decoded text.

=item B<EXAMPLE>

    # We need a ©-Sign
    $copyright_sign = DecodeHtml("&copy;");

=item B<SEE ALSO>

    EncodeHtml, SafeEncodeHtml

=back

=cut

# ------------------------------------------------------------------------------
    sub DecodeHtml($) # HTML
{
    my @lMessagePI = @_;

    print STDERR ">> DecodeHtml(@lMessagePI)\n"
        if &GetAttr("DebugLvl");

    for (@lMessagePI)
    {
        $_ = decode_entities($_);
    }

    return (wantarray? @lMessagePI: $lMessagePI[0]);

}


=head2 EncodeHtml - encode normal text, to be HTML-save

=over 2

=item B<DESCRIPTION>

    EncodeHtml encodes normal text, to be HTML-save. When you do this, any
    characters, which have a special meaning or coding in HTML, will be translated into
    correct HTML-entities. So you can savely use special characters like umlauts
    without caring, if HTML can display them correctly.

    B<NOTE>: This function does NOT decode the HTML-characters <, >, &, ; and \"

=item B<SYNOPSIS>

    $encoded_text = EncodeHtml($text_to_encode);

=item B<RETURN VALUE>

    The encoded text.

=item B<EXAMPLE>

    # öäü -> &ouml;&auml;&uuml;
    $encoded_text = EncodeHtml("öäü");

=item B<SEE ALSO>

    SafeEncodeHtml

=back

=cut

# --- encode HTML-Entities, but preserve HTML-Tags (ü -> &uuml;) ----------------
    sub EncodeHtml($) # HTML
{
    my @lMessagePI = @_;

    print STDERR ">> EncodeHtml(@lMessagePI)\n"
        if &GetAttr("DebugLvl");

    for (@lMessagePI)
    {
        $_ = encode_entities($_, "\200-\377");
    }

    return (wantarray? @lMessagePI: $lMessagePI[0]);

}



=head2 SafeEncodeHtml - extended encoding of HTML-Tags

=over 2

=item B<DESCRIPTION>

    EncodeHtml encodes normal text, to be HTML-save. When you do this, any
    characters, which have a special meaning or coding in HTML, will be
    translated into correct HTML-entities. So you can savely use special
    characters like umlauts without caring, if HTML can display them
    correctly. So long this behaves as B<EncodeHtml>, but this function
    handles the HTML-characters <, >, &, ; and \" too.

    You will need this function by example to secure user-input, which
    will be displayed later in HTML. Some bad guy could enter HTML-tags,
    which show things on your site, you want not to display.

=item B<SYNOPSIS>

    $encoded_text = SafeEncodeHtml($text_to_encode);

=item B<RETURN VALUE>

    The safe encoded text.

=item B<EXAMPLE>

    use CGI;

# print input of user
print p(SafeEncodeHtml($input_from_user));

=item B<SEE ALSO>

    SafeEncodeHtml

=back

=cut

# --- encode HTML-Entities, including <>&;" (ü -> &uuml;) -----------------------
    sub SafeEncodeHtml($) # HTML
{
    my @lMessagePI = @_;

    print STDERR ">> SafeEncodeHtml(@lMessagePI)\n"
        if &GetAttr("DebugLvl");

    for (@lMessagePI)
    {
        $_ = encode_entities($_);
    }

    return (wantarray? @lMessagePI: $lMessagePI[0]);

}


# --- Create a reference for Scan-Doc ---------------------------------------
sub CreRef($$$)
{
    my $cPreTextPI  = shift;
    my $cRefPI      = shift;
    my $cPostTextPI = shift;

    return ($cPreTextPI .
            &CreateReference(&GetAttr("SessionId"), $cRefPI) .
            $cPostTextPI);
}


# --- Scan HTML-Text and replace WWWdb-specific references ------------------
sub ScanDoc($)
{
    my $cText = shift;
    my $cAppl  = &GetAttr("ScriptName");

    $cText =~ s!=\"?wwwdb://(.*?)\"?>!&CreRef("=", $1, ">")!gei;

    $cText =~ s!src=[\"\']?/wwwdb/([^\"\'\s]+)[\"\']?\s*!SRC=\"/$cAppl/$1\" !gi;

    return $cText;
}





=head2 GetFieldTypeName - get the fieldtype-name of a given field

=over 2

=item B<DESCRIPTION>

    This function returns the SQL-Fieldtype of the given field.
    This is a short text like "varchar", "integer", etc.

=item B<SYNOPSIS>

    $cust_type = GetFieldTypeName($field_name);

=item B<RETURN VALUE>

    The SQL-fieldtype or undef, if the field does not exist.

=item B<EXAMPLE>

    # Convert date fields
    if(&GetFieldTypeName($field) eq "date")
{
    &ConvertData($record{$field});
}

=item B<SEE ALSO>

    -

=back

=cut


# --- Get the field-type of the field -----------------------------------------
sub GetFieldTypeName($) # Database
{
    my $cFieldNamePI = shift;

    my $cResult = undef;

    print STDERR ">> GetFieldTypeName($cFieldNamePI)\n"
        if &GetAttr("DebugLvl");

    if (defined $hTableInfoMGL{$cFieldNamePI})
    {
        $cResult = (defined $hTableInfoMGL{$cFieldNamePI}{"TYPE_NAME"}?
                    $hTableInfoMGL{$cFieldNamePI}{"TYPE_NAME"}:
                    undef);

    }

    print STDERR "<< GetFieldTypeName($cResult)\n"
        if &GetAttr("DebugLvl");

    return $cResult;

}


=head2 GetObjectId - get the id of the corresponding navigation-object

=over 2

=item B<DESCRIPTION>

    FIXME

    This procedure checks the existence of a session-parameter and those
    value.  If every thing is alright, the value 1 is returned. When the
    session-parameter is preceeded by a "!", the check is negated.

=item B<SYNOPSIS>

    $b_value = IsAttribOK($name_of_session_parameter);

=item B<RETURN VALUE>

    1 if the session-parameter exists, an has a value, else 0 (or vice
                                                               versa if negated)

=item B<EXAMPLE>

# Check, if we are logged in
    $bLoggedInCorrectly = IsAttribOK("ActualLogin");

=item B<SEE ALSO>

=back

=cut


# --- Get the Object-Id of the current application --------------------------
    sub GetObjectId () # Nav (Database)
{
    my $iResult = 0;

    my $cUrlParams = &GetAttr("UrlParams");
    my @lUrlParams = split ";", $cUrlParams;
    my $cLinkKey;

    # the url-param overloads the value of the form
    foreach (@lUrlParams)
    {

        $iResult = $1
            if (/^cat=(\d+)/);
    }


    $cLinkKey = ("wwwdb://" .
                 ($iResult?  "WWWdb:Nav": &GetAttr("ConfigFile")) .
                 ($cUrlParams? (";" . $cUrlParams): ""));

    # get object-info
    $iResult = ($oDbSessionGL->SqlSelect
                ("SELECT
                   id_object
                 FROM
                   wwwdb_object
                 WHERE
                   ref_link = ?",
                 $cLinkKey))->[0]->[0];

    # we had no success ... lets try it without the url-parameters
    if (!$iResult)
    {

        $cLinkKey = ("wwwdb://" .
                     &GetAttr("ConfigFile"));

        # get category-info
        $iResult = ($oDbSessionGL->SqlSelect
                    ("SELECT
                      id_object
                    FROM
                      wwwdb_object
                    WHERE
                      ref_link = ?",
                     $cLinkKey))->[0]->[0];
    }

    return $iResult;
}

# FIXME: implement GetCategoryId too

=head2 IsAttribOK - check a navigation-attribute

=over 2

=item B<DESCRIPTION>

    This procedure checks the existence of a session-parameter and those
    value.  If every thing is alright, the value 1 is returned. When the
    session-parameter is preceeded by a "!", the check is negated.

=item B<SYNOPSIS>

    $b_value = IsAttribOK($name_of_session_parameter);

=item B<RETURN VALUE>

    1 if the session-parameter exists, an has a value, else 0 (or vice
                                                               versa if negated)

=item B<EXAMPLE>

# Check, if we are logged in
    $bLoggedInCorrectly = IsAttribOK("ActualLogin");

=item B<SEE ALSO>

=back

=cut


# --- check if the expression $cAttribPI is true ----------------------------
    sub IsAttribOK ($@) # Session-Id
{
    my $cAttribPI = shift;
    my $iResult   = 999;

    my %hBuiltins = ("IsHidden"     => 1,
                     "IsSSL"        => 1,
                     @_);

    my $cOp   = "";
    my $cAttr = $cAttribPI;
    printf STDERR "cAttrPI = '$cAttr'\n";

    # pre-substitute all matching builtins
    foreach (keys %hBuiltins)
    {
        printf STDERR $hBuiltins{$_}." <= $_\n";
        $cAttr =~ s/$_/$hBuiltins{$_}/ge;
    }

    # This application should be hidden in categories, etc
    printf STDERR "cAttr = '$cAttr'\n";
    if($cAttr ne "" && defined $oSessionGL)
    {
        $cAttr =~ s/([A-Za-z_]+)/$oSessionGL->getState($1)?1:0/ge;
        $cAttr = '$iResult = (' . $cAttr . ')';

        $iResult = eval {
            eval $cAttr;
            printf STDERR "A: cAttr = '$cAttr' => '$iResult'\n";
            return $iResult;
        };

        $iResult = -999
            if $@;

        printf STDERR "B: cAttr = '$cAttr' => '$iResult'\n";
    }
    else
    {
        $iResult = 1;
    }

    printf STDERR "B: iResult = '$iResult'\n";

    return $iResult;
}


=head2 SQLSelectList - Get the SQL-SELECT-result as a list

=over 2

=item B<DESCRIPTION>

    SQLSelectList executes the Statement, given as argument, and returns a
    list of all found records with the fields backslach and
    comma-separated (\\,).

=item B<SYNOPSIS>

    @result_list = SQLSelectList($sql_select_statement);

=item B<RETURN VALUE>

    A array, containing one elemen for each found record. Inside the
    record, all the fields are separated with commas. When used in a
    scalar-context, perl will return the number of selected rows.

=item B<EXAMPLE>

    # check if login for Joe User is ok
    if(&SQLSelectList("SELECT username
                    FROM users
                    WHERE username = 'joe user' AND
                          password = '42'"))
{
    print "ok, you are Joe User\n";
}

# print all users
foreach (&SQLSelectList("SELECT username FROM users"))
{
    print "$_\n";
}

=item B<SEE ALSO>

    SQLDo

=back

=cut


# --- Execute the SQL-Select-statement and return the result as a list ---------
    sub SQLSelectList ($) # Database
{
    my $cSelectCmdPI = shift;

    my $cRecord;
    my $cResult;
    my $pStmtHdl;
    my $phRecord;
    my @lResult;

    print STDERR ">> SQLSelectList($cSelectCmdPI)\n"
        if &GetAttr("DebugLvl");

    return undef
        if(!defined $pDbHdlMGL);

    $pStmtHdl = $pDbHdlMGL->prepare($cSelectCmdPI);
    $pStmtHdl->execute();

    if($pStmtHdl->err())
    {
        &MyDie(sprintf(i18n("Database Error occured during %s!") . "<BR>" .
                       i18n("    SQL-Error: (%d) %s") . "<BR>" .
                       i18n("    Statement: %s") . "<BR>",
                       "SQLSelectList",
                       $pStmtHdl->err,
                       $pStmtHdl->errstr,
                       $cSelectCmdPI));
    }

    while ($cRecord = join "\\,", $pStmtHdl->fetchrow_array)
    {
        print STDERR "Select: $cRecord\n"
            if &GetAttr("DebugLvl");

        push @lResult, $cRecord;
    }

    $pStmtHdl->finish;

    print STDERR "<< SQLSelectList(@lResult)\n"
        if &GetAttr("DebugLvl");

    return @lResult;

}



=head2 SQLDo - executes the given SQL-statement

=over 2

=item B<DESCRIPTION>

    SQLDo executes the Statement, given as argument, and returns the
    number of affected records

=item B<SYNOPSIS>

    $nr_of_records = SQLDo($sql_statement);

=item B<RETURN VALUE>

    The number of Rows affected
# FIXME: What comes if an error is detected

=item B<EXAMPLE>

    # create a login for Joe User
    $nr_fo_records = &SQLDo("INSERT INTO username (username, password)
                             VALUES ('joe user', '42')");

=item B<SEE ALSO>

    SQLSelectList

=back

=cut


# --- Execute the SQL-Select-statement and return the result as a list ---------
    sub SQLDo ($) # Database
{
    my $cSelectCmdPI = shift;

    my $cRecord;
    my $cResult;
    my $pStmtHdl;
    my $phRecord;

    print STDERR ">> SQLDo($cSelectCmdPI)\n"
        if &GetAttr("DebugLvl");

    $pStmtHdl = $pDbHdlMGL->prepare($cSelectCmdPI);
    $cResult = $pStmtHdl->execute();

    if($pStmtHdl->err())
    {
        &MyDie(sprintf(i18n("Database Error occured during %s!") . "<BR>" .
                       i18n("    SQL-Error: (%d) %s") . "<BR>" .
                       i18n("    Statement: %s") . "<BR>",
                       "SQLDo",
                       $pStmtHdl->err,
                       $pStmtHdl->errstr,
                       $cSelectCmdPI));
    }

    $pStmtHdl->finish;

    print STDERR "<< SQLDo($cResult)\n"
        if &GetAttr("DebugLvl");

    return $cResult;

}



=head2 GetAttr - Get some internal WWWdb-attributes

=over 2

=item B<DESCRIPTION>

    GetAttr gets the values of some WWWdb-attributes:

    - LastBtn
    - State
    - RecordOk
    - ScriptName
    - HostName
    - BaseDir
    - DbDriver
    - ConfigPath
    - ConfigFile
    - SessionId
    - UrlParams
    - LogfileName
    - HTMLfileName
    - RecIdField
    - RecId


=item B<SYNOPSIS>

    $value = GetAttr($attribute_name);

=item B<RETURN VALUE>

    The Value of the selected Attribute

=item B<EXAMPLE>

    # Get the Driver of the Database
    $db_driver = &GetAttr("DbDriver");

=item B<SEE ALSO>

=back

=cut


# --- Execute the SQL-Select-statement and return the result as a list ---------
sub GetAttr ($) # CGI ENV ConfigFile
{
    my $cAttrTypePI = shift;
    my $cResult = undef;

  switch: for ($cAttrTypePI)
  {
      /^LastBtn$/ && do {
          $cResult = &MyParam("WWWdbLastBtn");
          last switch;
      };

      /^Lang$/ && do {
          $cResult = &MyUserVal('WWWdb', 'Lang', 'en');
          last switch;
      };

      /^BaseLang$/ && do {
          $cResult = &MyVal('WWWdb', 'Lang', 'en');
          last switch;
      };

      /^State$/ && do {
          $cResult = &MyParam("WWWdbState");
          last switch;
      };

      /^RecordOk$/ && do {
          &CheckRecord();

          $cResult = (%hFieldErrorsMGL)? "": "Yes";
          last switch;
      };

      /^ScriptName$/ && do {

          # same as basename
          ($cResult = &GetAttr("BaseDir")) =~ s{.*/}{};
          last switch;
      };

      /^WWWdbDomain$/ && do {

          $cResult = (&UnTaint($ENV{"WWWDB_DOMAIN"})?
                      &UnTaint($ENV{"WWWDB_DOMAIN"}):
                      "WWWdb");

          last switch;
      };

      /^HostName$/ && do {
          $cResult = &MyVal("WWWdb", "Hostname", &UnTaint($ENV{"HTTP_HOST"}));
          last switch;
      };

      /^DebugLvl$/ && do {
          $cResult = &MyUserVal('Debug', 'Level', '10') &&
              !!&UnTaint($ENV{"HTTP_PRAGMA"});
          last switch;
      };

      /^BaseDir$/ && do {
          $cResult = (&UnTaint($ENV{"WWWDB_BASE_PATH"})?
                      &UnTaint($ENV{"WWWDB_BASE_PATH"}):
                      &UnTaint($ENV{"DOCUMENT_ROOT"}) . "/WWWdb");

          last switch;
      };

      /^DbDriver$/ && do {
          $cResult = (&UnTaint($ENV{"WWWDB_DATABASE"})?
                      &UnTaint($ENV{"WWWDB_DATABASE"}):
                      "Default");
          last switch;
      };

      /^DbHandle$/ && do {
          $cResult = $pDbHdlMGL;
          last switch;
      };

      /^ConfigPath$/ && do {
          $cResult = (&UnTaint($ENV{"WWWDB_CONFIG_FILE"})?
                      &UnTaint($ENV{"WWWDB_CONFIG_FILE"}):
                      "WWWdb/Index");
          last switch;
      };

      /^ConfigFile$/ && do {
          ($cResult = (&UnTaint($ENV{"WWWDB_CONFIG_FILE"})?
                       &UnTaint($ENV{"WWWDB_CONFIG_FILE"}):
                       "WWWdb:Index")) =~ tr !/!:!;
          last switch;
      };

      /^SessionId$/ && do {
          $cResult = &UnTaint($ENV{"WWWDB_SESSION_ID"});
          last switch;
      };

      /^UrlParams$/ && do {
          $cResult = &UnTaint($ENV{"WWWDB_PARAMS"});
          last switch;
      };

      /^LogfileName$/ && do {
          $cResult =  (&GetAttr("BaseDir") .
                       "/tmp/" .
                       &GetAttr("ScriptName") .
                       ($iDevelopmentVersionMGL?
                        "$<-$$.log": # uid-pid
                        "$<.log"));
          last switch;
      };

      /^HTMLfileName$/ && do {
          $cResult =  (&GetAttr("BaseDir") .
                       "/tmp/" .
                       &GetAttr("ScriptName") .
                       "$<-$$.html"); # uid-pid
          last switch;
      };

      /^RecIdField$/ && do {
          $cResult = &MyVal("Data", "IdField", "");
          last switch;
      };

      /^RecId$/ && do {
          my @lKeyFields = split /, /, &GetAttr("RecIdField");

          # scan multiple primary-keys
          foreach (@lKeyFields)
          {
              $_ = &GetField($_);
          }

          $cResult = join ",", @lKeyFields;
          last switch;
      };

      /^ObjectId$/ && do {
          $cResult = &GetAttr("RecId");
          last switch;
      };
      /^AppId$/ && do {
          $cResult = md5_hex(&GetAttr("ConfigFile"));
          last switch;
      };

      assert($cAttrTypePI eq "defined")
          if &MyUserVal('Debug', 'Level', '0');
  }

    return $cResult;

}


# --- At the moment this is only hiding tainted things, without
#     security-checks
sub UnTaint($;$)
{
    my $cUnTaintExprPI  = shift || "";
    my $cUnTaintRegexPI = shift || "^(.*)\$";

    if ($cUnTaintExprPI =~ m/$cUnTaintRegexPI/)
    {
        # now untainted but dangerous!!!
        return $1;
    }
    else
    {
        return $cUnTaintExprPI;
    }
}



=head1 AUTHOR

    Klaus Reger <K.Reger@wwwdb.org>

    Get WWWdb at http://wwwdb.org

=cut


# run, run, run .....
&Main();

1;


# -----------------------------------------------------------------------------
# $Log: WWWdb.cgi,v $
# Revision 1.49  2003/04/16 11:25:21  k_reger
# - Help now implemented using documents
#
# Revision 1.48  2003/04/11 13:32:35  k_reger
# - Localisation included directly in WWWdb
#
# Revision 1.47  2002/11/19 12:21:01  k_reger
# - added function GetSelectboxValues($)
#
# Revision 1.46  2002/11/18 13:58:30  k_reger
# - Support Target-DB
#
# Revision 1.45  2002/04/08 04:59:01  k_reger
# - SQL-correction for Interbase
# - Switch temp. to devel-Version
#
# Revision 1.44  2002/03/18 15:24:57  k_reger
# - prepare for 0.8.2
#
# Revision 1.43  2002/03/15 08:59:58  k_reger
# - Bugfix: Selectfields / radiofields now correctly translated
# - Enter triggers default-button
#
# Revision 1.42  2002/03/05 16:16:10  k_reger
# - no "use lib"
# - untaint all ENV-Variables (not really)
# - set caching off by default
# - set VERSION directly here
#
# Revision 1.41  2001/01/25 11:52:27  k_reger
# - Better date-scanning and printing
# - enhanced order mechanism
#
# Revision 1.40  2000/11/30 13:58:46  k_reger
# - design separated from function via HTML::Templates
#
# Revision 1.39  2000/11/28 16:04:58  k_reger
# - Extended Attributes like H1 ... H6, PRE, etc.
# - SSL-Support
# - Design done by HTML::Templates
# - Navigation-Elements separated
# - Support of perl-locales
# - Debug-info only after reload
#
# Revision 1.38  2000/11/17 11:53:01  k_reger
# - Show sub-categories of the upper categoriy too
# - New Attribs H1 ... H4
# - Replaced some constants
#
# Revision 1.37  2000/11/15 12:08:42  k_reger
# - BUGFIX: Sort-buttons work again now
# - https-link-support
# - Browser can force WWWdb to ignore caching
#
# Revision 1.36  2000/11/03 11:36:20  k_reger
# - prepared for 0.8.0
#
# Revision 1.33  2000/09/29 11:16:21  k_reger
# - BUGFIX: check if plugin is readable
# - BUGFIX: handle blanks in generated links
# - better HTML-Cache-handling
# - new operator <> (like !=)
# - empty values can now be selected with "" or ''
# - check ExtraFields too
# - added MustMatch.Errmsg for a clear description of the regexp
# - now you can set the link-color with the entries [GUI]->Link, [GUI]->ALink, [GUI]->VLink,
# - removed WWWdb-specific plugins here
#
# Revision 1.32  2000/09/21 07:21:05  k_reger
# - Better Handling of Hidden-fields
# - CGI::Debug
# - Multiple-scrolling-lists work now
# - User-defined Buttons are placed behind the standard-buttons
#
# Revision 1.1  2000/05/10 13:39:04  work
# Initial revision
#
# Revision 1.29  2000/03/30 13:50:20  klaus
# Checkpoint before Release 0.0.7
#
# Revision 1.28  2000/03/24 09:49:20  klaus
# Checkpoint
#
# Revision 1.1  2000/03/06 14:10:09  work
# Initial revision
#
# Revision 1.27  2000/02/24 11:27:04  klaus
# - Internationalization
# - New OO-Classes
#
# Revision 1.1  2000/02/09 09:50:44  work
# Initial revision
#
# Revision 1.26  2000/02/02 23:38:48  klaus
# Second preparing WWWdb for 0.0.6
#
# Revision 1.25  2000/02/02 21:38:43  klaus
# Preparing WWWdb for 0.0.6
#
# Revision 1.24  2000/01/10 15:38:14  klaus
# Html-Tables in OO now
#
# Revision 1.23  1999/12/22 13:02:53  klaus
# Last corrections before 0.0.5
#
# Revision 1.22  1999/12/21 17:55:40  klaus
# New features of WWWdb-0.0.5:
#      System:
#          New General form layout (FormHeader, Navigation, TableHeader, Application-area,
#          TableFooter, FormFooter)
#          New Plugin: PreDoAction
#          New Plugins: FormHeader, TableHeader, TableFooter, FormFooter
#          Navigation through hierarchy
#          Navigation through search-words
#          Default-session-id is now 0000000000000000
#          File-hierarchy of configfiles is now possible: x/y/z => x:y:z
#          Passing parameters via URL in the form URL;Param=Value
#          New config-entries for simple field checking / converting: Mandatory, MustMatch,ToUpper, ToLower
#          The navigation column is generated from database
#          Query-fields can be attributed
#          Different ways to select a record in the browse: Btn, Check, None (implies selection via link)
#          Vertical alignment of single entries
#          Generate WWWdb-References in Labels
#     API:
#          ResolveRefField - Resolve a WWWdb-Reference for HTML
#          InternalFieldCheck - perform the default-checks for a field
#          Get-Attr - Get WWWdb Attributes
#          ConfigPath - the file-path of the config-file
#          UrlParams - the params passed by the URL
#          GetLastBtn - -deleted-
#     Applications:
#          Navigation in wwwdb via hierarchy or search-words
#          Edit navigation-categories
#          Edit navigation-objects
#          Link category and object
#          Edit docu-entries
#
# Revision 1.21  1999/12/06 10:44:26  klaus
# - implemented file-hierarchy
#
# Revision 1.20  1999/12/02 15:19:02  klaus
#  - New General Table-Layout
#  - If config-file is missing, we take Empty.rc
#  - New Plugins:
#    + PreDoAction
#    + FormHeader, TableHeader, TableFooter, FormFooter
#  - Generated menu-structure (from database)
#  - Different way to select records in Qry-Mode
#  - Default session-id is now 0000000000000000
#  - a : in url generates a file hierarchy (x:y:z => x/y/z)
#  - pass params via the url in the form url;param=value[;paramn=valuen]
#  - API-function GetLastBtn deleted
#
# Revision 1.19  1999/11/23 15:43:09  klaus
# New lib-directory
#
# Revision 1.18  1999/11/22 09:13:13  klaus
# - Last bugfixes before 0.0.4
#
# Revision 1.17  1999/11/19 14:29:10  klaus
# - Last corrections before 0.0.4
#
# Revision 1.16  1999/11/19 12:42:35  klaus
# - Corrections after installation on pc01
#
# Revision 1.15  1999/11/18 15:00:51  klaus
# - New Help-Interface
# - Login now crypted
#
# Revision 1.14  1999/11/15 13:52:36  klaus
# - HTML-output buffered
# - WWWdb_(Pre|Post).(rc|pl)
# - own tmp-directory
# - little customizations  for qry-mode
# - enhancement of debug-trace-utilities
# - API: GetAttr()
#
# Revision 1.13  1999/11/11 14:15:48  klaus
# Corrections after internal installation
#
# Revision 1.12  1999/11/11 13:22:49  klaus
# Snapshot for internal installation
#
# Revision 1.11  1999/11/02 12:01:58  klaus
# Check-in to store actual state
#
# Revision 1.10  1999/10/22 11:06:06  klaus
# - Corrections of the data-conversion between Db and Html-Form
#
# Revision 1.9  1999/10/21 13:35:05  klaus
# - Select and Radio-Fields can now be filled with SQL
# - WWWdb is now "-w"-proof
# - Database-Errors are now shown uniquely
#
# Revision 1.8  1999/10/20 13:01:34  klaus
# Version 1.0.3
# - Getting field-type-information
# - Plugins to convert DB-data to Form-data and vice versa
# - New API-functions
#    $current_state = GetState();
#    $cust_type = GetFieldTypeName($field_name);
#
# BUGFIX:
# -kfm, lynx and w3m seem to work now
#
# Revision 1.7  1999/10/08 13:48:09  klaus
# - Selection-Boxes and radio-fields now can have labels
# - plugins: API-Documentation
# - Perl-makefile integrated
#
# Revision 1.6  1999/10/07 13:56:20  klaus
# - Security-Bugfix: HTML-Entities decoded
# - Internal state perfixed with WWWdb
# - Adding file README.application
# - Enhancements of index.html
#
# Revision 1.5  1999/10/06 08:42:13  klaus
# Checkpoint before copying to WWW-server
#
# Revision 1.4  1999/10/06 06:49:19  klaus
# Sync 06.10.99
#
# Revision 1.3  1999/10/06 06:21:08  klaus
# Sync with KR's work at home.
#
# Revision 1.2  1999/09/28 13:12:53  klaus
# Bugfixes
#
# Revision 1.1.1.1  1999/09/27 08:50:26  klaus
# Integration in CVS
#
# Revision 1.1.1.1  1999/09/27 08:09:51  klaus
# Imported using tkCVS
#
# Revision 1.10  1999/09/21 08:34:33  klaus
# - Anzeige von Fehlern in der Konfigurations-Datei
# - Update/Query-Felder getrennt konfigurierbar
# - Neue Attribute:
#   Align, BgColor, NoWrap, Big, Blink, Bold, Italic, Small
#   Font, Disabled, Readonly, Tabindex, Title
# - Neue Input-Felder:
#   Password, Area, Hidden, Radio, Checkbutton
# - Position kann nun auch als Offset angegeben werden
#
# Revision 1.9  1999/09/17 14:07:26  klaus
# - Konfigurationsdatei zur Steuerung
#   + Datenbank-Verbindung
#   + Allgemeines Tabellenlayout
#   + Label
#   + Textfelder
#   + Select-Buttons
#
# Revision 1.8  1999/09/13 14:10:04  klaus
# - Hilfs-informationen
# - letzte Version vor Verallgemeinerung
#
# Revision 1.7  1999/09/07 09:33:40  klaus
# - Funktionen zum Browsen der Daten
# - Normierung der Telefon-Nummern
# - Assertions eingebaut
# - Fehler-Meldungen über OK-Form
#
# Revision 1.6  1999/09/02 12:43:22  klaus
# - Farb- und Font Korrekturen
# -> Dies ist die erste freigegebene Alpha-Version
#
# Revision 1.5  1999/09/01 13:55:40  klaus
# - Korrekte Fehlerbehandlung
# - Konsistente Verwaltung der Ãœbergabe-Parameter
#
# Revision 1.4  1999/09/01 07:20:50  klaus
# - Folgende DB-Funktionen eingebaut:
#   + Änderung
#   + Löschung
# - Oracle-Anbindung läuft nun korrekt
# - DB-Meldungen als OK-Forms
#
# Revision 1.3  1999/08/31 10:46:13  klaus
# Nun funktionieren folgende DB-Funktionen:
# - Neuanlage
# - Suche
# - Auswahl von Sätzen
#
# Revision 1.2  1999/08/26 12:20:40  klaus
# Aller unnötiger HTML-Code entfernt
#
# Revision 1.1  1999/08/25 07:33:05  klaus
# Initial revision
#
#
# -----------------------------------------------------------------------------