1#!/usr/bin/perl -I/home/klaus/Work/WWWdb
2#!/usr/bin/perl
3#!/usr/bin/speedy -- -r10 -t600
4#!/usr/bin/perl -d:DProf
5# -*-perl-*-
6# -----------------------------------------------------------------------------
7#
8#   Copyright (c) 1999-2002 by Klaus Reger <K.Reger@wwwdb.org>
9#
10#   You may distribute under the terms of either the GNU General Public
11#   License or the Artistic License, as specified in the Perl README file.
12#
13#   THIS IS BETA SOFTWARE!
14#
15#   THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
16#   IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
17#   WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
18#
19#   $Id: WWWdb.cgi,v 1.49 2003/04/16 11:25:21 k_reger Exp $
20#
21# -----------------------------------------------------------------------------
22# Program-Data
23# -----------------------------------------------------------------------------
24# Project  :
25# System   :
26# Program  :
27# Module   : $RCSfile: WWWdb.cgi,v $
28# Version  : $Revision: 1.49 $
29# Date     : $Date: 2003/04/16 11:25:21 $
30# State    : $State: Exp $
31#
32# Description:
33#   This script allows, to insert, update and delete records of
34#   a Database over the WWW
35#
36#
37# State-Flows:
38# ---------------------------------------------------------------------------
39# By Default, the following states are implemented
40#
41# State  SubState Exits   LeadsTo Comment
42# Init   Ok       New     Init    Insert Record, Clear form, Jump back
43#        Error    New     Init    Show Err-Messages
44#        -        Qry     Qry     Selection of date, internal navigation
45#        -        Back    Init    Clear form, Jump back
46# Qry    -        Sel_x   Work    Show sel. record
47#        -        Back    Init    Clear form, Jump back
48# Work   Error    Upd     Upd     Show Err-Messages
49#        Ok       Upd     Init    Change Record, Clear form, Jump back
50#        -        Del     Init    Del record, Clear form, Jump back
51#        -        Back    Init    Clear form, Jump back
52#
53# -----------------------------------------------------------------------------
54# Change-log (See at end of this file)
55#
56# --- Known Bugs -------------
57# please look at the BUGS-File
58# --- TODO -------------------
59# please look at the TODO-File
60# ----------------------------------------------------------------------------
61
62use strict;
63use locale;
64# use diagnostics;
65
66use POSIX qw();
67
68use CGI::Carp qw(fatalsToBrowser);
69use CGI::Cache;
70
71use DB_File;
72
73use DBIx::Recordset;            # SQL-access via recordsets
74
75use Digest::MD5 qw(md5_hex);    # Create md5-hashes
76
77use HTML::Entities;             # HTML-conversions (� -> &uuml;)
78use HTML::Template;             # HTML-Template
79
80use vars qw($VERSION
81            $cBgColorMGL
82            $cBgImageMGL
83            $hQryMGL
84            $iCacheTimeoutMGL
85            $iDevelopmentVersionMGL
86            $lFieldLayoutMGL
87            $oConfPoolGL
88            $oDbSessionGL
89            $oDbTargetGL
90            $oFormMGL
91            $oSessionGL
92            $pDataSetMGL
93            $pDbHdlMGL
94            %hFieldErrorsMGL
95            %hFormDataMGL
96            %hTableInfoMGL
97            %hSelectCacheMGL
98            @pDataSetMGL
99            %hCategoriesGL
100            %hMessagesGL
101            );
102
103use WWWdb::Base;                # Base methods for WWWdb
104use WWWdb::HTML;                # HTML-related methods for WWWdb
105use WWWdb::Session;             # Session-related methods for WWWdb
106use WWWdb::Plugin;              # Plugin-methods for WWWdb
107use WWWdb::DbSession;           # Database-Session for WWWdb
108use WWWdb::ConfigPool;          # Config-File-Pools for WWWdb
109use WWWdb::ConfigFile;          # Config-Files for WWWdb
110
111# use WWWdb::Monitor;             # Monitoring variables
112
113=head1 NAME
114
115WWWdb-API - Interface to WWWdb to use in your plugins
116
117=head1 SYNOPSIS
118
119ClearFields - clear all entry-fields
120
121OkForm - Display a form similar to a popup-window
122
123Error - show a error-frame and leave
124
125MyExit - leave WWWdb in a clean way
126
127MyUserVal - Get an entry of the config-file, but look for session-data before
128
129MyVal - Get an entry of the config-file
130
131MySetVal - Set an entry, defined in the config-file
132
133Redirect - redirect the browser to another HTML-page
134
135CreateReference - makes an internal WWWdb-HTML-reference
136
137ResolveRefField - Resolve a Reference of an wwwdb_object
138
139GetField - Get value of a Field in the HTML-Form
140
141SetField - Sets the value of a HTML-field
142
143AddError - Add an error-message to the internal list
144
145DecodeHtml - decodes HTML-formatted entities to normal Text
146
147EncodeHtml - encode normal text, to be HTML-save
148
149SafeEncodeHtml - extended encoding of HTML-Tags
150
151GetFieldTypeName - get the fieldtype-name of a given field
152
153SQLSelectList - Get the SQL-SELECT-result as a list
154
155SQLDo - executes the given SQL-statement
156
157GetAttr - Get some internal WWWdb-attributes
158
159=head1 DESCRIPTION
160
161WWWdb-API is a interface to the WWWdb-application. This application
162enables you to maintain the data of a database-table over the WWW. To
163keep the data consistent, maybe you need to write some plugins, which
164check data-integrity.
165
166Because it is included in WWWdb, you should normally NOT include it in
167your scripts. Your scripts are included in WWWdb, and this Library
168gives you a interface to the internals of WWWdb.
169
170=head1 FUNCTIONS
171
172=cut
173
174
175
176# --- This routine is called at compilation-time ----------------------------
177sub BEGIN ()
178{
179    my $cBasePath;
180
181    $VERSION                = '0.8.3';
182    $iDevelopmentVersionMGL = 0;
183
184    delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};   # Make %ENV safer
185
186    if ($iDevelopmentVersionMGL &&
187        &UnTaint($ENV{"HTTP_PRAGMA"}))
188    {
189        require Data::Dumper;               # Pretty-print data-structs for debug
190        require CGI;
191
192        require CGI::Debug;
193        import  CGI::Debug(report       => ['errors', 'time',
194                                            'params', 'cookies',
195                                            'environment',
196                                            'everything'],
197                           on           => ['anything'],
198                           to           => { browser => 1 },
199                           header       => 'ignore',
200                           set          => {
201                               param_length => 512,
202                               error_document => 'oups.html' }
203                           );
204
205        require Carp::Assert;
206
207        # require CGI::Pretty;
208        CGI->import(qw(:standard :html3 -debug)); # CGI-functionality
209
210        $main::SIG{'__WARN__'} = \&MyDie;
211
212    }
213    else
214    {
215        require CGI;
216        CGI->import(qw(:standard :html3)); # CGI-functionality
217    }
218
219    $main::SIG{'__DIE__'}  = \&MyDie;
220    $main::SIG{'SEGV'}     = \&MyDie;
221    $main::SIG{'BUS'}      = \&MyDie;
222
223} # BEGIN
224
225
226sub END()
227{
228   untie %hMessagesGL;
229}
230
231
232
233
234# --- Initializations -----------------------------------------------------------
235sub InitVars()
236{
237   my $cKey;
238   my $cCacheFileName;
239   my $cCGIParamKey = "";
240
241   $hQryMGL               = new CGI; # CGI-Query-Set
242   $hQryMGL->autoEscape(undef);
243
244   %hFormDataMGL          = ();
245   %hTableInfoMGL         = ();
246   %hSelectCacheMGL       = ();
247
248   # Monitor::monitor(\%hFormDataMGL, 'hFormDataMGL');
249
250   close STDERR;
251   open(STDERR, ">" . &GetAttr("LogfileName")) or
252      print STDERR ("Unable to open " . &GetAttr("LogfileName") . " for Output: $!\n");
253
254   # Form-Parameters in Hash
255   foreach $cKey ($hQryMGL->param)
256   {
257      # FIXME: This makes multiple selections appear, but makes
258      #        trouble with some single fields
259      $hFormDataMGL{$cKey} = join "\\,", $hQryMGL->param($cKey);
260      # $hFormDataMGL{$cKey} = $hQryMGL->param($cKey);
261      $cCGIParamKey .= "$cKey=" . $hQryMGL->param($cKey);
262   }
263
264   print STDERR $hQryMGL->Dump()
265          if &GetAttr("DebugLvl") > 4;
266
267   $cCGIParamKey = $hQryMGL->param? md5_hex($cCGIParamKey) : "0";
268   # $cCGIParamKey =~ s/\W//g; # For tests only
269
270   $cCacheFileName = sprintf ('%s/tmp/cache/%s/%s/%s/%s-%s-%s.html',
271                              &UnTaint($ENV{"WWWDB_BASE_PATH"}),
272                              &GetAttr("DbDriver"),
273                              &GetAttr("SessionId"),
274                              &GetAttr("ConfigPath"),
275                              &MyParam("WWWdbState"),
276                              &GetAttr("UrlParams"),
277                              $cCGIParamKey),
278
279   $cCacheFileName =~ s/[!\"\\;=&,\']/_/g;
280
281   $iCacheTimeoutMGL = 0;
282
283   &Plugin::_UndefAllPlugins();
284
285   {
286      if (&GetAttr("DebugLvl"))
287      {
288         foreach (keys %ENV)
289         {
290            print STDERR "ENV->$_ = $ENV{$_}\n";
291         }
292      }
293
294      my $cBasePath = (&UnTaint($ENV{"WWWDB_BASE_PATH"})?
295                       &UnTaint($ENV{"WWWDB_BASE_PATH"}):
296                       &UnTaint($ENV{"DOCUMENT_ROOT"}) . "/WWWdb");
297
298      foreach (# the Pre-plugin functionality
299               "WWWdb/Pre",
300
301               # Pre-Domain
302               ("WWWdb/Pre" .
303                (&UnTaint($ENV{"WWWDB_DOMAIN"})?
304                 &UnTaint($ENV{"WWWDB_DOMAIN"}):
305                 "WWWdb")),
306
307               # Database-related scripts
308               ("WWWdb/Db/" .
309                (&UnTaint($ENV{"WWWDB_DATABASE"})?
310                 &UnTaint($ENV{"WWWDB_DATABASE"}):
311                 "Default")),
312
313               # The application-script
314               (&UnTaint($ENV{"WWWDB_CONFIG_FILE"})?
315                &UnTaint($ENV{"WWWDB_CONFIG_FILE"}):
316                "WWWdb/Index"),
317
318               # Post-Domain
319               ("WWWdb/Post" .
320                (&UnTaint($ENV{"WWWDB_DOMAIN"})?
321                 &UnTaint($ENV{"WWWDB_DOMAIN"}):
322                 "WWWdb")),
323
324               # the Post-plugin functionality
325               "WWWdb/Post")
326      {
327         my $cConfigFile = &UnTaint($_);
328
329         # If the entry is a directory, use the Index.pl script
330         $cConfigFile .= "/Index"
331             if(-d sprintf("%s/lib/%s", $cBasePath, $cConfigFile));
332
333
334         # --- include here your own application-code in the .pl-Source ----------------
335         {
336            my $cPerlSource = &UnTaint(sprintf("%s/lib/%s.pl",
337                                               $cBasePath,
338                                               $cConfigFile));
339
340            if (-f $cPerlSource)
341            {
342               if (-r $cPerlSource)
343               {
344                  if(eval
345                     {
346                        do $cPerlSource;
347                     })
348                  {
349                     print STDERR "do $cPerlSource\n"
350                         if &GetAttr("DebugLvl") > 2;
351                  }
352                  else
353                  {
354                     print STDERR "do $cPerlSource failed\n"
355                         if &GetAttr("DebugLvl") > 2;
356                  }
357               }
358               else
359               {
360                  die(sprintf(i18n("Sorry, but the plugin-source %s ".
361                                   "is not readable!"),
362                           br() x 2 .
363                           (big(b($cPerlSource))) .
364                           br() x 2));
365               }
366            }
367         }
368      }
369   }
370
371   # Actualize the Sym-Table-Cache
372   &Plugin::_Init_SymTableCache();
373
374   $Data::Dumper::Indent = 1;      # mild pretty print
375
376   # my $hConfDataMGL = ();
377   $cBgColorMGL  = undef;
378   $cBgImageMGL  = undef;
379   $oFormMGL     = undef;
380   $oSessionGL   = undef;
381   $oConfPoolGL  = undef;
382
383   {
384      my $cPathOfConfigFile =
385          &GetAttr("ConfigPath");
386
387      # Remove last element of Path
388      $cPathOfConfigFile =~ s./[^/]+..;
389
390      #    ConfigFileName                    ReadOnly  MustExist
391      my @lConfigFileData =
392          (["WWWdb/Pre",                            1, 0],
393           ["WWWdb/Pre" . &GetAttr("WWWdbDomain"),  1, 0],
394           [&GetAttr("ConfigPath"),                 0, 1],
395           ["WWWdb/Db/" . &GetAttr("DbDriver"),     1, 1],
396           ["WWWdb/Post" . &GetAttr("WWWdbDomain"), 1, 0],
397           ["WWWdb/Post",                           1, 0]);
398
399      my $cConfigFileEntry;
400
401      $oConfPoolGL = ConfigPool->new("DebugLvl" => &GetAttr("DebugLvl"));
402
403      foreach $cConfigFileEntry (@lConfigFileData)
404      {
405         my $oConfigFile;
406         my $cConfigFilename = sprintf("%s/lib/%s.rc",
407                                       &GetAttr("BaseDir"),
408                                       $cConfigFileEntry->[0]);
409
410         if((! -f $cConfigFilename) && $cConfigFileEntry->[2])
411         {
412           die(sprintf(i18n("Sorry, but the config-file %s does not exist!"),
413                           br() x 2 .
414                           (big(b($cConfigFilename))) .
415                           br() x 2));
416         }
417
418         if((! -r $cConfigFilename) && $cConfigFileEntry->[2])
419         {
420            die(sprintf(i18n("Sorry, but the config-file %s is not readable!"),
421                           br() x 2 .
422                           (big(b($cConfigFilename))) .
423                           br() x 2));
424         }
425
426         $oConfigFile = ConfigFile->new
427             ($cConfigFilename,
428              "ReadOnly"  => $cConfigFileEntry->[1],
429              "MustExist" => $cConfigFileEntry->[2],
430              "DebugLvl"  => 0
431              );
432
433         $oConfPoolGL->addConfigFile($oConfigFile);
434
435      }
436   }
437
438   $oConfPoolGL->Dump()
439       if &GetAttr("DebugLvl");
440
441
442   $iCacheTimeoutMGL = &MyVal('Cache', 'Timeout', 0);
443
444   if ($iCacheTimeoutMGL)
445   {
446      &CGI::Cache::SetFile($cCacheFileName, $iCacheTimeoutMGL);
447      &CGI::Cache::Start();
448   }
449   else
450   {
451      $hQryMGL->cache("no");
452   }
453}
454
455
456
457
458# --- Main-Routine -----------------------------------------------------------
459sub Main()
460{
461   my $cBtn;
462
463   # set real uid to effective uid
464   # $< = $>;
465   # set real gid to effective gid
466   # $( = $);
467
468   &InitVars();
469
470   &InitDb();
471   &InitForm();
472
473   &DebugFormData()
474       if &GetAttr("DebugLvl") > 2;
475
476   printf STDERR "Config-file: %s\n", &GetAttr("ConfigPath")
477       if &GetAttr("DebugLvl") > 2;
478
479   &MyParam("WWWdbLastUrlParam", &GetAttr("UrlParams"))
480       if &GetAttr("UrlParams") > 2;
481
482   printf STDERR "URL-Params: %s\n", &MyParam('WWWdbLastUrlParam')
483       if &GetAttr("DebugLvl") > 2;
484
485   $cBtn = &GetAttr("LastBtn");
486
487   # Another language was choosen
488   if ($cBtn =~ /^Btn_SelLang$/)
489   {
490
491      # in anonymous-mode: change the session-id
492      if($oSessionGL->getState("IsAnonymous"))
493      {
494         my $iNewSessionId;
495
496         # get the anonymous-session-id for the new language
497         $iNewSessionId = $oDbSessionGL->SqlSelect
498             ("SELECT
499                  s1.session_id
500               FROM
501                  wwwdb_state s1,
502                  wwwdb_state s2
503               WHERE
504                  s1.key_name    = '[WWWdb] Lang' AND
505                  s1.key_value   = ?              AND
506                  s2.key_name    = 'IsAnonymous'  AND
507                  s2.key_value  != ''             AND
508                  s1.session_id  = s2.session_id",
509              &GetField("_SelLang"))->[0]->[0];
510
511         &Redirect($iNewSessionId, "WWWdb:Index")
512             if $iNewSessionId;
513      }
514      # change the preferences
515      else
516      {
517
518         $oSessionGL->setState("[WWWdb] Lang",
519                               &GetField("_SelLang"));
520
521# FIXME: This does not work here :-( don't know why (yet)
522#         print &Redirect(&GetAttr("SessionId"),
523#                         (&GetAttr("ConfigFile") .
524#                          ";" .
525#                          &MyParam('WWWdbLastUrlParam')));
526
527         &OkForm("", i18n("Language will change " .
528                          "after pressing the OK-button!"));
529         &MyExit();
530      }
531   }
532
533   # Search for a word
534   elsif ($cBtn =~ /^Btn_Search$/ || &GetField("_Search"))
535   {
536
537      {
538         &Redirect(&GetAttr("SessionId"),
539                   ("WWWdb:Nav;sword=*" .
540                    &GetField("_Search") .
541                    "*"));
542      }
543   }
544
545   Plugin->new("PreDoAction")->Call();
546
547   &HavePermissionToRun();
548
549   # decide what to do next
550   &FindActionToDo();
551
552   &MyExit();
553}
554
555
556# --- Initialize data in form ------------------------------------------------
557sub InitDb ()
558{
559   my $cKey;
560   my @lDateScanFormats = &MyListVal('DB', 'DateScanFormats');
561
562   # set params for DBIx::Recordset
563   &MyParam("!Database", &MyVal('DB', 'Database') )
564       if !defined($hFormDataMGL{"!Database"});
565
566   &MyParam("!Username", &MyVal('DB', 'Username'))
567       if !defined($hFormDataMGL{"!Username"});
568
569   &MyParam("!Password", &MyVal('DB', 'Password'))
570       if !defined($hFormDataMGL{"!Password"});
571
572   # --- Database-specific options -------------------------------------------
573   $oDbSessionGL = DbSession->new
574       (&MyVal('DB', 'Driver', 'Default'), # FIXME: Replace Default
575        &MyParam("!Database"),
576        &MyParam("!Username"),
577        &MyParam("!Password"),
578        "DbHost"          => &MyVal('DB', 'Host', "localhost"),
579        "DebugLvl"        => &GetAttr("DebugLvl"),
580        "Lang"            => &GetAttr("BaseLang"),
581        "DatePrintFormat" => i18n(&MyVal('DB', 'DatePrintFormat',
582                                         "%Y-%m-%d %H:%M:%S")),
583        (@lDateScanFormats ?
584         ("DateScanFormats" => \@lDateScanFormats):
585         undef));
586
587   # check for a target database
588   if (&MyVal('TargetDB', 'Database'))
589   {
590      # set params for DBIx::Recordset
591      &MyParam("!Database", &MyVal('TargetDB', 'Database'));
592      &MyParam("!Username", &MyVal('TargetDB', 'Username'));
593      &MyParam("!Password", &MyVal('TargetDB', 'Password'));
594
595      $oDbTargetGL = DbSession->new
596          (&MyVal('DB', 'Driver', 'Default'),
597           &MyParam("!Database"),
598           &MyParam("!Username"),
599           &MyParam("!Password"),
600           "DbHost"          => &MyVal('TargetDB', 'Host', "localhost"),
601           "DebugLvl"        => &GetAttr("DebugLvl"),
602           "Lang"            => &GetAttr("BaseLang"),
603           "DatePrintFormat" => i18n(&MyVal('TargetDB', 'DatePrintFormat',
604                                            "%Y-%m-%d %H:%M:%S")),
605           (@lDateScanFormats ?
606            ("DateScanFormats" => \@lDateScanFormats):
607            undef));
608   }
609   else
610   {
611      $oDbTargetGL = $oDbSessionGL;
612   }
613
614   &MyParam("!DataSource", $oDbTargetGL->getDataSource());
615
616   # make a standard connection to the database
617   $pDbHdlMGL = $oDbSessionGL->getDbHandle();
618
619   &Error(sprintf(i18n("The Id-Field (which defines a global unique " .
620                       "key for every record in the database " .
621                       "is not set!") .
622                  "<BR><BR>" .
623                  i18n("Insert the correct name of the id-field " .
624                       "in the config-file " .
625                       "under the section %s with:") .
626                  "<BR>" .
627                  "%s",
628                  b("[DB]"),
629                  b("IdField = <name><BR>")))
630    if !&GetAttr("RecIdField");
631
632}
633
634
635# --- initialize data for DBIx::Recordset -----------------------------------
636sub InitDBIxRecordset()
637{
638   *DBIx::Recordset::LOG   = \*STDERR;
639   $DBIx::Recordset::Debug = &GetAttr("DebugLvl")? 3: 1;
640
641   &MyParam('$max', &MyVal('Browser', 'MaxRows', 5));
642   &MyParam('$valuesplit', ",");
643   &MyParam('$compconj',   "and");
644   &MyParam('!DBIAttr', {LongReadLen => 256 * 1024,
645                         LongTruncOk => 1});
646
647   &MyParam('$start', "0")
648       unless &MyParam('$start');
649
650   &MyParam("!Table", &MyVal('Data', 'Table'));
651
652   &MyParam("!Order", &MyVal('Data', 'Order', ''))
653       unless defined &MyParam('!Order');
654
655   # 0 -> undef = SQL:NULL
656   # 1 -> undef fields are ignored,
657   # 2 -> undef or empty fields are ignored
658   &MyParam("!IgnoreEmpty", "0"); # FIXME: IgnoreEmpty
659
660}
661
662
663# --- Initialize form-data --------------------------------------------------
664sub InitForm ()
665{
666   my $cKey;
667   my $cBtn;
668
669   $oSessionGL = Session->new($pDbHdlMGL,
670                              "Id"       => &GetAttr("SessionId"),
671                              "Length" => 16,
672                              "DebugLvl" => &GetAttr("DebugLvl")) or
673       die i18n("Could not get the session-id!");
674
675   # the Id we already have is invalid
676   # let's take the id from $oSessionGL
677   if(&GetAttr("SessionId") ne $oSessionGL->getId())
678   {
679
680      &Redirect($oSessionGL->getId(), "WWWdb:Index");
681
682   }
683
684   # What was the last submit-button, that triggered this page
685   foreach $cKey (keys %hFormDataMGL)
686   {
687
688      # Check the pressed Button (handle images also)
689      if ($cKey =~ /^(Btn.*?)(\.[xy])?$/)
690      {
691         printf STDERR i18n("Button %s pressed") . "<BR>\n", $1
692             if &GetAttr("DebugLvl") > 1;
693
694         $cBtn = $1;
695         &MyParamDelete($1);
696         &MyParam("WWWdbLastBtn", $1);
697      }
698   }
699
700   &MyParam("WWWdbState", "Init")
701          if !defined($hFormDataMGL{"WWWdbState"});
702   &MyParam("WWWdbSubState", "")
703          if !defined($hFormDataMGL{"WWWdbSubState"});
704
705#   &MyParam("WWWdbLastUrlParam", &GetAttr("UrlParams"))
706#       if (!defined($hFormDataMGL{"WWWdbLastUrlParam"}));
707
708   $cBgColorMGL = &MyUserVal('GUI', 'BgColor', undef);
709   $cBgImageMGL = &MyVal('GUI', 'BgImage', undef);
710
711   &setLanguage(&GetAttr("BaseDir") . "/locale",
712                &GetAttr("Lang"));
713
714} # sub InitForm
715
716
717sub setLanguage($)
718{
719   my $cLocaleDir = shift;
720   my $cLang      = shift;
721   my $cPath      = "$cLocaleDir/$cLang";
722
723   tie(%hMessagesGL, "DB_File", $cPath, O_RDONLY, 0644) ||
724       die ("Cannot open language file $cPath");
725}
726
727
728# --- Check if this application has the permission to run ------------------
729sub HavePermissionToRun () # Db Session
730{
731   my $cAttribs;
732   my $iObjectId  = &GetObjectId();
733   my $bInSSlMode = &UnTaint($ENV{"HTTPS"})? 1: 0;
734   my $bNeedSSl   = 0;
735   my $cUseSSl    = &MyVal('WWWdb', 'UseSSL', "NEVER");
736
737
738   $cAttribs = ($oDbSessionGL->SqlSelect
739                ("SELECT
740                    attribs
741                  FROM
742                    wwwdb_object
743                  WHERE
744                    id_object = ?",
745                 defined $iObjectId? $iObjectId: 0))->[0]->[0];
746
747   switch: for ($cUseSSl)
748   {
749      /^ALWAYS$/i && do {
750
751         $bNeedSSl = 1;
752         last switch;
753      };
754
755      /^STAY$/i && do {
756
757         $bNeedSSl   = ((&IsAttribOK($cAttribs, "IsSSL" => 0) !=
758                         &IsAttribOK($cAttribs, "IsSSL" => 1)) ||
759                        $bInSSlMode);
760         last switch;
761      };
762
763      /^APP_ONLY$/i && do {
764
765         $bNeedSSl   = (&IsAttribOK($cAttribs, "IsSSL" => 0) !=
766                        &IsAttribOK($cAttribs, "IsSSL" => 1));
767
768         last switch;
769      };
770
771      do {
772
773         $bNeedSSl = 0;
774         last switch;
775      };
776   }
777
778   if($cAttribs && defined $oSessionGL)
779   {
780      if((&IsAttribOK($cAttribs, "IsAdmin" => 0) !=
781          &IsAttribOK($cAttribs, "IsAdmin" => 1)) &&
782         (!$oSessionGL->getState("ActualLogin")))
783       {
784          &Error(sprintf(i18n("Please %s first!"),
785                         &ResolveRefField("wwwdb://WWWdb:System:Login",
786                                          i18n("login"))));
787      }
788   }
789
790   if(!&IsAttribOK($cAttribs))
791   {
792      if($cAttribs =~ "ActualLogin")
793      {
794         &Error(sprintf(i18n("Please %s first!"),
795                        &ResolveRefField("wwwdb://WWWdb:System:Login",
796                                         i18n("login"))));
797      }
798      else
799      {
800         &Error(i18n("Sorry, you are not permitted, to run this application!"));
801      }
802   }
803
804   printf STDERR ("bNeedSSl: %d bInSSlMode: %d\n",
805                  $bNeedSSl, $bInSSlMode);
806
807   # Do we have to change the encryption?
808   if($bNeedSSl != $bInSSlMode)
809   {
810
811      $ENV{"HTTPS"} = $bNeedSSl;
812
813      &Redirect(&GetAttr("SessionId"),
814                &GetAttr("ConfigFile") . ";" .
815                &GetAttr("UrlParams"));
816   }
817
818}
819
820
821
822# --- Show, what params came from last post ----------------------------------
823sub DebugFormData() # Form CGI
824{
825   my $cEntry;
826
827   printf STDERR (p("Form-data:"), hr({-noshade => 1,
828                                       -size => 1}));
829
830   foreach $cEntry (sort keys %hFormDataMGL)
831   {
832      printf STDERR "$cEntry=".&MyParam($cEntry)."<BR>\n";
833   }
834   printf STDERR  hr({-noshade => 1,
835                      -size => 1});
836
837} # sub DebugFormData
838
839
840
841# --- Now let's look, what to do  --------------------------------------------
842sub FindActionToDo() # Control
843{
844   my $bBtnFound = 0;
845   my $cBtn;
846   my $cDefaultButton;
847   my $cEntry;
848   my $cKey;
849   my $cParamBtnName;
850   my $cSection;
851   my $oBtnPlugin;
852
853   $cBtn = &GetAttr("LastBtn");
854
855   # look for a param in the uri
856   if(!$cBtn)
857   {
858
859      my $cUrlParams = &GetAttr("UrlParams");
860      my @lUrlParams = split ";", $cUrlParams;
861
862      foreach (@lUrlParams)
863      {
864         my $iId = 0;
865
866         $iId = $1
867             if (/^id=([^;]+)/);
868
869         if ($iId)
870         {
871            $cBtn = "BtnSelect" . $iId;
872            # &MyParam("BtnSelect" . $iId, $iId);
873            &MyParam("WWWdbLastBtn",
874                     "BtnSelect" . $iId);
875         }
876      }
877   }
878
879   # try to assign a default-button
880   unless ($cBtn)
881   {
882       my %hBtnMap = ("Init" => "BtnQry",
883                      "Work" => "BtnUpd");
884
885       if(defined $hBtnMap{&MyParam("WWWdbState")})
886       {
887
888           printf STDERR "State:%s, Btn:%s\n",
889           &MyParam("WWWdbState"),
890           $hBtnMap{&MyParam("WWWdbState")};
891
892           $cBtn = &MyParam("WWWdbState")
893               if (&MyVal("State ". $hBtnMap{&MyParam("WWWdbState")},
894                          &MyParam("WWWdbState")) ne "-");
895       }
896   }
897
898   # Change the sort-order
899   if ($cBtn =~ /^BtnSort(.*)$/)
900   {
901      my $cCurrOrder = &MyParam("!Order");
902      my $cNewOrder  = $1;
903
904      if (&GetField("_ResetSort"))
905      {
906         $cCurrOrder = "";
907      }
908
909      if ($cCurrOrder =~ m/$cNewOrder desc$/)
910      {
911         $cCurrOrder =~ s/ desc$//;
912         &MyParam("!Order", $cCurrOrder);
913      }
914      # reverse sort_order if it ends with the same field
915      elsif ($cCurrOrder =~ m/$cNewOrder$/)
916      {
917         &MyParam("!Order", $cCurrOrder . " desc");
918      }
919      # re-arrange the sort-order
920      else
921      {
922         $cCurrOrder = ""
923             if $cCurrOrder =~ m/$cNewOrder/;
924
925         &MyParam("!Order", ($cCurrOrder? "$cCurrOrder, ": "") . $cNewOrder);
926      }
927
928      &MyParamDelete($cBtn);
929
930      $cBtn = "BtnQry";
931      &MyParam($cBtn, "Query");
932      &MyParam("WWWdbLastBtn", $cBtn);
933   }
934   # catch dynamic generated Buttons
935   elsif ($cBtn =~ /^BtnSelect(.+)$/)
936   {
937      my @lKeyValues = split /,/, $1;
938      my @lKeyFields  = split /, /, &GetAttr("RecIdField");
939      my $iInd;
940
941      # scan multiple primary-keys
942      for ($iInd = 0; $iInd <= $#lKeyValues; $iInd ++)
943      {
944         # Set Record-Id
945         &MyParam("Fld" . $lKeyFields[$iInd],
946                  $lKeyValues[$iInd]);
947
948      }
949
950      &MyParamDelete($cBtn);
951
952      $cBtn = "BtnSelect";
953      &MyParam($cBtn, "Select");
954   }
955
956   $oBtnPlugin = Plugin->new("$cBtn",
957                             "HasPrePost" => 1,
958                             "HasMy"      => 1)
959       if $cBtn;
960
961   # First look for all default-Buttons
962   foreach $cDefaultButton ("BtnNew",
963                            "BtnDel",
964                            "BtnQry",
965                            "BtnUpd",
966                            "BtnSelect",
967                            "BtnCancel",
968                            "BtnExit",
969                            "BtnHelp",
970                            "BtnOk")
971   {
972      if ($cBtn eq $cDefaultButton)
973      {
974         $bBtnFound = 1;
975
976         $oBtnPlugin->Call();
977         Plugin->new($cBtn . "Redisplay")->Call();
978      }
979   }
980
981   if(!$bBtnFound)
982   {
983      # Scan all sections
984      foreach $cSection ($oConfPoolGL->getSectionNames())
985      {
986         # Scan all parameters of section
987       PARAM:
988         foreach $cParamBtnName ($oConfPoolGL->getEntryNames($cSection))
989         {
990
991            # only interested in the Btn... = ... -Parameters
992            next
993                if ($cParamBtnName !~ /^Btn.*/);
994
995            if ($cBtn eq $cParamBtnName)
996            {
997               $bBtnFound = 1;
998
999               $oBtnPlugin->Call();
1000            }
1001         } # foreach $cParam
1002      } # foreach $cSection
1003   }
1004
1005   if (!$bBtnFound)
1006   {
1007      # Try to start cBtn's plugin
1008      $oBtnPlugin->Call()
1009          if defined $oBtnPlugin;
1010
1011      # We are in (special) browse mode
1012      if(&MyParam("WWWdbState") eq "Qry")
1013      {
1014         &BtnQry();
1015      }
1016      else
1017      {
1018         # Any other "unknown" mode
1019         &GenPage();
1020      }
1021   }
1022
1023   &MyParamDelete($cBtn);
1024
1025   &SaveState();
1026
1027}
1028
1029
1030
1031# --- Insert-Button pressed --------------------------------------------------
1032sub BtnNew () # Trigger
1033{
1034   &MyParam("WWWdbState", "Init");
1035
1036   if (!&GetAttr("RecordOk")) {
1037      &GenPage();
1038   }
1039   else {
1040
1041      &NewRecord();
1042   }
1043
1044}
1045
1046
1047sub BtnNewRedisplay() # Trigger
1048{
1049  if (&GetAttr("RecordOk"))
1050  {
1051     &ClearFields();
1052
1053     # confirm insertion eventually
1054     if(!&MyUserVal("GUI", "DontConfirmAfterInsert", ""))
1055     {
1056        &OkForm("", i18n("Record inserted!"));
1057     }
1058     else
1059     {
1060        &GenPage();
1061     }
1062  }
1063}
1064
1065
1066# --- OK-button pressed ------------------------------------------------------
1067sub BtnOk () # Trigger
1068{
1069   &GenPage();
1070}
1071
1072
1073# --- Delete-button pressed --------------------------------------------------
1074sub BtnDel () # Trigger
1075{
1076  &MyParam("WWWdbState", "Init");
1077  &DelRecord();
1078}
1079
1080sub BtnDelRedisplay () # Trigger
1081{
1082   &ClearFields();
1083   &MyParamDelete("BtnDel");
1084
1085   # confirm insertion eventually
1086   if(!&MyUserVal("GUI", "DontConfirmAfterDelete", ""))
1087   {
1088      &OkForm("", i18n("Record deleted!"));
1089   }
1090   else
1091   {
1092      &GenPage();
1093   }
1094}
1095
1096
1097
1098# --- Query-button pressed ---------------------------------------------------
1099sub BtnQry () # Trigger
1100{
1101   &MyParam("WWWdbState", "Qry");
1102   &QryData();
1103}
1104
1105
1106# --- Update-button pressed --------------------------------------------------
1107sub BtnUpd () # Trigger
1108{
1109   &MyParam("WWWdbState", "Work");
1110
1111   if (!&GetAttr("RecordOk")) {
1112      &GenPage();
1113   }
1114   else {
1115
1116      &UpdRecord();
1117      &MyParam("WWWdbState", "Init");
1118   }
1119
1120}
1121
1122sub BtnUpdRedisplay () # Trigger
1123{
1124   if (!&GetAttr("RecordOk")) {
1125      # Update Button has to be changed to Select, as like the record
1126      # has been selected in the last cycle
1127      &MyParamDelete("BtnUpdate");
1128      &MyParam("BtnSelect", "Select");
1129
1130      &MyParam("WWWdbState", "Work");
1131
1132      &GenPage();
1133   }
1134   else
1135   {
1136
1137      &ClearFields();
1138
1139      # eventually confirm update
1140      if(!&MyUserVal("GUI", "DontConfirmAfterUpdate", ""))
1141      {
1142         &OkForm("", "Record changed!");
1143      }
1144      else
1145      {
1146         &GenPage();
1147      }
1148   }
1149}
1150
1151
1152# --- This button was generated dynamically ----------------------------------
1153sub BtnSelect () # Trigger
1154{
1155   &MyParam("WWWdbState", "Work");
1156
1157   &FetchRecord();
1158}
1159
1160sub BtnSelectRedisplay () # Trigger
1161{
1162   &GenPage();
1163}
1164
1165
1166# --- Cancel-button pressed --------------------------------------------------
1167sub BtnCancel () # Trigger
1168{
1169   &MyParam("WWWdbState", "Init");
1170}
1171
1172
1173sub BtnCancelRedisplay () # Trigger
1174{
1175   &ClearFields();
1176   &GenPage();
1177}
1178
1179
1180# --- Exit-button pressed --------------------------------------------------
1181sub BtnExit () # Trigger HTML
1182{
1183    &Redirect(&GetAttr("SessionId"), "WWWdb:Index");
1184}
1185
1186
1187# --- Help-button pressed ----------------------------------------------------
1188sub BtnHelp () # Trigger HTML
1189{
1190   &Redirect(&GetAttr("SessionId"),
1191             ("WWWdb:Tools:ShowDoc;id=,help," .
1192              lc(&GetAttr("State")) .
1193              "-mode"));
1194}
1195
1196
1197# --- closure for %hCategories
1198sub _GetCatInfo {
1199
1200   # --- Create a navigation-list in first column ---------------------------
1201   sub GetCatInfo() # HTML Nav
1202   {
1203      my $cEntry;
1204      my $cLinkKey;
1205      my $cResult;
1206      my $cUrlParams = &GetAttr("UrlParams");
1207      my $iActualId;
1208      my $iCategory = 0;
1209      my $iInd;
1210      my $lRecord;
1211      my @lCatPath = ();
1212      my @lFields;
1213      my @lIdChain;
1214      my @lIdNames;
1215      my @lUrlParams = split ";", $cUrlParams;
1216      my $iLevel;
1217      my $iSortNr;
1218      my $iId;
1219
1220      return %hCategoriesGL
1221          if %hCategoriesGL;
1222
1223      # FIXME: Use GetObjectId
1224      return
1225          unless defined $oDbSessionGL;
1226
1227      # Generate a path upwards
1228      $cResult = "";
1229
1230      # the url-param overloads the value of the form
1231      foreach (@lUrlParams)
1232      {
1233
1234         $iCategory = $1
1235             if (/^cat=(\d+)/);
1236      }
1237
1238      $cLinkKey = ("wwwdb://" .
1239                   ($iCategory?  "WWWdb:Nav": &GetAttr("ConfigFile")) .
1240                   ($cUrlParams? (";" . $cUrlParams): ""));
1241
1242      # get category-info
1243      $iCategory = $oDbSessionGL->SqlSelect
1244          ("SELECT
1245                cat.id_category
1246            FROM
1247                wwwdb_category cat,
1248                wwwdb_obj_cat  oc,
1249                wwwdb_object   obj
1250            WHERE
1251                cat.id_category = oc.id_category AND
1252                oc.id_object    = obj.id_object  AND
1253                obj.ref_link    = ?",
1254           $cLinkKey)->[0]->[0]
1255              unless $iCategory;
1256
1257      # we had no success ... lets try it without the url-parameters
1258      unless ($iCategory)
1259      {
1260
1261         $cLinkKey = ("wwwdb://" .
1262                      &GetAttr("ConfigFile"));
1263
1264         # get category-info
1265         $iCategory = ($oDbSessionGL->SqlSelect
1266                       ("SELECT
1267                             cat.id_category
1268                         FROM
1269                             wwwdb_category cat,
1270                             wwwdb_obj_cat  oc,
1271                             wwwdb_object   obj
1272                         WHERE
1273                             cat.id_category = oc.id_category AND
1274                             oc.id_object    = obj.id_object  AND
1275                             obj.ref_link    = ?",
1276                        $cLinkKey))->[0]->[0];
1277      }
1278
1279      push @lCatPath, $iCategory
1280          if $iCategory;
1281
1282      push @lCatPath, &MyVal('WWWdb', 'DefaultCat', 0)
1283          if &MyVal('WWWdb', 'DefaultCat', 0);
1284
1285      # this are the default-categories
1286      push @lCatPath, 10000, 1;
1287
1288      # Try the categories in the sequence <found>, default-user, default-sys
1289      foreach (@lCatPath)
1290      {
1291
1292         # get category-info
1293         $cEntry = ($oDbSessionGL->SqlSelect
1294                    ("SELECT
1295                        cat.id_category,
1296                        cat.id_cat_of_cat,
1297                        cat.name,
1298                        cat.id_chain,
1299                        cat.name_chain,
1300                        cat.sort_nr,
1301                        cat.attribs,
1302                        tr1.trans_text   AS name_tra,
1303                        tr2.trans_text   AS name_chain_tra
1304                      FROM
1305                        wwwdb_category    cat,
1306                        wwwdb_translation tr1,
1307                        wwwdb_translation tr2
1308                      WHERE
1309                        cat.id_category       = ?           AND
1310                        cat.name_txt_id       = tr1.id_text AND
1311                        cat.name_chain_txt_id = tr2.id_text AND
1312                        tr1.lang              = ?           AND
1313                        tr2.lang              = tr1.lang
1314                      ORDER BY
1315                        cat.sort_nr",
1316                     $_,
1317                     &GetAttr("Lang")))->[0];
1318
1319         if (defined $cEntry)
1320         {
1321            $iCategory = $_;
1322            last;
1323         }
1324      }
1325
1326      die sprintf i18n("No wwwdb_category record with id=%s found! " .
1327                       " Please insert."),
1328          $iCategory
1329              unless defined $cEntry;
1330
1331      @lFields  = @{$cEntry};
1332
1333      @lIdChain = split /,/, $lFields[3];
1334      @lIdNames = split /,/, ($lFields[8] eq "?" ?
1335                              $lFields[4]:
1336                              $lFields[8]);
1337
1338   #   pop @lIdChain;
1339   #   pop @lIdNames;
1340
1341      for ($iInd = 0; $iInd < (@lIdChain); $iInd++)
1342      {
1343         $hCategoriesGL{$iInd}{-999}{$lIdChain[$iInd]} = $lIdNames[$iInd];
1344      }
1345
1346      # subcategories of this (and upper) category
1347      {
1348         # use -999 as a non-existent dummy-value when we are on top
1349         my $iParentCat   = ((@lIdChain > 1)?
1350                             $lIdChain[-2]:
1351                             -999);
1352
1353         # read sub-categories from database
1354         $lRecord = $oDbSessionGL->SqlSelect
1355             ("SELECT
1356                   ca0.id_category,
1357                   ca0.name,
1358                   ca0.sort_nr,
1359                   ca0.attribs,
1360                   tra.trans_text as tra_name,
1361                   ca0.id_cat_of_cat
1362               FROM
1363                   wwwdb_category     ca0,
1364                   wwwdb_category     ca1,
1365                   wwwdb_translation  tra
1366               WHERE
1367                   ca1.id_category        = ca0.id_category    AND
1368                   (ca0.id_cat_of_cat      = ?  OR
1369                    ca0.id_cat_of_cat      = ?)                AND
1370                   (ca1.nr_of_subcats + ca0.nr_of_objs) > 0    AND
1371                   ca0.name_txt_id        = tra.id_text        AND
1372                   tra.lang               = ?
1373               ORDER BY
1374                   ca0.sort_nr",
1375              $iCategory,
1376              $iParentCat,
1377              &GetAttr("Lang"));
1378
1379         # generate them
1380         foreach (@$lRecord)
1381         {
1382            my $lFields;
1383            my $iDelta;
1384
1385            @lFields = @{$_};
1386
1387            next
1388                if(!&IsAttribOK($lFields[3],
1389                                "IsHidden" => 0));
1390
1391            if($lFields[5] == $iParentCat)
1392            {
1393
1394               $iDelta = -1;
1395            }
1396            else
1397            {
1398               $iDelta = 0;
1399            }
1400
1401            $hCategoriesGL{$iInd + $iDelta}{$lFields[2]}{$lFields[0]} =
1402                ($lFields[4] eq "?" ?
1403                 $lFields[1]:
1404                 $lFields[4]);
1405         }
1406      }
1407
1408      foreach $iLevel (sort {$a <=> $b} keys %hCategoriesGL)
1409      {
1410
1411         foreach $iSortNr (sort {$a <=> $b} keys %{$hCategoriesGL{$iLevel}})
1412         {
1413
1414            foreach $iId (sort {$a <=> $b} keys %{$hCategoriesGL{$iLevel}{$iSortNr}})
1415            {
1416               print STDERR "**" x $iLevel . "$iLevel>$iSortNr>$iId iId => " . $iId .
1417                   " $hCategoriesGL{$iLevel}{$iSortNr}{$iId}\n";
1418            }
1419
1420         }
1421      }
1422
1423      return %hCategoriesGL;
1424
1425   }
1426
1427}
1428
1429
1430# --- obsolete Create a navigation-list in first column ---------------------
1431sub FirstColumn() # HTML Nav
1432{
1433   my $cResult = "";
1434
1435   $cResult .= &HierarchyForm();
1436
1437   $cResult .= &SubCategoriesForm();
1438
1439   $cResult .= &LoginForm();
1440
1441   $cResult .= &SearchForm();
1442
1443   $cResult .= &LangForm();
1444
1445   return $cResult;
1446}
1447
1448
1449# --- Form for the hierarchy-information ------------------------------------
1450sub HierarchyForm()
1451{
1452   my %hCategories = &GetCatInfo();
1453   my $iLevel;
1454   my $iSortNr;
1455   my $iId;
1456   my $cResult;
1457   my $iIgnoreLevel;
1458   my $iNrOfEntries =0;
1459
1460   my $oHtmlTableHier  = HTML::Table->new
1461       (BorderPar      => 0,
1462        CellpaddingPar => 0);
1463
1464   # find highest level of hierarchy
1465   LEVEL:
1466   foreach $iLevel (sort {$b <=> $a} keys %hCategories)
1467   {
1468      foreach $iSortNr (keys %{$hCategories{$iLevel}})
1469      {
1470         if($iSortNr == -999)
1471         {
1472            $iIgnoreLevel = $iLevel + 1;
1473            last LEVEL;
1474         }
1475      }
1476   }
1477
1478   my @lLevel = (sort {$a <=> $b} keys %hCategories);
1479
1480   # remove last hierarchy, because it is used by SubCategoriesForm
1481   # $iIgnoreLevel = pop @lLevel;
1482
1483   foreach $iLevel (@lLevel)
1484   {
1485      foreach $iSortNr (sort {$a <=> $b} keys %{$hCategories{$iLevel}})
1486      {
1487
1488         # Skip the hier-entries of the lowest two levels
1489         next
1490             if ((($iSortNr == -999) &&
1491                 ($iLevel  >= $iIgnoreLevel - 1)) ||
1492                 ($iLevel  >= $iIgnoreLevel));
1493
1494         foreach $iId (sort {$a <=> $b} keys %{$hCategories{$iLevel}{$iSortNr}})
1495         {
1496            print STDERR "HHH" x $iLevel . "$iLevel.$iSortNr.$iId iId => " . $iId .
1497                " $hCategories{$iLevel}{$iSortNr}{$iId}\n";
1498
1499            $oHtmlTableHier->Element
1500                (HTML::Table::APPEND,
1501               HTML::TableRow->new());
1502
1503            $oHtmlTableHier->Element
1504                (HTML::Table::CURRENT, $iLevel + 1, $iLevel + 1,
1505                 small(b(&ResolveRefField
1506                         (sprintf("wwwdb://WWWdb:Nav;cat=%s",
1507                                  $iId),
1508                          $hCategories{$iLevel}{$iSortNr}{$iId}))));
1509
1510            $oHtmlTableHier->Element
1511                (HTML::Table::CURRENT,
1512               HTML::Table::CURRENT)->setColspanPar(99);
1513
1514            $iNrOfEntries ++;
1515         }
1516
1517      }
1518   }
1519
1520   $cResult .= &FormTempl(i18n("Hierarchy:"),
1521                          $oHtmlTableHier->HtmlCode())
1522       if $iNrOfEntries;
1523
1524   return $cResult;
1525
1526}
1527
1528
1529# --- Form for the current access-path --------------------------------------
1530sub PathForm(;$$$)
1531{
1532   my $cPreTextPI   = shift || " [";
1533   my $cDelimTextPI = shift || "] [";
1534   my $cPostTextPI  = shift || "] ";
1535
1536   my %hCategories = &GetCatInfo();
1537   my $iLevel;
1538   my $iSortNr = -999;
1539   my $iId;
1540   my $cResult;
1541
1542   my @lLevel = (sort {$a <=> $b} keys %hCategories);
1543
1544   foreach $iLevel (sort {$a <=> $b} keys %hCategories)
1545   {
1546      foreach $iSortNr (keys %{$hCategories{$iLevel}})
1547      {
1548         foreach $iId (sort {$a <=> $b} keys %{$hCategories{$iLevel}{$iSortNr}})
1549         {
1550            $cResult .=
1551                (($cResult? $cDelimTextPI: "") .
1552                 &ResolveRefField
1553                 (sprintf("wwwdb://WWWdb:Nav;cat=%s",
1554                          $iId),
1555                  $hCategories{$iLevel}{$iSortNr}{$iId}))
1556                    if $iSortNr == -999;
1557
1558         }
1559
1560      }
1561   }
1562
1563   $cResult = &ResolveRefField("wwwdb://WWWdb:Index", "WWWdb")
1564       unless $cResult;
1565
1566   return $cPreTextPI . $cResult . $cPostTextPI;
1567
1568}
1569
1570
1571# --- Form for the actual subcategories -------------------------------------
1572sub SubCategoriesForm()
1573{
1574   my $cBullet;
1575   my $cResult;
1576   my $iId;
1577   my $iLevel    = undef;
1578   my $iMaxLevel = undef;
1579   my $iNrOfSubcats = 0;
1580   my $iSortNr;
1581   my %hCategories = &GetCatInfo();
1582
1583   my $oHtmlTableSubCat  = HTML::Table->new
1584       (BorderPar      => 0,
1585        CellpaddingPar => 0);
1586
1587   # find highest level of hierarchy
1588   LEVEL:
1589   foreach $iLevel (sort {$b <=> $a} keys %hCategories)
1590   {
1591   print STDERR "CCC: iLevel = $iLevel\n";
1592      foreach $iSortNr (keys %{$hCategories{$iLevel}})
1593      {
1594         print STDERR "CCC: iSortNr = $iSortNr\n";
1595         if($iSortNr == -999)
1596         {
1597            $iMaxLevel = $iLevel + 1;
1598            last LEVEL;
1599         }
1600      }
1601   }
1602
1603   print STDERR "CCC: iMaxLevel = $iMaxLevel\n";
1604
1605   $cBullet = (&GenImage(&MyVal('Layout Table', 'Bullet1stCol', ""),
1606                            "", 0) or
1607                  &MyVal('Layout Table', 'Bullet1stCol', "-"));
1608
1609   foreach $iSortNr (sort {$a <=> $b} keys %{$hCategories{$iMaxLevel}})
1610   {
1611      next
1612          if ($iSortNr == -999);
1613
1614      foreach $iId (sort {$a <=> $b} keys %{$hCategories{$iMaxLevel}{$iSortNr}})
1615      {
1616         print STDERR "CCC" x $iMaxLevel . "$iMaxLevel.$iSortNr.$iId iId => " . $iId .
1617             " $hCategories{$iMaxLevel}{$iSortNr}{$iId}\n";
1618
1619         $oHtmlTableSubCat->Element
1620             (HTML::Table::APPEND,
1621            HTML::TableRow->new());
1622
1623         $oHtmlTableSubCat->Element
1624             (HTML::Table::CURRENT, $iMaxLevel, $iMaxLevel + 1, $cBullet);
1625
1626         $oHtmlTableSubCat->Element
1627             (HTML::Table::CURRENT, $iMaxLevel + 1, $iMaxLevel + 1,
1628              small(b(&ResolveRefField
1629                      (sprintf("wwwdb://WWWdb:Nav;cat=%s",
1630                               $iId),
1631                       $hCategories{$iMaxLevel}{$iSortNr}{$iId}))));
1632
1633         $oHtmlTableSubCat->Element
1634             (HTML::Table::CURRENT,
1635            HTML::Table::CURRENT)->setColspanPar(99);
1636
1637         $iNrOfSubcats ++;
1638      }
1639
1640   }
1641
1642   $cResult .= &FormTempl(i18n("Sub-categories:"),
1643                          $oHtmlTableSubCat->HtmlCode())
1644       if $iNrOfSubcats;
1645
1646   return $cResult;
1647}
1648
1649
1650
1651# --- Form for searching the site -------------------------------------------
1652sub SearchForm()
1653{
1654   my $cResult = "";
1655   my $cHeader = "";
1656
1657
1658   $cHeader = i18n("Site-Search:");
1659
1660   $cResult .= (textfield (-name      => "Fld_Search",
1661                           -maxlength => "100",
1662                           -size      => "10",
1663                           -tabindex  => 9999));
1664
1665   $cResult .= "&nbsp;";
1666
1667   $cResult .= &SubmitButton("Btn_Search",
1668                             &EncodeHtml(i18n("Search")));
1669
1670   $cResult = &FormTempl($cHeader, $cResult);
1671
1672   return $cResult;
1673}
1674
1675# --- Form for user-login --------------------------------------------------
1676sub LoginForm()
1677{
1678   my $cResult = "";
1679   my $cHeader = "";
1680
1681   if(&IsAttribOK("ActualLogin") &&
1682      defined $oSessionGL        &&
1683      !$oSessionGL->getState("IsAnonymous"))
1684   {
1685      my $cUserName;
1686      my $cPassword;
1687
1688      ($cUserName, $cPassword) = split /,/, $oSessionGL->getState("login");
1689
1690      $cHeader = sprintf(i18n("Logged in as %s"),
1691                         b($cUserName));
1692
1693      $cResult .= ((&ResolveRefField("wwwdb://WWWdb:System:Logout",
1694                                       i18n("Logout"))));
1695   }
1696   else
1697   {
1698      $cHeader = i18n("Not logged in.");
1699      $cResult .= ((&ResolveRefField("wwwdb://WWWdb:System:Login",
1700                                       i18n("Login"))));
1701   }
1702
1703   $cResult = &FormTempl($cHeader, center($cResult));
1704
1705   return $cResult;
1706}
1707
1708# --- Form for language-selection -------------------------------------------
1709sub LangForm()
1710{
1711   my $cResult = "";
1712   my $lLang;
1713   my $cHeader = "";
1714
1715   $lLang = $oDbSessionGL->SqlSelect
1716       ("SELECT
1717             key_value, label, sort_nr
1718         FROM
1719            wwwdb_lookup
1720         WHERE
1721            lang     = 'en'          AND
1722            key_name = 'lang_select'
1723         ORDER BY
1724            sort_nr");
1725
1726   # Select the language
1727   if (@$lLang > 1)
1728   {
1729      my $cLang;
1730      my %hLabels = ();
1731      my @lListValues = ();
1732
1733      $cHeader = i18n("Language-Select:");
1734
1735
1736      # Split the Value,Label list in two Arrays
1737      foreach $cLang (@$lLang)
1738      {
1739         push @lListValues, $cLang->[0];
1740         $hLabels{$cLang->[0]} = $cLang->[1];
1741      }
1742
1743      $cResult .= (scrolling_list(-name      => "Fld_SelLang",
1744                                  -values    => \@lListValues,
1745                                  -labels    => \%hLabels,
1746                                  -default   => &GetAttr("Lang"),
1747                                  -override  => 1,
1748                                  -size      => "1"));
1749
1750      $cResult .= &SubmitButton("Btn_SelLang",
1751                                &EncodeHtml("<<"));
1752
1753
1754   }
1755
1756   $cResult = &FormTempl($cHeader, center($cResult));
1757
1758   return $cResult;
1759}
1760
1761
1762
1763# --- Generate a HTML-Container for some Data -------------------------------
1764sub FormTempl($$)
1765{
1766   my $cHeaderPI  = shift;
1767   my $cContentPI = shift;
1768   my $cResult = "";
1769
1770   if($cContentPI)
1771   {
1772      my $oTemplate = HTML::Template->new
1773          (filename => (&GetAttr("BaseDir") .
1774                        &MyVal('WWWdb', "NavTemplate",
1775                               "/lib/WWWdb/Templ/Tmpl_WWWdbNav.html")),
1776           die_on_bad_params => 0);
1777
1778
1779      # fill in some parameters
1780      $oTemplate->param(HEADER       => $cHeaderPI,
1781                        CONTENT      => $cContentPI);
1782
1783      $cResult = $oTemplate->output;
1784   }
1785}
1786
1787
1788
1789
1790=head2 ClearFields - clear all entry-fields
1791
1792=over 2
1793
1794=item B<DESCRIPTION>
1795
1796Clears all entry-fields in the Form which were defined via
1797[Layout\ Field\ ...] entries.
1798
1799=item B<SYNOPSIS>
1800
1801ClearField();
1802
1803=item B<RETURN VALUE>
1804
1805None.
1806
1807=item B<EXAMPLE>
1808
1809 # Clear all fields to blank
1810 &ClearFields();
1811
1812=item B<SEE ALSO>
1813
1814SetField
1815
1816=back
1817
1818=cut
1819
1820# --- Clear all user Fields --------------------------------------------------
1821sub ClearFields() # CGI Form
1822{
1823   my $cEntry;
1824
1825   foreach $cEntry (keys %hFormDataMGL)
1826   {
1827      if ($cEntry =~ /^Fld(.*)$/)
1828      {
1829         &MyParamDelete($cEntry);
1830         &MyParamDelete($1);
1831      }
1832   }
1833}
1834
1835# --- generate a error-message ------------------------------------------------
1836sub DbiErrorAndExit ($) # Db HTML
1837{
1838
1839   my $cSqlOperationPI = shift;
1840
1841   printf STDERR $pDataSetMGL->LastSQLStatement() . "<BR>\n"
1842       if &GetAttr("DebugLvl") > 3;
1843
1844   if( $pDataSetMGL->DBHdl()->err)
1845   {
1846      &Error(sprintf(i18n("Database Error occured during %s!") . "<BR>" .
1847                     i18n("    SQL-Error: (%d) %s") . "<BR>" .
1848                     i18n("    Statement: %s") . "<BR>",
1849                     $cSqlOperationPI,
1850                     $pDataSetMGL->DBHdl()->err,
1851                     $pDataSetMGL->DBHdl()->errstr,
1852                     $pDataSetMGL->LastSQLStatement()));
1853   }
1854}
1855
1856
1857# --- Query-data and display the result --------------------------------------
1858sub QryData() # (HTML Db Recordset ConfigFile CGI Plugin)
1859{
1860   my $bSortKeys = 0;
1861   my $cBgColor2;
1862   my $cBgColor;
1863   my $cField;
1864   my $cKey;
1865   my $cLastRecId;
1866   my $cName;
1867   my $cNavBtnsOrMsg;
1868   my $cOp;
1869   my $cQrySelType;
1870   my $cRecIdFields;
1871   my $cValue;
1872   my $iInd;
1873   my $iNrOfColouredLine;
1874   my $iNrOfRows;
1875   my $oHtmlTableApp;
1876   my $oTableHeaderPlugin;
1877   my $pRecord;
1878   my @lNames;
1879   my %hOPlugins;
1880
1881   $cBgColor2         = &MyVal('Qry', 'BgColor2', "#dddddd");
1882   $iNrOfColouredLine = &MyVal('Qry', 'NrOfColLine', 2);
1883   $cQrySelType       = &MyVal('Qry', 'SelType', 'Btn');
1884
1885   $cRecIdFields      = &GetAttr("RecIdField");
1886
1887   $oTableHeaderPlugin = Plugin->new("TableHeader",
1888                                     "HasPrePost" => 1,
1889                                     "HasMy"      => 1);
1890
1891   $oHtmlTableApp  = HTML::Table->new
1892       (BorderPar      => &MyVal('Qry', 'BorderWidth', '0'),
1893    BgColorPar     => &MyUserVal('Layout Table',
1894                                     'BgColor',
1895                                     $cBgColorMGL),
1896        CellpaddingPar => 0,
1897    WidthPar       => "100%",
1898    HeightPar      => "100%");
1899
1900   # add id-field to the query
1901   &MyParam("!Fields",
1902            ((&MyVal('Qry', 'Distinct')? "DISTINCT ":  "") .
1903             &MyVal('Data', 'QryFields') .
1904             ", ".
1905             $cRecIdFields ));
1906
1907   &InitDBIxRecordset();
1908
1909   # Here the User can manipulate form-data
1910   Plugin->new("PreCreateForm")->Call();
1911
1912   &DebugFormData();
1913
1914   # create recordset
1915   *pDataSetMGL = DBIx::Recordset->Setup(\%hFormDataMGL);
1916
1917   # Get the type-info for the fields
1918   &GetAllFieldInfo(&MyVal('Data', 'Table'), $pDataSetMGL);
1919
1920   # construct selection-criteria
1921   foreach $cKey (keys %hFormDataMGL)
1922   {
1923
1924      if ($cKey =~ "^Fld.*" and &MyParam($cKey) ne "")
1925      {
1926
1927         # get the fieldname
1928         ($cField = $cKey) =~ s/^Fld//;
1929
1930         # we got an operator
1931         if(&MyParam("\*$cField"))
1932         {
1933            &MyParam($cKey,
1934                     &MyParam("\*$cField") . " " .
1935                     &MyParam("$cField"));
1936
1937         }
1938
1939         # now scan the search-operator
1940         if(&MyParam($cKey) =~ /^(<>|>=|<=|<|>|!=|=|like)\s*(.*)$/)
1941         {
1942            ($cOp, $cValue) = ($1, $2);
1943         }
1944         else # no search-operator
1945         {
1946            # * is replaced with LIKE
1947            if (&MyParam($cKey) =~ /\*/)
1948            {
1949               ($cValue = &MyParam($cKey)) =~ s/\*/%/g;
1950               $cOp     = "like";
1951
1952            }
1953            else
1954            {
1955               $cOp    = "=";
1956               $cValue = &MyParam($cKey);
1957            }
1958         }
1959
1960         # make this field ready for querying the database
1961         &MyParam($cKey, $cValue);
1962
1963         &ConvertDataForDb("Form2Db", $cField);
1964         $cValue = &MyParam($cKey);
1965
1966         if($cValue)
1967         {
1968            # if an empty-value is detected use " "
1969            if (($cValue eq "''") or
1970                ($cValue eq '""'))
1971            {
1972               $cValue = "";
1973            }
1974
1975            &MyParam("\*$cField", $cOp);
1976            &MyParam("$cField", $cValue);
1977
1978            printf STDERR sprintf(i18n("%s => Op: s(%s) Value: s(%s)") .
1979                                  "<BR>\n",
1980                                  $cField,
1981                                  $cOp,
1982                                  $cValue)
1983                if &GetAttr("DebugLvl") > 3;
1984         }
1985      } # if ($cKey =~ "Fld.*" and &MyParam($cKey) ne "")
1986   } # foreach $cKey (keys %hFormDataMGL)
1987
1988   &InitDBIxRecordset();
1989
1990   # Search for Data
1991   $pDataSetMGL->Search(\%hFormDataMGL);
1992
1993   # catch DB-error
1994   &DbiErrorAndExit(i18n("data-querying"));
1995
1996   {
1997      my $cEntry;
1998      my $iRowInd = 0;
1999
2000      # show table-header like in field-list
2001      foreach $cEntry (split /, */,
2002                       "_link, " . &MyVal('Data', 'QryFields'))
2003      {
2004         my $cConfKey = "Layout Qry $cEntry";
2005
2006         $hOPlugins{$cEntry} =
2007             Plugin->new("QryConv_${cEntry}");
2008
2009         if (lc($cEntry) eq "_link")
2010         {
2011
2012            if ($cQrySelType ne "None")
2013            {
2014
2015                $oHtmlTableApp->Element
2016                    (0, $iRowInd, 0,
2017                     p(font({-SIZE=>2},
2018                            checkbox(-name      => "Fld_ResetSort",
2019                                     -checked   => 0,
2020                                     -value     => 1,
2021                                     -override  => 1,
2022                                     -label     => " " . i18n("Reset")))).
2023                     &MyVal($cConfKey, "Text"));
2024            }
2025         }
2026         else
2027         {
2028            my $cBtnLabel = &MyVal($cConfKey, "Text", $cEntry);
2029
2030            if(!$cBtnLabel)
2031            {
2032                $oHtmlTableApp->Element
2033                    (0, $iRowInd, 0, "&nbsp;");
2034            }
2035            else
2036            {
2037
2038                $oHtmlTableApp->Element
2039                    (0, $iRowInd, 0,
2040                     p(font({-SIZE=>2},
2041                            &SubmitButton("BtnSort$cEntry",
2042                                          $cBtnLabel))));
2043                $bSortKeys = 1;
2044            }
2045         }
2046         $iRowInd ++;
2047      }
2048
2049   }
2050
2051   $oHtmlTableApp->Element(0, 0, 0, &MyVal("Layout Qry _link", "Text"))
2052       unless $bSortKeys;
2053
2054   $iInd = 0;
2055   while ($pRecord = $pDataSetMGL[$iInd])
2056   {
2057       $iInd ++;
2058
2059       my $iRow = 0;
2060       # Show different colors for the different rows
2061       $cBgColor = ((($iInd - 1) % $iNrOfColouredLine)?
2062                    $cBgColorMGL:
2063                    "$cBgColor2");
2064
2065       foreach $cName (split /, */,
2066                       "_link, " . &MyVal('Data', 'QryFields'))
2067       {
2068           my $cConfKey = "Layout Qry $cName";
2069           my %hAttribs = ();
2070           my $cTabEntry;
2071
2072           # $cName = lc($cName);
2073
2074           $hAttribs{"BgColorPar"} = $cBgColor
2075               if $cBgColor;
2076
2077           # we need this field for generating a selector for the record
2078           if ($cName eq "_link")
2079           {
2080               my @lKeyFields = split /, /, &GetAttr("RecIdField");
2081
2082               # scan multiple primary-keys
2083               foreach (@lKeyFields)
2084               {
2085                   $_ = $$pRecord{$_};
2086               }
2087
2088               $cLastRecId = join ",", @lKeyFields;
2089               $cLastRecId =~ s/ /%20/g;
2090               $cLastRecId =~ s/://g; # Normally 3A but this works no
2091               $cLastRecId =~ s/\//%2F/g;
2092
2093               if($cQrySelType eq "Check")
2094               {
2095
2096                   $cTabEntry =
2097                       font({-SIZE=>2},
2098                            checkbox(-name    => "Chb" . $$pRecord{$cName},
2099                                     -checked => $$pRecord{$cName},
2100                                     -value   => i18n(&MyVal($cConfKey,
2101                                                             "Value",
2102                                                             "1")),
2103                                     -label   => &EncodeHtml(i18n($iInd))));
2104
2105               }
2106               elsif($cQrySelType eq "Link")
2107               {
2108                   $cTabEntry = &GenField("Qry",
2109                                          "_link",
2110                                          ("wwwdb://" .
2111                                           &GetAttr("ConfigFile") .
2112                                           ";id=" .
2113                                           $cLastRecId));
2114               }
2115               elsif($cQrySelType eq "None")
2116               {
2117                   $cTabEntry = "";
2118                   next;
2119               }
2120               else
2121               {
2122                   $cTabEntry =
2123                       font({-SIZE=>2},
2124                            &SubmitButton("BtnSelect" . $cLastRecId,
2125                                          &EncodeHtml(i18n($iInd))));
2126               }
2127           }
2128           # not the selector
2129           else
2130           {
2131               my $cValue;
2132
2133               # use the default-plugin, if available. If not take
2134               # simply the field-value
2135               $cValue = ($hOPlugins{$cName}->IsDefined("Default")?
2136                          $hOPlugins{$cName}->Call($$pRecord{$cName},
2137                                                   %{$pRecord}):
2138                          $$pRecord{$cName});
2139
2140               $hAttribs{"AlignPar"} = &MyVal($cConfKey, "Align", "")
2141                   if &MyVal($cConfKey, "Align", "");
2142               $hAttribs{"ValignPar"} = &MyVal($cConfKey, "VAlign", "")
2143                   if &MyVal($cConfKey, "VAlign", "");
2144               $hAttribs{"NowrapPar"} = "NOWRAP"
2145                   if &MyVal($cConfKey, "NoWrap", "");
2146               $hAttribs{"BorderPar"}  = &MyVal('Layout Table', 'Border', '0')
2147                   if &MyVal('Layout Table', 'Border', '0');
2148
2149               if($cValue)
2150               {
2151
2152                   $cTabEntry = &GenField("Qry",
2153                                          $cName,
2154                                          ($cValue .
2155                                           "\\," .
2156                                           $$pRecord{&GetAttr("RecIdField")}));
2157
2158                   # FIXME: Check why we need ... $$pRecord{&GetAttr("RecIdField")
2159               }
2160               else
2161               {
2162
2163                   $cTabEntry = "&nbsp;"
2164                       if !$cTabEntry;
2165               }
2166           }
2167
2168           $oHtmlTableApp->Element
2169               ($iInd, $iRow, HTML::TableCol->new(%hAttribs));
2170
2171           $oHtmlTableApp->Element
2172               ($iInd, $iRow, 0, $cTabEntry);
2173
2174           $iRow ++;
2175       }
2176   } # while ($pRecord = $pDataSetMGL[$iInd++])
2177
2178   $iNrOfRows = $iInd;
2179
2180   # bottom area
2181   {
2182       $iInd ++;
2183
2184       # No record was found
2185       if ($iNrOfRows == 0)
2186       {
2187
2188          # "remove" sort-buttons
2189          foreach (0 .. $oHtmlTableApp->getMaxCol())
2190          {
2191             $oHtmlTableApp->Element(0, $_, 0, "");
2192          }
2193
2194          # Message, that no data was found
2195          $cNavBtnsOrMsg = Plugin->new("NoRecordFound",
2196                                       "HasMy" => 1)->Call();
2197       }
2198       # exactly one record found, show directly
2199       elsif ($iNrOfRows == 1 && !&MyVal('Qry', 'ForceBrowse', ))
2200       {
2201          # Throw away the generated form
2202          $oHtmlTableApp = undef;
2203
2204          # "emulate" the Select-Button
2205          &Redirect(&GetAttr("SessionId"),
2206                    &GetAttr("ConfigFile") . ";id=$cLastRecId");
2207       }
2208       else
2209       {
2210          # due to security-reasons thes fields are deleted
2211          foreach $cKey ("!DataSource", "!Database", "!Username", "!Password")
2212          {
2213             &MyParamDelete($cKey);
2214          }
2215
2216          # Remove all unneccessary hidden-fields
2217          foreach $cKey (sort keys %hFormDataMGL)
2218          {
2219             if (($cKey =~ /^Btn.*/) ||
2220                 ($cKey =~ /^Fld_.*/) ||
2221                 ($cKey =~ /^_.*/))
2222             {
2223                &MyParamDelete($cKey);
2224             }
2225
2226          }
2227
2228          # all hidden fields will be generated here too
2229          $cNavBtnsOrMsg = $pDataSetMGL->PrevNextForm
2230              ({-first => i18n('|< Begin'),
2231                -prev  => i18n('<< Back'),
2232                -next  => i18n('Forward >>'),
2233                -last  => i18n('End >|')},
2234               \%hFormDataMGL);
2235
2236
2237       }
2238
2239       # WORKAROUND: extract form-commands from $cNavBtnsOrMsg
2240       $cNavBtnsOrMsg =~ s/<\/?form.*?>//gi;
2241
2242       $oHtmlTableApp->Element($iInd, 0, 0, center($cNavBtnsOrMsg));
2243       $oHtmlTableApp->Element
2244           ($iInd, 0)->setColspanPar($oHtmlTableApp->getMaxCol());
2245
2246       $iInd ++;
2247       $oHtmlTableApp->Element($iInd, 0, 0, &FormButtons());
2248       $oHtmlTableApp->Element
2249       ($iInd, 0)->setColspanPar($oHtmlTableApp->getMaxCol());
2250
2251   }
2252
2253   &GenHtmlForm($oTableHeaderPlugin->Call(&MyParam("!Order")?
2254                                          (i18n("Search-result ordered by ") .
2255                                           i18n(&MyParam("!Order"))):
2256                                          i18n("Search-result")),
2257                $oHtmlTableApp->HtmlCode(),
2258                undef);
2259} # sub QryData
2260
2261# -- Plugin, if no record was found -----------------------------------
2262sub NoRecordFound()
2263{
2264   my $cResult =
2265       (br() x 2 .
2266        p(b(small(i18n("Sorry! No data is available " .
2267                       "for your search-criteria!")))) .
2268        br() x 2);
2269
2270   return $cResult;
2271}
2272
2273sub FormButtons() # HTML (ConfigFile)
2274{
2275   my $cParam;
2276
2277   my $cResult = "";
2278
2279   $cResult .= ("<CENTER>\n");
2280
2281   # Work with selected Record
2282   if (&MyParam("WWWdbState") eq "Work") {
2283
2284      $cResult .= &AddSubmitButton("Work", "BtnUpd", i18n("Update.png"));
2285      $cResult .= &AddSubmitButton("Work", "BtnDel", i18n("Delete.png"));
2286
2287      $cResult .= &UserButtonsOfState("Work", ("BtnUpd", "BtnDel"));
2288   }
2289   # Initial state
2290   elsif(&MyParam("WWWdbState") eq "Init") {
2291
2292      $cResult .= &AddSubmitButton("Init", "BtnQry", i18n("Query.png"));
2293      $cResult .= &AddSubmitButton("Init", "BtnNew", i18n("Insert.png"));
2294
2295      $cResult .= &UserButtonsOfState("Init", ("BtnQry", "BtnNew"));
2296
2297   }
2298   # Query-mode
2299   elsif(&MyParam("WWWdbState") eq "Qry") {
2300
2301      $cResult .= &UserButtonsOfState("Qry", ());
2302   }
2303
2304   # Buttons, that appear in every state
2305
2306   $cResult .= &AddSubmitButton("All", "BtnCancel", i18n("Cancel.png"));
2307   $cResult .= &AddSubmitButton("All", "BtnExit",   i18n("Exit.png"));
2308   $cResult .= &AddSubmitButton("All", "BtnHelp",   i18n("Help.png"));
2309
2310   $cResult .= &UserButtonsOfState("All", ("BtnCancel", "BtnExit", "BtnHelp"));
2311
2312   $cResult .= ("</CENTER>\n");
2313
2314   return $cResult;
2315}
2316
2317# --- scan the config-file for user-defined buttons in this state ------------
2318sub UserButtonsOfState ($\@) # CGI Html
2319{
2320   my $cStatePI = shift;
2321   my @lcDefaultButtonsPI = @_;
2322
2323   my $cParamBtnName;
2324   my $cDefaultButton;
2325   my $cSection;
2326   my $cResult = "";
2327
2328   # Scan all sections
2329   foreach $cSection ($oConfPoolGL->getSectionNames())
2330   {
2331
2332      # only the [State ...] sections are interesting
2333      if($cSection eq "State $cStatePI")
2334      {
2335         # Scan all parameters of section
2336       PARAM:
2337         foreach $cParamBtnName ($oConfPoolGL->getEntryNames($cSection))
2338         {
2339
2340            # only the Btn... = ... -Parameters are interesting
2341            next
2342                if ($cParamBtnName !~ /^Btn.*/);
2343
2344            # Default-Buttons are handled explicitly
2345            foreach $cDefaultButton (@lcDefaultButtonsPI)
2346            {
2347               next PARAM
2348                   if($cParamBtnName eq $cDefaultButton);
2349
2350            } # foreach $cDefaultButton
2351
2352            $cResult .= &AddSubmitButton("$cStatePI", "$cParamBtnName");
2353
2354         } # foreach $cParam
2355      } # if($cSection eq "State $cStatePI"
2356   } # foreach $cSection
2357
2358   return $cResult;
2359}
2360
2361
2362# --- add a single Button if allowed in config-file
2363sub AddSubmitButton () # HTML
2364{
2365   my ($cStatePI, $cBtnNamePI, $cDefaultPI) = @_;
2366
2367   my $cBtnLabel;
2368   my $cResult = "";
2369
2370
2371   $cBtnLabel = &MyVal("State $cStatePI", "$cBtnNamePI");
2372
2373   # show button only, if label is ne "-"
2374   if ("$cBtnLabel" ne "-")
2375   {
2376      $cBtnLabel = $cDefaultPI
2377          if (!$cBtnLabel);
2378
2379      $cResult .= &SubmitButton($cBtnNamePI, $cBtnLabel);
2380   }
2381
2382   return $cResult;
2383
2384}
2385
2386
2387sub SubmitButton($$)
2388{
2389   my ($cBtnNamePI, $cLabelPI) = @_;
2390
2391   my $cFilename = "";
2392   my $cResult;
2393   my $cLabel = i18n($cLabelPI);
2394
2395   if($cLabelPI =~ /(.*)\.(png|jpg|gif)/)
2396   {
2397      $cFilename = (&GetAttr("BaseDir") .
2398                    "/lib/Images/Btn" .
2399                    i18n($cLabelPI));
2400
2401      if (! -f $cFilename)
2402      {
2403         $cFilename = undef;
2404         $cLabel    = $1;
2405
2406      }
2407      else
2408      {
2409         $cFilename = ("/" .
2410                       &GetAttr("ScriptName") .
2411                       "/lib/Images/Btn" .
2412                       i18n($cLabelPI));
2413
2414      }
2415   }
2416
2417   if ($cFilename)
2418   {
2419      $cResult = image_button(-name   => $cBtnNamePI,
2420                              -src    => $cFilename,
2421                              -border => "0");
2422   }
2423   else
2424   {
2425      $cResult = submit(-name  => $cBtnNamePI,
2426                        -label => i18n($cLabel)). "";
2427
2428   }
2429
2430   return $cResult;
2431
2432}
2433
2434
2435
2436# --- Check the whole record -------------------------------------------------
2437sub CheckRecord () # (DataRecord Plugin ConfigFile)
2438{
2439
2440   my $cField;
2441   my $cTable;
2442   my @lFields = ();
2443
2444   # empty the error-hash
2445   undef %hFieldErrorsMGL;
2446
2447   my $oPluginEveryField =
2448       Plugin->new("Check_${cTable}_EveryField");
2449
2450   $cTable = &MyVal('Data', 'Table');
2451
2452   push @lFields, split ", ", &MyVal('Data', 'IdField');
2453   push @lFields, split ", ", &MyVal('Data', 'UpdFields');
2454   push @lFields, split ", ", &MyVal('Data', 'ExtraFields');
2455
2456   foreach $cField (@lFields)
2457   {
2458      &InternalFieldCheck($cField);
2459
2460      $oPluginEveryField->Call("$cField");
2461
2462      Plugin->new("Check_${cTable}_${cField}")->Call();
2463
2464   }
2465
2466   Plugin->new("Check_$cTable")->Call();
2467
2468   return;
2469
2470} # sub CheckRecord
2471
2472
2473
2474
2475=head2 InternalFieldCheck - make default-checks
2476
2477=over 2
2478
2479=item B<DESCRIPTION>
2480
2481FIXME: add dcos
2482
2483=item B<SYNOPSIS>
2484
2485=item B<RETURN VALUE>
2486
2487None.
2488
2489=item B<EXAMPLE>
2490
2491 # The Record has not been found
2492 &OkForm("error", "Sorry, but the record couldn't be found!");
2493
2494=item B<SEE ALSO>
2495
2496Error
2497
2498=back
2499
2500=cut
2501
2502# --- make internal checks ---------------------------------------------------
2503sub InternalFieldCheck($) # HTML
2504{
2505   my $cFieldNamePI = shift;
2506
2507   my $cPattern;
2508   my $cValue = &GetField($cFieldNamePI);
2509
2510   # make lowercase
2511   if (&MyVal("Layout Field $cFieldNamePI", 'ToLower'))
2512   {
2513      &SetField($cFieldNamePI,
2514                lc($cValue));
2515   }
2516
2517   # make uppercase
2518   if (&MyVal("Layout Field $cFieldNamePI", 'ToUpper'))
2519   {
2520      &SetField($cFieldNamePI,
2521                uc($cValue));
2522   }
2523
2524   # check the Mandatory-Flag
2525   if (&MyVal("Layout Field $cFieldNamePI", 'Mandatory'))
2526   {
2527      &AddError("$cFieldNamePI",
2528                sprintf(i18n("No value for field %s, please complete!"),
2529                        (i18n($cFieldNamePI))))
2530          if(!$cValue);
2531   }
2532
2533   $cPattern = &MyVal("Layout Field $cFieldNamePI", 'MustMatch');
2534
2535   # check the MustMatch-Flag
2536   if ($cPattern && ($cValue ne ""))
2537   {
2538
2539      printf STDERR "MATCHING: '$cPattern' with '$cValue'\n";
2540
2541      if($cValue !~ /$cPattern/)
2542      {
2543         my $cErrMessage;
2544
2545         $cErrMessage  = (i18n($cFieldNamePI) .
2546                          ": " .
2547                          &MyVal("Layout Field $cFieldNamePI",
2548                                 'MustMatch_Errmsg',
2549                                i18n("didn't meet the " .
2550                                     "right format, please correct!")));
2551
2552         &AddError("$cFieldNamePI", $cErrMessage);
2553      }
2554   }
2555
2556}
2557
2558
2559# --- convert data between html-form and a format, the database can understand
2560sub ConvertDataForDb($;$) # Db (Plugin)
2561{
2562   my $cDirectionPI = shift;
2563   my $cFieldPI     = shift;
2564
2565   my $cField;
2566   my $cTable;
2567   my @lFields;
2568   my %hConvPlugins = ();
2569
2570   if (defined($cFieldPI))
2571   {
2572       @lFields = $cFieldPI;
2573   }
2574   else
2575   {
2576      push @lFields, split ", ", &MyVal('Data', 'IdField');
2577      push @lFields, split ", ", &MyVal('Data', 'UpdFields');
2578      push @lFields, split ", ", &MyVal('Data', 'ExtraFields');
2579   }
2580
2581   print STDERR "ConvertDataForDb Fields: @lFields\n"
2582       if &GetAttr("DebugLvl") > 3;
2583
2584   $cTable = &MyVal('Data', 'Table');
2585
2586   foreach $cField (@lFields)
2587   {
2588      my $cFieldType;
2589      my $cFunctName;
2590      my $cEvalCode;
2591      my $cFieldValue;
2592      my $cResult = undef;
2593
2594      $cFieldType = &GetFieldTypeName($cField);
2595
2596      # assert($cFieldType) if DEBUG
2597      $cFunctName = sprintf("DbSession::%s_%s",
2598                            $cFieldType,
2599                            $cDirectionPI);
2600
2601      $cFieldValue = &GetField($cField);
2602
2603      if(!defined $hConvPlugins{"$cFunctName"})
2604      {
2605         $hConvPlugins{"$cFunctName"} = eval "defined(&$cFunctName)" || 0;
2606         printf STDERR ("defined $cFunctName = %s\n",
2607                        $hConvPlugins{"$cFunctName"});
2608      }
2609
2610      $cEvalCode = "$oDbTargetGL->$cFunctName(" . $oDbTargetGL . ", $cFieldValue)";
2611      $cResult = ($hConvPlugins{"$cFunctName"}?
2612                  eval {$oDbTargetGL->$cFunctName($cFieldValue);}:
2613                  $cFieldValue);
2614
2615      if (defined $cResult)
2616      {
2617         print STDERR "Field: $cFunctName(), $cField, $cFieldValue -> $cResult\n"
2618             if &GetAttr("DebugLvl") > 2;
2619
2620         # this happens, when no plugin is defined, or the first param
2621         # is not correctly shifted
2622         # *** This may be a dirty Hack - better solutions are welcome ***
2623         $cResult =~ s/DbSession=HASH(.*) //;
2624
2625         &SetField($cField, $cResult);
2626      }
2627   }
2628
2629   return;
2630}
2631
2632
2633
2634# --- get the values of the fields and store them as HTML-parameters ---------
2635sub ExtractFieldsFromRecordset() # HTML CGI Recordset
2636{
2637
2638   my $cKey;
2639   my $cField;
2640
2641   foreach $cKey (keys %hFormDataMGL)
2642   {
2643
2644      if ($cKey =~ /^Fld(.*)/ )
2645      {
2646
2647         # get fieldname
2648         $cField = $1;
2649         &MyParam($cKey, &MyParam($cField))
2650             if $cField;
2651
2652      } # ($cKey =~ /^Fld(.*)/
2653   } # foreach $cKey (keys %hFormDataMGL)
2654
2655}
2656
2657
2658# --- get the HTML-parameters and store them as fields for te recordset ------
2659sub CreateFieldsForRecordset() # HTML CGI Recordset
2660{
2661
2662   my $cKey;
2663   my $cField;
2664
2665   foreach $cKey (keys %hFormDataMGL)
2666   {
2667
2668      if ($cKey =~ "^Fld(.*)")
2669      {
2670
2671         # get fieldnames
2672         $cField = $1;
2673         &MyParam("$cField", (&MyParam($cKey)?
2674                              &MyParam($cKey):
2675                              ""));
2676
2677      } # if ($cKey =~ "Fld.*" and &MyParam($cKey) ne "") {
2678   } # foreach $cKey (keys %hFormDataMGL)
2679
2680}
2681
2682
2683# --- insert a new record ----------------------------------------------------
2684sub NewRecord() # Db
2685{
2686   &InitDBIxRecordset();
2687
2688   # create recordset
2689   *pDataSetMGL = DBIx::Recordset->Setup(\%hFormDataMGL);
2690
2691   # Get the type-info for the fields
2692   &GetAllFieldInfo(&MyVal('Data', 'Table'), $pDataSetMGL);
2693
2694   &ConvertDataForDb("Form2Db");
2695
2696   # Insert Record here
2697   &CreateFieldsForRecordset();
2698
2699   $pDataSetMGL->Insert(\%hFormDataMGL);
2700
2701   # catch DB-error
2702   &DbiErrorAndExit(i18n("record-insertion"));
2703
2704}
2705
2706
2707# --- delete record -------------------------------------------------------
2708sub DelRecord() # Db
2709{
2710   my @lKeyFields     = split /, /, &GetAttr("RecIdField");
2711   my %hKeysForDelete = ();
2712
2713   &CreateFieldsForRecordset();
2714
2715   # here something went wrong
2716   if (!&GetAttr("RecId"))
2717   {
2718      die(i18n("internal error -> Record-ID missing!!"));
2719   }
2720
2721   &InitDBIxRecordset();
2722
2723   # scan multiple primary-keys
2724   foreach (@lKeyFields)
2725   {
2726      $hKeysForDelete{$_} = &GetField($_);
2727   }
2728
2729   # create Recordset
2730   *pDataSetMGL = DBIx::Recordset->Setup(\%hFormDataMGL);
2731
2732   $pDataSetMGL->Delete(\%hKeysForDelete);
2733
2734   # catch DB-error
2735   &DbiErrorAndExit(i18n("record-deletion"));
2736
2737
2738}
2739
2740
2741
2742
2743# --- update a record ------------------------------------------------------
2744sub UpdRecord() # Db
2745{
2746   my @lKeyFields     = split /, /, &GetAttr("RecIdField");
2747   my %hKeysForUpdate = ();
2748
2749   # scan multiple primary-keys
2750   foreach (@lKeyFields)
2751   {
2752      $hKeysForUpdate{$_} = &GetField($_);
2753   }
2754
2755   &InitDBIxRecordset();
2756
2757   # create recordset
2758   *pDataSetMGL = DBIx::Recordset->Setup(\%hFormDataMGL);
2759
2760   # Get the type-info for the fields
2761   &GetAllFieldInfo(&MyVal('Data', 'Table'), $pDataSetMGL);
2762
2763   &ConvertDataForDb("Form2Db");
2764
2765   # here something went wrong
2766   if (!&GetAttr("RecId"))
2767   {
2768      die(i18n("internal error -> Record-ID missing!!"));
2769   }
2770
2771   # Update Recordset here
2772   &CreateFieldsForRecordset();
2773
2774   $pDataSetMGL->Update
2775       (\%hFormDataMGL,
2776        \%hKeysForUpdate);
2777
2778   # catch DB-error
2779   &DbiErrorAndExit(i18n("record-update"));
2780
2781
2782}
2783
2784
2785
2786
2787# --- read one single record------------------------------------------------
2788sub FetchRecord() # Db CGI
2789{
2790
2791   my $pRecord;
2792   my $plNames;
2793   my $cName;
2794   my @lKeyFields     = split /, /, &GetAttr("RecIdField");
2795   my %hKeysForSelect = ();
2796
2797   # something went wrong
2798   if (!&GetAttr("RecId"))
2799   {
2800      die(i18n("internal error -> Record-ID missing!!"));
2801      &MyExit();
2802   }
2803
2804   # get all fields for the selection
2805   &MyParam("!Fields", (&GetAttr("RecIdField") . ", " .&MyVal('Data', 'UpdFields')));
2806
2807   # scan multiple primary-keys
2808   foreach (@lKeyFields)
2809   {
2810      $hKeysForSelect{$_} = &GetField($_);
2811   }
2812
2813   &InitDBIxRecordset();
2814
2815   # create recordset
2816   *pDataSetMGL = DBIx::Recordset->Setup(\%hFormDataMGL);
2817
2818   # Record-Id=Value
2819   $pDataSetMGL->Select(\%hKeysForSelect);
2820
2821   # catch DB-error
2822   &DbiErrorAndExit(i18n("record-re-select"));
2823
2824   # Get the type-info for the fields
2825   &GetAllFieldInfo(&MyVal('Data', 'Table'), $pDataSetMGL);
2826
2827
2828   $plNames = $pDataSetMGL->Names;
2829   $pRecord = $pDataSetMGL[0];
2830
2831   # distribute the found fields in HTML-form
2832   foreach $cName (@$plNames)
2833   {
2834      # &MyParam("Fld" . lc($cName), $$pRecord{lc($cName)});
2835      &MyParam("Fld" . $cName, $$pRecord{$cName});
2836   }
2837
2838   # make data ready for interaction with user
2839   &ConvertDataForDb("Db2Form");
2840
2841
2842} # sub Fetch Record
2843
2844
2845
2846# --- get info about field-types etc ----------------------------------------
2847sub GetAllFieldInfo ($$) # Db
2848{
2849   my $cTablePI      = shift; # not needed at the moment
2850   my $hFldInfoSetPI = shift;
2851
2852   my $cType;
2853   my $hDB;
2854   my $hStmt;
2855   my $iInd;
2856   my $plTypes;
2857   my %hTypeNames;
2858   my @lLen;
2859   my $plNames;
2860
2861   $hDB = $hFldInfoSetPI->DBHdl();
2862
2863   $plNames   = $hFldInfoSetPI->AllNames();
2864   $plTypes   = $hFldInfoSetPI->AllTypes();
2865
2866   foreach $iInd (0 .. $#{$plNames})
2867   {
2868      my $cFieldName = $plNames->[$iInd];
2869      my $iFieldType = $plTypes->[$iInd];
2870
2871      # some drivers use their own db-specific type-coding
2872      $iFieldType = &DbSession::MapDatatype($iFieldType)
2873          unless defined &DbSession::NameOfType($iFieldType);
2874
2875      printf STDERR ("TypeInfo %s -> (%s,%s): T: <%s>\n",
2876                     $cFieldName,
2877                     $plTypes->[$iInd],
2878                     $iFieldType,
2879                     &DbSession::NameOfType($iFieldType))
2880          if &GetAttr("DebugLvl") > 0;
2881
2882      $hTableInfoMGL{$cFieldName}{"PRECISION"} = 0;
2883      $hTableInfoMGL{$cFieldName}{"TYPE"}      = $iFieldType;
2884      $hTableInfoMGL{$cFieldName}{"TYPE_NAME"} =
2885          &DbSession::NameOfType($iFieldType);
2886   }
2887}
2888
2889
2890
2891=head2 OkForm - Display a form similar to a popup-window
2892
2893=over 2
2894
2895=item B<DESCRIPTION>
2896
2897Generates a complete HTML-Form, to inform the user about an error,
2898a warning, an information or anything else.
2899
2900=item B<SYNOPSIS>
2901
2902OkForm($type, $text [, $btn])
2903
2904 type  - error, die, yes-no or blank ("")
2905 text  - The text, you want to display
2906 btn   - (Optional) The name, you want to give the Ok-button
2907
2908=item B<RETURN VALUE>
2909
2910None.
2911
2912=item B<EXAMPLE>
2913
2914 # The Record has not been found
2915 &OkForm("error", "Sorry, but the record couldn't be found!");
2916
2917=item B<SEE ALSO>
2918
2919Error
2920
2921=back
2922
2923=cut
2924
2925# --- show OK-Form ---------------------------------------------------------
2926sub OkForm ($$;$) # HTML
2927{
2928
2929   my ($cTypePI, $cTextPI, $cBtnPI) = @_;
2930
2931   my $cBtn         = $cBtnPI;
2932   my $cHeaderMsg;
2933   my $cText        = $cTextPI;
2934   my $cType        = lc($cTypePI);
2935   my $oHtmlTableApp;
2936
2937
2938   # error-messages get another header
2939   if ($cType eq "error")
2940   {
2941      $cHeaderMsg = i18n("Problem!!");
2942   }
2943   elsif ($cType eq "die")
2944   {
2945      $cHeaderMsg = i18n("Fatal Error!!");
2946   }
2947   elsif ($cType eq "yes-no")
2948   {
2949      # Here the User can manipulate form-data
2950      Plugin->new("PreCreateForm")->Call();
2951
2952      $cHeaderMsg = i18n("Confirmation");
2953   }
2954   else
2955   {
2956      # Here the User can manipulate form-data
2957      Plugin->new("PreCreateForm")->Call();
2958
2959      $cHeaderMsg = i18n("Information");
2960   }
2961
2962   # Application-Table
2963   {
2964       $oHtmlTableApp  = HTML::Table->new
2965           (BorderPar  => &MyVal('Layout Table', 'Border', '0'),
2966            BgColorPar => &MyUserVal('Layout Table',
2967                                     'BgColor',
2968                                     $cBgColorMGL),
2969            WidthPar   => "100%",
2970            HeightPar  => "100%");
2971
2972       # The text of the message
2973       $oHtmlTableApp->Element(0, 0, 0, p($cText));
2974
2975       # create the buttons
2976       if ($cType eq "yes-no")
2977       {
2978           $oHtmlTableApp->Element
2979               (1, 0, 0,
2980                &SubmitButton("BtnYes",
2981                             &EncodeHtml(i18n("Yes"))),
2982                &SubmitButton("BtnNo" ,
2983                             &EncodeHtml(i18n("No"))));
2984       }
2985       else
2986       {
2987           $oHtmlTableApp->Element
2988               (1, 0, 0,
2989                &SubmitButton((defined($cBtnPI)? $cBtnPI: "BtnOk"),
2990                             &EncodeHtml(i18n("OK"))))
2991                   if $cBtnPI ne "-";
2992       }
2993
2994       # center all lines
2995       foreach (0..1)
2996       {
2997       $oHtmlTableApp->Element($_)->setAlignPar("Center")
2998           if defined $oHtmlTableApp->Element($_);
2999       }
3000   }
3001
3002   # all hidden fields
3003   $oHtmlTableApp->Element(HTML::Table::APPEND, 0, 0,
3004                           &GenPageHidden());
3005
3006   if ($cType eq "die")
3007   {
3008      &InitHTMLForm();
3009
3010      my $oTemplate = HTML::Template->new
3011          (filename => (&GetAttr("BaseDir") .
3012                        &MyVal('WWWdb', "Template",
3013                               "/lib/WWWdb/Templ/Tmpl_WWWdb.html")),
3014           die_on_bad_params => 0,
3015           debug => 1);
3016
3017      $oTemplate->param('APPL' => $oHtmlTableApp->HtmlCode());
3018      $oTemplate->param('HIER_FORM' => &HierarchyForm());
3019
3020      $oFormMGL->Element(0, &ScanDoc($oTemplate->output));
3021
3022   }
3023   else
3024   {
3025      &GenHtmlForm(undef, $oHtmlTableApp->HtmlCode(), undef);
3026
3027   }
3028
3029} # sub OkForm
3030
3031sub InitHTMLForm()
3032{
3033    my %hFormParam  = ();
3034
3035
3036    # set the params for the form
3037    $hFormParam{"ExpireHeadPar"}  = ($iCacheTimeoutMGL?
3038                                     "+" . $iCacheTimeoutMGL . "s":
3039                                     "now");
3040
3041    $hFormParam{"MetaHtmlPar"}    = {"keywords" => "WWWdb", # FIXME: meta-keywords
3042                                  };
3043    $hFormParam{"AuthorHtmlPar"}  = &UnTaint($ENV{"SERVER_ADMIN"});
3044    $hFormParam{"TitleHtmlPar"}   = (i18n(&MyVal
3045                                          ("Header",
3046                                           "Title",
3047                                           "WWWdb")));
3048    $hFormParam{"BackgroundHtmlPar"} = ("/" .
3049                                        &GetAttr("ScriptName") .
3050                                        "/lib/".
3051                                        $cBgImageMGL)
3052    if $cBgImageMGL;
3053    $hFormParam{"BgColorHtmlPar"}    = $cBgColorMGL
3054    if $cBgColorMGL;
3055
3056    foreach ("Link", "ALink", "VLink")
3057    {
3058       my $cValue = &MyVal('GUI', "$_" . "Color", undef);
3059
3060       $hFormParam{$_ . "HtmlPar"}    = $cValue
3061           if defined $cValue;
3062    }
3063
3064    $hFormParam{"ActionFormPar"}     =
3065        &CreateReference(&GetAttr("SessionId"),
3066                         (&GetAttr("ConfigFile")));
3067
3068    $oFormMGL = HTML::Form->new(%hFormParam);
3069
3070    return;
3071
3072}
3073
3074# --- Generate the HTML-code using some templates ---------------------------
3075sub GenHtmlForm ($$$) # HTML (ConfigFile)
3076{
3077    my $cTableHeaderPI = shift;
3078    my $cApplPI        = shift;
3079    my $cTableFooterPI = shift;
3080
3081    my %hTemplParam = ();
3082
3083    # HTML::Template supports only lowercase variables,
3084    # so we have to convert the standard_templates
3085    my %hPluginMap = ("formheader"      => "FormHeader",
3086                      "formfooter"      => "FormFooter",
3087                      "firstcolumn"     => "FirstColumn",
3088                      "preformheader"   => "PreFormHeader",
3089                      "preformfooter"   => "PreFormFooter",
3090                      "prefirstcolumn"  => "PreFirstColumn",
3091                      "postformheader"  => "PostFormHeader",
3092                      "postformfooter"  => "PostFormFooter",
3093                      "postfirstcolumn" => "PostFirstColumn",);
3094
3095    &InitHTMLForm();
3096
3097    my $oTemplate = HTML::Template->new
3098        (filename => (&GetAttr("BaseDir") .
3099                      &MyVal('WWWdb', "Template",
3100                             "/lib/WWWdb/Templ/Tmpl_WWWdb.html")),
3101         die_on_bad_params => 0,
3102         debug => &GetAttr("DebugLvl") + 100);
3103
3104    if ($oTemplate->query(name => 'APPL'))
3105    {
3106       $hTemplParam{'APPL'} = $cApplPI;
3107
3108    }
3109
3110    printf STDERR "HDR: $cTableHeaderPI\n";
3111    printf STDERR "FTR: $cTableFooterPI\n";
3112    $hTemplParam{'TABLE_HEADER'} = "TableHeader";
3113    $hTemplParam{'TABLE_FOOTER'} = "TableFooter";
3114
3115    if ($oTemplate->query(name => 'TABLE_HEADER'))
3116    {
3117       $hTemplParam{'TABLE_HEADER'} = $cTableHeaderPI;
3118    }
3119
3120    if ($oTemplate->query(name => 'TABLE_FOOTER'))
3121    {
3122       $hTemplParam{'TABLE_FOOTER'} = $cTableFooterPI;
3123    }
3124
3125    if ($oTemplate->query(name => 'PATH_FORM'))
3126    {
3127       $hTemplParam{'PATH_FORM'} = &PathForm(" ", " > ", " ");
3128
3129    }
3130
3131    if ($oTemplate->query(name => 'SUBCAT_FORM'))
3132    {
3133       $hTemplParam{'SUBCAT_FORM'} = &SubCategoriesForm();
3134
3135    }
3136
3137    if ($oTemplate->query(name => 'HIER_FORM'))
3138    {
3139       $hTemplParam{'HIER_FORM'} = &HierarchyForm();
3140
3141    }
3142
3143    if ($oTemplate->query(name => 'LOGIN_FORM'))
3144    {
3145       $hTemplParam{'LOGIN_FORM'} = &LoginForm();
3146
3147    }
3148
3149    if ($oTemplate->query(name => 'SEARCH_FORM'))
3150    {
3151       $hTemplParam{'SEARCH_FORM'} = &SearchForm();
3152
3153    }
3154
3155    if ($oTemplate->query(name => 'LANG_FORM'))
3156    {
3157       $hTemplParam{'LANG_FORM'} = &LangForm();
3158
3159    }
3160
3161    # find program parameters and fill them in
3162    my @lParams = $oTemplate->param();
3163    for my $cParam (@lParams)
3164    {
3165       if ($cParam =~ /^__plugin_(.*)__$/)
3166       {
3167          my $cPluginName = (defined $hPluginMap{$1}?
3168                             $hPluginMap{$1}:
3169                             $1);
3170
3171          $hTemplParam{$cParam} =
3172              (Plugin->new("$cPluginName",
3173                           "HasPrePost" => 0,
3174                           "HasMy"      => 1)->Call());
3175       }
3176    }
3177
3178    # fill in some parameters
3179    $oTemplate->param(\%hTemplParam);
3180
3181    # Resolve WWWdb-links
3182    $oFormMGL->Element(0, &ScanDoc($oTemplate->output));
3183
3184    print STDERR Dumper($oFormMGL)
3185        if &GetAttr("DebugLvl") > 3;
3186
3187
3188}
3189
3190
3191
3192# --- generate a page with all entry-fields hidden -------------------------
3193sub GenPageHidden () # HTML ConfigFile CGI
3194{
3195   my $cResult = "";
3196
3197   foreach (keys %hFormDataMGL)
3198   {
3199      if (/^Fld[^_].*$/)
3200      {
3201         $cResult .= hidden(-name  => $_,
3202                            -value => &EncodeHtml(&MyParam($_))) . "\n";
3203      }
3204   }
3205
3206#     foreach $cField (split ", ", &MyVal("Data", "UpdFields"))
3207#     {
3208#         $cResult .= hidden(-name  => "Fld" . $cField,
3209#             -value => &EncodeHtml(&MyParam("Fld" .
3210#                            $cField))) .
3211#                                "\n";
3212#     }
3213
3214   return $cResult;           # FIXME: Why does this return results in wrong data?
3215} # sub GenPageHidden
3216
3217
3218# --- generate the HTML-page for entering all the data ---------------------
3219sub GenPage () # HTML (ConfigFile CGI)
3220{
3221   my $iInd;
3222   my $cHeaderText;
3223   my $iMaxCol;
3224   my $oHtmlTableApp;
3225   my $oErrTextCol = undef;
3226   my @lColsWithFullWidth = ();
3227
3228
3229   # Here the User can manipulate form-data
3230   Plugin->new("PreCreateForm")->Call();
3231
3232   if(&MyParam("WWWdbState") eq "Init")
3233   {
3234      $cHeaderText = &MyVal("State Init", "Header",
3235                            i18n("Search-criteria / insert data"));
3236   }
3237   elsif(&MyParam("WWWdbState") eq "Work")
3238   {
3239      $cHeaderText = &MyVal("State Work", "Header",
3240                            i18n("Work on this record"));
3241   }
3242   elsif(&MyParam("WWWdbState") eq "Qry")
3243   {
3244      $cHeaderText = &MyVal("State Qry", "Header",
3245                            i18n("Browse or select data"));
3246   }
3247
3248
3249   # show table -------------------------------------------------------
3250   {
3251       my $cField;
3252       my $cFieldType;
3253       my $cPos;
3254       my $cPosKey;
3255       my $iCol;
3256       my $iIndPosKey;
3257       my $iLine;
3258       my $iLineOffset;
3259       my $iMaxLine;
3260       my $iPosCol;
3261       my $iPosLine;
3262       my $iPosSequence;
3263       my $iColSpan;
3264       my $iRowSpan;
3265       my $iSequence;
3266       my %hFieldInfo;
3267       my @lcFields;
3268       my @lcPosKey;
3269       my $cTableBackground;
3270
3271       # read all fields of the configuration-file and calculate their
3272       # positions in the HTML-table
3273       {
3274
3275           my $cSection;
3276           my $cParam;
3277           my $cValue;
3278           my $cCurrPos;
3279
3280           $cCurrPos = "000.000.000.000";
3281
3282           # scan all sections
3283           foreach $cSection ($oConfPoolGL->getSectionNames())
3284           {
3285
3286               # scan all parameters
3287               foreach $cParam ($oConfPoolGL->getEntryNames($cSection))
3288               {
3289                   if (($cSection   =~ /^Layout\s+(Label|Field)/) and
3290                       (lc($cParam) eq "pos"))
3291                   {
3292                       my $cField;
3293                       my $cFieldType;
3294                       my $cDummy;
3295
3296                       ($cDummy, $cFieldType, $cField) = split(" ", $cSection);
3297
3298                       # calculate position and insert in hash
3299                       &MakeNewPosEntry
3300                           ($cFieldType,
3301                            $cField,
3302                            $oConfPoolGL->getValue($cSection, $cParam),
3303                            $cCurrPos,
3304                            \%hFieldInfo);
3305
3306                       $cCurrPos = $hFieldInfo{"$cField.$cFieldType"}{"Pos"};
3307
3308                   }
3309               }
3310           }
3311       }
3312
3313       # Now we have a correct sequence of the fields ...
3314       @lcPosKey = sort keys %{$hFieldInfo{"Pos"}};
3315
3316       $iMaxLine  = 0;
3317       $iMaxCol   = 0;
3318
3319       # let's count the maximum lines and columns
3320       foreach $cPosKey (@lcPosKey)
3321       {
3322           ($iLine, $iCol) = split /\./, $cPosKey;
3323
3324           $iMaxLine = $iLine if ($iMaxLine < $iLine);
3325           $iMaxCol  = $iCol  if ($iMaxCol < $iCol);
3326       }
3327
3328       # Now we have to look for all fields in the table, which have
3329       # been "forgotten" in the config-file
3330
3331       {
3332           # We dont need no Record-ID
3333           # push @lcFields, split ", ", &MyVal('Data', 'IdField');
3334           push @lcFields, split ", ", &MyVal('Data', 'UpdFields');
3335           push @lcFields, split ", ", &MyVal('Data', 'ExtraFields');
3336
3337           # fill the array
3338           foreach $cField (@lcFields)
3339           {
3340               my $cFieldPos;
3341               my $iSequence;
3342               my $iWidth;
3343
3344               # is this field configured?
3345               $cFieldPos = &MyVal("Layout Field $cField", "Pos", "");
3346
3347               # NO!
3348               if(!$cFieldPos)
3349               {
3350
3351                   $iMaxLine ++;
3352
3353                   # Append the label in the first column at the last row
3354                   &MakeNewPosEntry("Label",
3355                                    $cField,
3356                                    "$iMaxLine.0.0",
3357                                    "$iMaxLine.0.0",
3358                                    \%hFieldInfo);
3359
3360                   # Append the field in the second column at the last row
3361                   &MakeNewPosEntry("Field",
3362                                    $cField,
3363                                    "$iMaxLine.1.0",
3364                                    "$iMaxLine.1.0",
3365                                    \%hFieldInfo);
3366
3367                   # Maybe we have to correct the max. column
3368                   $iMaxCol = 1 if $iMaxCol < 1;
3369               }
3370
3371           } # foreach $cFieldType ("Field", "Label")
3372
3373       } # foreach $cField ...
3374
3375
3376       # again we need the correct order of the fields ...
3377       @lcPosKey = sort keys %{$hFieldInfo{"Pos"}};
3378       $iIndPosKey = 0;
3379
3380       $cTableBackground = &MyVal('Layout Table', 'Background', "");
3381
3382       $cTableBackground = &GenImage($cTableBackground)
3383           if $cTableBackground;
3384
3385       $oHtmlTableApp  = HTML::Table->new
3386           (BorderPar     => &MyVal('Layout Table', 'Border', '0'),
3387            BackgroundPar => $cTableBackground,
3388            BgColorPar    => &MyUserVal('Layout Table',
3389                                        'BgColor',
3390                                        $cBgColorMGL),
3391            WidthPar      => "100%",
3392            HeightPar     => "100%");
3393
3394       $oHtmlTableApp->Element(HTML::Table::APPEND, 0, 0,
3395                               b(&EncodeHtml(i18n($cHeaderText))));
3396       $oHtmlTableApp->Element
3397           (HTML::Table::CURRENT, 0)->setAlignPar("Center");
3398
3399       # mark for enlarging later
3400       push @lColsWithFullWidth, $oHtmlTableApp->Element(0, 0);
3401
3402       # show standard error-text
3403       if (%hFieldErrorsMGL)
3404       {
3405           $oHtmlTableApp->Element
3406               (HTML::Table::APPEND, 0, 0,
3407                font({-color => 'Red',
3408                      -size => 3},
3409                     b(&EncodeHtml
3410                       (i18n("While checking your input-data some problems " .
3411                             "were detected and marked. <BR>" .
3412                             "Some explanation of the problems, you have " .
3413                             "to solve first is on the bottom of this page")))));
3414
3415           push (@lColsWithFullWidth,
3416                 $oHtmlTableApp->Element(HTML::Table::CURRENT, 0));
3417       }
3418
3419       # Now we are ready to construct the table!!!
3420       $iLineOffset = $oHtmlTableApp->getMaxRow() - 1;
3421
3422       foreach (@lcPosKey)
3423       {
3424           my $cCellType;
3425
3426           ($cField, $cCellType) =
3427               split /\./, $hFieldInfo{"Pos"}{$_};
3428
3429           # splits $_ and converts to integer
3430           ($iPosLine, $iPosCol, $iPosSequence, $iRowSpan, $iColSpan) =
3431               map {int($_)} split /\./, $_;
3432
3433           # make a new column-object
3434           {
3435               my $cConfKey;
3436               my $oColumn;
3437               my $cBackground;
3438               my %hAttribs = ();
3439
3440               $cConfKey = "Layout $cCellType $cField";
3441
3442
3443               $cBackground = &MyVal($cConfKey, 'Background', "");
3444
3445               $cBackground = &GenImage($cBackground)
3446                   if $cBackground;
3447
3448               $hAttribs{"BackgroundPar"} = $cBackground
3449                   if $cBackground;
3450
3451               $hAttribs{"BgColorPar"} = &MyVal($cConfKey, "BgColor", $cBgColorMGL)
3452                   if &MyVal($cConfKey, "BgColor", $cBgColorMGL);
3453               $hAttribs{"AlignPar"} = &MyVal($cConfKey, "Align", "")
3454                   if &MyVal($cConfKey, "Align", "");
3455               $hAttribs{"ValignPar"} = &MyVal($cConfKey, "VAlign", "")
3456                   if &MyVal($cConfKey, "VAlign", "");
3457               $hAttribs{"NowrapPar"} = "NOWRAP"
3458                   if &MyVal($cConfKey, "NoWrap", "");
3459
3460               $oColumn = HTML::TableCol->new(%hAttribs);
3461
3462               $oHtmlTableApp->Element($iPosLine + $iLineOffset,
3463                                       $iPosCol,
3464                                       $oColumn);
3465           }
3466
3467
3468           $oHtmlTableApp->Element($iPosLine + $iLineOffset,
3469                                   $iPosCol,
3470                                   $iPosSequence,
3471                                   &GenField($cCellType,
3472                                             $cField,
3473                                             &MyParam("Fld$cField")));
3474
3475           $oHtmlTableApp->Element
3476               ($iPosLine + $iLineOffset, $iPosCol)->setColspanPar($iColSpan)
3477                   if $iColSpan > 1;
3478           $oHtmlTableApp->Element
3479               ($iPosLine + $iLineOffset, $iPosCol)->setRowspanPar($iRowSpan)
3480                   if $iRowSpan > 1;
3481       }
3482   }
3483
3484   $oHtmlTableApp->Element (HTML::Table::APPEND, 0, 0, "");
3485
3486   $iInd = 0;
3487   # scan multiple primary-keys
3488
3489   # With multiline-fields this makes problems, because some fields
3490   # are defined twice and appear like a array (here for example
3491   # all id_fields)
3492#   foreach (split /, /, &GetAttr("RecIdField"))
3493#   {
3494#      $oHtmlTableApp->Element
3495#       (HTML::Table::CURRENT,
3496#        0,
3497#        $iInd ++,
3498#        hidden(-name      => "Fld" . $_,
3499#               -value     => (&EncodeHtml
3500#                              (&MyParam("Fld" . $_)))));
3501#
3502#   }
3503
3504   # Did an error occur?
3505   if (%hFieldErrorsMGL)
3506   {
3507      my $cField;
3508      my $cResult = "";
3509
3510      $cResult .=
3511      font({-color => 'Red',
3512        -size => 3},
3513           b(&EncodeHtml
3514         (i18n("This is a list of the problems appeared:<BR>"))));
3515
3516      foreach $cField (keys %hFieldErrorsMGL) {
3517      $cResult .=
3518          font({-color => 'Red',
3519            -size => 2},
3520           li(b(&EncodeHtml("$hFieldErrorsMGL{$cField}<BR>"))));
3521
3522      }
3523
3524      $oHtmlTableApp->Element(HTML::Table::APPEND, 0, 0, $cResult);
3525
3526      push (@lColsWithFullWidth,
3527            $oHtmlTableApp->Element(HTML::Table::CURRENT, 0));
3528   }
3529
3530
3531   $oHtmlTableApp->Element(HTML::Table::APPEND, 0, 0,
3532                           &FormButtons());
3533   push (@lColsWithFullWidth,
3534         $oHtmlTableApp->Element(HTML::Table::CURRENT, 0));
3535
3536   foreach (@lColsWithFullWidth)
3537   {
3538       $_->setColspanPar($oHtmlTableApp->getMaxCol());
3539   }
3540
3541   &GenHtmlForm(undef, $oHtmlTableApp->HtmlCode(), undef);
3542
3543} # sub GenPage
3544
3545
3546sub GenField($$$) # HTML (ConfigFile)
3547{
3548   my $cCellTypePI = shift;
3549   my $cFieldPI    = shift;
3550   my $cValuePI    = shift;
3551
3552   my $cFieldType;
3553   my $cConfKey;
3554   my $cAttr;
3555   my $cResult = "";
3556   my @lValues;
3557   my @lAttr = ("H1=H1",
3558                "H2=H2",
3559                "H3=H3",
3560                "H4=H4",
3561                "H5=H5",
3562                "H6=H6",
3563
3564                "Cite=CITE",
3565                "Code=CODE",
3566                "Del=DEL",
3567                "Em=EM",
3568                "Ins=INS",
3569                "Pre=PRE",
3570                "Strong=STRONG",
3571                "TT=TT",
3572
3573                "Big=BIG",
3574                "Blink=BLINK",
3575                "Bold=B",
3576                "Italic=I",
3577                "NoBr=NOBR",
3578                "Small=SMALL",
3579                "Strike=STRIKE",
3580                "Sub=SUB",
3581                "Sup=SUP",
3582                );
3583
3584   my $oPlugErrLabel =
3585       Plugin->new("ErrLabel",
3586                   "HasPrePost" => 1,
3587                   "HasMy"      => 1);
3588
3589   @lValues = split /\\,/, $cValuePI;
3590
3591   $cConfKey = "Layout $cCellTypePI $cFieldPI";
3592
3593   $cFieldType = &MyVal($cConfKey, "Type",
3594                        ($cCellTypePI eq "Qry"?
3595                         "Label":
3596                         "Text"));
3597
3598
3599   # if the field is an id-field, it must be read-only
3600   if(&MyParam("WWWdbState") eq "Work")
3601   {
3602      foreach (split /, /, &GetAttr("RecIdField"))
3603      {
3604         if ($_ eq $cFieldPI)
3605         {
3606            $cFieldType = "Label"
3607                if $cFieldType ne "Hidden";
3608
3609            last;
3610         }
3611      }
3612   }
3613
3614
3615   if ($cCellTypePI eq "Qry")
3616   {
3617      $cResult .= "<SMALL>";
3618
3619      $cFieldPI = "_" .  $cFieldPI;
3620
3621   }
3622
3623   # switch on attributes
3624   foreach $cAttr (@lAttr)
3625   {
3626       my $cConfAttr;
3627       my $cHtmlAttr;
3628
3629       ($cConfAttr, $cHtmlAttr) =  split /=/, $cAttr;
3630
3631       # Attribute defined? Generate it!
3632       if(&MyVal($cConfKey, $cConfAttr, ""))
3633       {
3634           $cResult .= ("<$cHtmlAttr>");
3635       }
3636   }
3637
3638
3639   # Font-Attribute
3640   if(&MyVal($cConfKey, "Font", ""))
3641   {
3642       $cResult .= ("<FONT " .
3643                    &MyVal($cConfKey, "Font", "") .
3644                    ">");
3645   }
3646
3647   if($cCellTypePI eq "Label")
3648   {
3649       my $cText;
3650       my $cRef = &MyVal($cConfKey, "Ref");
3651       my $cImg = &MyVal($cConfKey, "Image");
3652
3653       if($cRef)
3654       {
3655           $cText = &ResolveRefField($cRef,
3656                                     i18n(&MyVal($cConfKey, "Text", $cRef)));
3657       }
3658       else
3659       {
3660           $cText = i18n(&MyVal($cConfKey, "Text", $cFieldPI));
3661       }
3662
3663
3664       if($cImg)
3665       {
3666           $cText = GenImage($cImg,
3667                             $cText,
3668                             &MyVal($cConfKey, "ImgBorder"));
3669
3670
3671       }
3672       # Text of label
3673       $cResult .= &EncodeHtml($cText);
3674
3675   } # if($cCellTypePI eq "Label")
3676   else
3677   {
3678       $cResult .= &EncodeHtml($oPlugErrLabel->Call("Fld$cFieldPI"));
3679
3680       if($cFieldType eq "HTML")
3681       {
3682
3683           # include a HTML-Page
3684           if(-r &MyVal($cConfKey, "File"))
3685           {
3686               $cResult .= &InsertHtmlPage(&MyVal($cConfKey, "File"));
3687           }
3688
3689       } # if($cCellTypePI eq "HTML")
3690       # Entry-Field for text
3691       elsif($cFieldType eq "Text")
3692       {
3693           $cResult .= (textfield (-name      => "Fld$cFieldPI",
3694                                   -maxlength => &MyVal($cConfKey,
3695                                                        "MaxLength",
3696                                                        "100"),
3697                                   -size      => &MyVal($cConfKey,
3698                                                        "Size",
3699                                                        "30"),
3700                                   -override  => 1,
3701                                   -value     => ($lValues[0]),
3702                                   &CommonInputAttr($cConfKey)));
3703
3704
3705       } # if($cFieldType eq "Text")
3706       # Password-field: input-data is not shown
3707       elsif($cFieldType eq "Password")
3708       {
3709           $cResult .= (password_field(-name      => "Fld$cFieldPI",
3710                                       -maxlength => &MyVal($cConfKey,
3711                                                            "MaxLength",
3712                                                            "100"),
3713                                       -size      => &MyVal($cConfKey,
3714                                                            "Size",
3715                                                            "30"),
3716                                       -value     => ($lValues[0]),
3717                                       -override  => 1,
3718                                       &CommonInputAttr($cConfKey)));
3719
3720
3721       } # if($cFieldType eq "Password")
3722       # enter data in more than one line
3723       elsif($cFieldType eq "Area")
3724       {
3725           $cResult .= (textarea(-name     => "Fld$cFieldPI",
3726                                 -rows     => &MyVal($cConfKey,
3727                                                     "Rows",
3728                                                     "4"),
3729                                 -columns  => &MyVal($cConfKey,
3730                                                     "Size",
3731                                                     "30"),
3732                                 -override => 1,
3733                                 -wrap     => &MyVal($cConfKey,
3734                                                     "Wrap",
3735                                                     "VIRTUAL"),
3736                                 -default  => ($lValues[0]),
3737                                 &CommonInputAttr($cConfKey)));
3738
3739
3740       } # if($cFieldType eq "Area")
3741       # enter data in more than one line
3742       elsif($cFieldType eq "File")
3743       {
3744           $cResult .= (filefield(-name      => "Fld$cFieldPI",
3745                                  -size      => &MyVal($cConfKey,
3746                                                       "Size",
3747                                                       "80"),
3748                                  -maxlength => &MyVal($cConfKey,
3749                                                       "MaxLength",
3750                                                       "128000"),
3751                                  -accept    => &MyVal($cConfKey,
3752                                                       "Accept",
3753                                                       "text/*"),
3754                                  -override  => 0,
3755                                  -default   => ($lValues[0]),
3756                                  &CommonInputAttr($cConfKey)));
3757
3758
3759       } # if($cFieldType eq "Area")
3760       elsif($cFieldType eq "Btn")
3761       {
3762           $cResult .= &SubmitButton("Btn$cFieldPI",
3763                                     &EncodeHtml(i18n(&MyVal($cConfKey,
3764                                                             "Label",
3765                                                             $cFieldPI))));
3766
3767       } # if($cFieldType eq "Btn")
3768       # Hidden field, which is not shown on the screen
3769       elsif($cFieldType eq "Hidden")
3770       {
3771           $cResult .= hidden(-name      => "Fld$cFieldPI",
3772                              -override  => 1,
3773                              -value     => ($lValues[0]));
3774
3775       } # if($cFieldType eq "Hidden")
3776       elsif($cFieldType eq "Label")
3777       {
3778           $cResult .= hidden(-name      => ("Fld" .
3779                                             $cFieldPI),
3780                              -override  => 1,
3781                              -value     => ($lValues[0]))
3782               unless $cCellTypePI eq "Qry";
3783
3784           $cResult .= (&MyVal($cConfKey, "SafeText", "")?
3785                        &EncodeHtml(($lValues[0])):
3786                        &SafeEncodeHtml(($lValues[0])));
3787
3788       } # if($cFieldType eq "Label")
3789       elsif($cFieldType eq "Ref")
3790       {
3791           $cResult .= &ResolveRefField($lValues[0],
3792                                        &MyVal($cConfKey, "Value", "->"));
3793
3794       } # if($cFieldType eq "Ref")
3795       elsif($cFieldType eq "RecordRef")
3796       {
3797           $cResult .= a({href =>
3798                              &CreateReference(&GetAttr("SessionId"),
3799                                               (&GetAttr("ConfigFile") .
3800                                                ";BtnSelect=" .
3801                                                $lValues[1]))},
3802                         &EncodeHtml(i18n($lValues[0])));
3803
3804       } # if($cFieldType eq "RecordRef")
3805       # Selection-List with more possible values
3806       elsif(($cFieldType eq "Select") or
3807             ($cFieldType eq "Radio"))
3808       {
3809           my %hLabels = undef;
3810           my @lListValues = undef;
3811
3812           if (0) # FIXME: kick out ....
3813           {
3814           my $cValLabel;
3815           my @lValLabel;
3816
3817           @lValLabel = &MyListVal($cConfKey, "Values", "");
3818
3819           # if this is a SQL-Statement, then execute it
3820           if ($lValLabel[0] =~ /^select/i)
3821           {
3822               my $pResult;
3823
3824               $pResult = $oDbTargetGL->SqlSelect
3825                   (i18n(join "\n", @lValLabel));
3826               # (i18n(join "\n", @lValLabel)); FIXME
3827
3828               @lValLabel = @{$pResult};
3829           }
3830           else
3831           {
3832               # splits the xxxx\\,yyy into [xxxx, yyyy]
3833               @lValLabel = map {[split /\\,/]} @lValLabel;
3834           }
3835
3836           # make an "undefined" label e.g. for searching
3837           unshift @lValLabel, ["", i18n("Undefined")]
3838               unless &MyVal($cConfKey, "NoUndef", ""),;
3839
3840           # Split the Value,Label list in two Arrays
3841           foreach $cValLabel (@lValLabel)
3842           {
3843               # $cValLabel = i18n($cValLabel);
3844
3845               # do we have a value and a label?
3846               if (ref $cValLabel)
3847               {
3848                   push @lListValues, $cValLabel->[0];
3849                   $hLabels{$cValLabel->[0]} = i18n($cValLabel->[1]);
3850               }
3851               else
3852               {
3853                   push @lListValues, $cValLabel;
3854                   $hLabels{$cValLabel} = i18n($cValLabel);
3855               }
3856           }
3857           }
3858
3859           my @lResult = &GetSelectboxValues($cFieldPI);
3860
3861           @lListValues = @{$lResult[0]};
3862           %hLabels     = %{$lResult[1]};
3863
3864           $hSelectCacheMGL{$cFieldPI} = \%hLabels;
3865
3866           if($cFieldType eq "Select")
3867           {
3868
3869               $cResult .= (scrolling_list(-multiple  => (&MyVal($cConfKey,
3870                                                                 "Multiple",
3871                                                                 "")? "true": "0"),
3872                                           -name      => "Fld$cFieldPI",
3873                                           -values    => \@lListValues,
3874                                           -labels    => \%hLabels,
3875                                           -override  => 1,
3876                                           -size      => &MyVal($cConfKey,
3877                                                                "Rows",
3878                                                                "1"),
3879                                           -default   => \@lValues,
3880                                           &CommonInputAttr($cConfKey)));
3881
3882           } #if($cFieldType eq "Select")
3883           # Selection with Radio-buttons
3884           elsif($cFieldType eq "Radio")
3885           {
3886               $cResult .= (radio_group(-name      => "Fld$cFieldPI",
3887                                        -values    => \@lListValues,
3888                                        -labels    => \%hLabels,
3889                                        -override  => 1,
3890                                        -default   => $lValues[0],
3891                                        &CommonInputAttr($cConfKey)));
3892
3893           } #if($cFieldType eq "Select")
3894       } # if($cFieldType eq "Select") or ($cFieldType eq "Radio"))
3895       # Check-Button
3896       elsif($cFieldType eq "Checkbutton")
3897       {
3898           $cResult .= (checkbox(-name      => "Fld$cFieldPI",
3899                                 -checked   => $lValues[0],
3900                                 -value     => i18n(&MyVal($cConfKey,
3901                                                           "Value",
3902                                                           "1")),
3903                                 -override  => 1,
3904                                 -label     => (&MyVal($cConfKey,
3905                                                       "Text",
3906                                                       i18n($cFieldPI))),
3907                                 &CommonInputAttr($cConfKey)));
3908
3909       } #if($cFieldType eq "Select")
3910   } # else ($cCellTypePI eq "Label")
3911
3912   # switch off Font-Attribute
3913   if(&MyVal($cConfKey, "Font", ""))
3914   {
3915       $cResult .= "</FONT>";
3916   }
3917
3918   # switch off Attributes
3919   foreach $cAttr (reverse @lAttr)
3920   {
3921       my $cConfAttr;
3922       my $cHtmlAttr;
3923
3924       ($cConfAttr, $cHtmlAttr) =  split /=/, $cAttr;
3925
3926       if(&MyVal($cConfKey, $cConfAttr, ""))
3927       {
3928           $cResult .= "</$cHtmlAttr>";
3929       }
3930
3931   }
3932
3933
3934   $cResult .= "</SMALL>"
3935       if $cCellTypePI eq "Qry";
3936
3937   return $cResult;
3938
3939}
3940
3941
3942sub GetSelectboxValues($)
3943{
3944    my $cFieldNamePI = shift;
3945
3946    my $cConfKey = "Layout Field $cFieldNamePI";
3947    my $cValLabel;
3948    my %hLabels = ();
3949    my @lValLabel;
3950    my @lListValues = ();
3951    my @lResult     = ();
3952
3953    @lValLabel = &MyListVal($cConfKey, "Values", "");
3954
3955    # if this is a SQL-Statement, then execute it
3956    if ($lValLabel[0] =~ /^select/i)
3957    {
3958        my $pResult;
3959
3960        $pResult = $oDbTargetGL->SqlSelect
3961            (i18n(join "\n", @lValLabel));
3962        # (i18n(join "\n", @lValLabel)); FIXME
3963
3964        @lValLabel = @{$pResult};
3965    }
3966    else
3967    {
3968        # splits the xxxx\\,yyy into [xxxx, yyyy]
3969        @lValLabel = map {[split /\\,/]} @lValLabel;
3970    }
3971
3972    # make an "undefined" label e.g. for searching
3973    unshift @lValLabel, ["", i18n("Undefined")]
3974        unless &MyVal($cConfKey, "NoUndef", ""),;
3975
3976    # Split the Value,Label list in two Arrays
3977    foreach $cValLabel (@lValLabel)
3978    {
3979        # $cValLabel = i18n($cValLabel);
3980
3981        # do we have a value and a label?
3982        if (ref $cValLabel)
3983        {
3984            push @lListValues, $cValLabel->[0];
3985            $hLabels{$cValLabel->[0]} = i18n($cValLabel->[1]);
3986        }
3987        else
3988        {
3989            push @lListValues, $cValLabel;
3990            $hLabels{$cValLabel} = i18n($cValLabel);
3991        }
3992    }
3993
3994    push @lResult, \@lListValues;
3995    push @lResult, \%hLabels;
3996
3997    return @lResult;
3998}
3999
4000
4001# --- set some common attributes for input-fields --------------------------
4002sub CommonInputAttr ($) # HTML
4003{
4004    my $cConfKeyPI = shift;
4005
4006    my $cResult;
4007
4008    $cResult = ((&MyVal($cConfKeyPI, "Disabled", "")?
4009                 " DISABLED ":
4010                 "") .
4011                (&MyVal($cConfKeyPI, "Readonly", "")?
4012                 " READONLY ":
4013                 "") .
4014                (&MyVal($cConfKeyPI, "Tabindex", "")?
4015                 " TABINDEX=".&MyVal($cConfKeyPI, "Tabindex", "0"):
4016                 "") .
4017                (&MyVal($cConfKeyPI, "Help", "")?
4018                 " TITLE=\"".i18n(&MyVal($cConfKeyPI, "Help", ""))."\"":
4019                 ""));
4020
4021    return $cResult;
4022
4023} # sub CommonInputAttr
4024
4025# --- calculate a offset for positioninf of columns ------------------------
4026sub CalcOffset ($$) # Tool
4027{
4028    my ($iValuePI, $iOffsetPI) = @_;
4029
4030    my $iResult = $iOffsetPI;
4031
4032    # Handle the form +nnn
4033    if ($iOffsetPI =~ /\+(\d+)/)
4034    {
4035        $iResult = $iValuePI + $1;
4036    }
4037
4038    return $iResult;
4039} # sub CalcOffset
4040
4041
4042# --- create a new position-entry for the table-definitions ----------------
4043sub MakeNewPosEntry ($$$$\%) # Tool
4044{
4045   my ($cFieldTypePI,
4046       $cFieldPI,
4047       $cFieldPosPI,
4048       $cCurrFieldPosPI,
4049       $hFieldInfoPIO) = @_;
4050
4051   my $cNewPos;
4052   my $iCol;
4053   my $iLine;
4054   my $iSequence;
4055   my $iCurrCol;
4056   my $iCurrLine;
4057   my $iCurrSequence;
4058   my $iLineSpan;
4059   my $iColSpan;
4060
4061   printf STDERR "MakeNewPosEntry: FieldTypePI, $cFieldPI, $cFieldPosPI\n"
4062       if &GetAttr("DebugLvl") > 2;
4063
4064   ($iLine, $iCol, $iSequence) = split /\./, $cFieldPosPI;
4065   ($iCurrLine, $iCurrCol, $iCurrSequence) = split /\./, $cCurrFieldPosPI;
4066
4067
4068
4069   # +xx-yy: from column xx span yy columns
4070   if($iLine =~ /(\+?\d+)\+(\d+)/)
4071   {
4072      $iLine  = &CalcOffset($iCurrLine, $1);
4073
4074      # of course the actual line must be included!
4075      $iLineSpan = $2 + 1;
4076
4077   }
4078   else
4079   {
4080      $iLine  = &CalcOffset($iCurrLine, $iLine);
4081      $iLineSpan = 1;
4082   }
4083
4084   # when starting on a new line, columns must start at zero
4085   if($iCurrLine < $iLine) {
4086      $iCurrCol      = 0;
4087      $iCurrSequence = 0;
4088   }
4089   # when starting on a new column sequences must start at zero
4090   if($iCurrCol < $iCol) {
4091      $iCurrSequence = 0;
4092   }
4093
4094
4095   # +xx-yy: from column xx span yy columns
4096   if($iCol =~ /(\+?\d+)\+(\d+)/)
4097   {
4098      $iCol  = &CalcOffset($iCurrCol, $1);
4099
4100      # of course the actual column must be included!
4101      $iColSpan = $2 + 1;
4102
4103   }
4104   else
4105   {
4106      $iCol  = &CalcOffset($iCurrCol, $iCol);
4107      $iColSpan = 1;
4108   }
4109
4110   # when starting on a new column sequences must start at zero
4111   if($iCurrCol < $iCol) {
4112      $iCurrSequence = 0;
4113   }
4114
4115   $iSequence = &CalcOffset($iCurrSequence, $iSequence);
4116
4117   $cNewPos = sprintf("%03d.%03d.%03d.%03d.%03d",
4118                      $iLine,
4119                      $iCol,
4120                      $iSequence,
4121                      $iLineSpan,
4122                      $iColSpan);
4123
4124   printf STDERR "MakeNewPosEntry: $cNewPos\n"
4125       if &GetAttr("DebugLvl") > 2;
4126
4127   $$hFieldInfoPIO{"$cFieldPI.$cFieldTypePI"}{'Pos'} = $cNewPos;
4128
4129   # create data in hash for sort by position
4130   $$hFieldInfoPIO{'Pos'}{$cNewPos} = "$cFieldPI.$cFieldTypePI";
4131
4132   printf STDERR "$cFieldPI.$cFieldTypePI = $cNewPos<BR>\n"
4133       if &GetAttr("DebugLvl") > 2;
4134
4135   return $cNewPos;
4136} # sub MakeNewPosEntry
4137
4138
4139# --- Generate the form-header ---------------------------------------------
4140sub TableHeader($) # Plugin
4141{
4142   my $cTitlePI = shift;
4143
4144   my $cResult = "";
4145
4146   $cTitlePI = "&nbsp;"
4147       if !$cTitlePI;
4148
4149   $cResult .=
4150       table({-WIDTH   => "100%",
4151              -BORDER  => 0},
4152             (TR(td(p({-ALIGN => "LEFT"},
4153                      h4((&EncodeHtml
4154                          (i18n(&MyVal("Header", "Title"))))))),
4155                 td(p({-ALIGN => "RIGHT"},
4156                      h4(&EncodeHtml(i18n($cTitlePI))))),
4157                 )));
4158
4159   $cResult .= hr({-noshade => 1,
4160                   -size => 1});
4161
4162   return $cResult;
4163
4164}
4165
4166
4167# --- Generate the form-footer ---------------------------------------------
4168sub TableFooter($) # Plugin
4169{
4170   my $cTitlePI = shift;
4171
4172   my $cResult = "";
4173
4174
4175   # generated by CVS
4176   my $cRevision = (($iDevelopmentVersionMGL?
4177                     i18n("Develop-"): "") .
4178                    'Version: ' .
4179                    $VERSION .
4180                    ', $Date: 2003/04/16 11:25:21 $ ');
4181
4182   # make version-info looking nicer
4183   $cRevision =~ s/ ?\$ ?//g;
4184   $cRevision =~ s/Revision:/i18n("Version:")/e;
4185   $cRevision =~ s/Date:/&i18n(" Date:")/e;
4186   # remove the time
4187   $cRevision =~ s/ (\d\d:){2}\d\d//;
4188
4189   $cResult .= (hr({-noshade => 1,
4190                    -size => 1}) .
4191                p({-ALIGN => "CENTER"},
4192                  small("($cRevision)")));
4193
4194   return $cResult;
4195}
4196
4197
4198sub FormHeader ($) # Plugin
4199{
4200   my $cTitlePI = shift;
4201
4202
4203}
4204
4205sub FormFooter ($) # Plugin
4206{
4207   my $cTitlePI = shift;
4208
4209
4210}
4211
4212
4213# --- save actual state in a file for debugging ----------------------------
4214sub SaveState () # CGI
4215{
4216   my $cKey;
4217
4218   my $cStateFileName =
4219       (&GetAttr("BaseDir") .
4220        "/tmp/" .
4221        &GetAttr("ScriptName") .
4222        "_state.log");
4223
4224   open MY_STATE, ">$cStateFileName" or
4225       die(sprintf(i18n("can't open %s!!"),
4226                   "$cStateFileName"));
4227
4228   printf STDERR (p(i18n("saved state:"),  hr({-noshade => 1,
4229                                               -size => 1})))
4230       if &GetAttr("DebugLvl") > 2;
4231
4232   # due to security-reasons thes fields are deleted
4233   foreach $cKey ("!DataSource", "!Database", "!Username", "!Password")
4234   {
4235      &MyParamDelete($cKey);
4236   }
4237
4238   # Hash scanning ...
4239   foreach $cKey (sort keys %hFormDataMGL)
4240   {
4241      if (($cKey !~ /^Btn.*/) && ($cKey !~ /^_.*/))
4242      {
4243
4244         print STDERR "$cKey='" . &MyParam($cKey) . "'\n"
4245             if &GetAttr("DebugLvl") > 2;
4246
4247         print MY_STATE "$cKey=" . &MyParam($cKey) . "\n";
4248
4249         $hQryMGL->param (-name  => $cKey,
4250                          -value => &MyParam($cKey));
4251      }
4252      else
4253      {
4254         &MyParamDelete($cKey);
4255      }
4256
4257   }
4258
4259   close MY_STATE;
4260
4261   chmod 0666, $cStateFileName;
4262
4263} # sub SaveState
4264
4265
4266
4267# --- Wrapper for param, which keeps %hFormDataMGL in an actual state ------
4268sub MyParam($;$) # CGI
4269{
4270   my ($cNamePI, $cValuePI) = @_;
4271   my $cResult = undef;
4272
4273   # assign the value
4274   if (defined($cValuePI)) {
4275
4276      printf STDERR "ACHTUNG!!!!! $cNamePI=$cValuePI<BR>\n"
4277          if !$cNamePI && &GetAttr("DebugLvl");
4278
4279      $hQryMGL->param(-name  => $cNamePI,
4280                      -value => $cValuePI);
4281
4282      $hFormDataMGL{$cNamePI} = $cValuePI;
4283
4284      $cResult = $cValuePI;
4285   }
4286   # get the Value
4287   else
4288   {
4289      $cResult = (defined($hFormDataMGL{$cNamePI})?
4290                  $hFormDataMGL{$cNamePI}:
4291                  undef);
4292   }
4293
4294   return $cResult;
4295}
4296
4297# --- Wrapper for delete, which keeps %hFormDataMGL in an actual state -----
4298sub MyParamDelete($) # CGI
4299{
4300   my $cNamePI = shift;
4301
4302
4303   $hQryMGL->delete($cNamePI);
4304   delete $hFormDataMGL{$cNamePI};
4305
4306}
4307
4308
4309# --- insert HTML-page -----------------------------------------------------
4310sub InsertHtmlPage($) # HTML
4311{
4312   my $cHtmlFilePI = shift;
4313   my $cResult = "";
4314
4315   open TEMPLATE, "<$cHtmlFilePI" or
4316       die(sprintf(i18n("Can't open HTML-File %s!"),
4317                           "$cHtmlFilePI"));
4318
4319   while (<TEMPLATE>)
4320   {
4321      $cResult .= &EncodeHtml($_);
4322   }
4323
4324   close TEMPLATE;
4325
4326   return $cResult;
4327} # sub InsertHtmlPage
4328
4329
4330# --- my own die-Handler ---------------------------------------------------
4331sub MyDie # HTML
4332{
4333    my $cMessagePI = shift;
4334
4335    my $iRow;
4336    my $iCol;
4337    my $oHtmlTableStack;
4338    my @lCallInfo;
4339    my @lColsWithFullWidth = ();
4340    my $cMessage;
4341    my $cAdress     = &MyVal('WWWdb', 'MailWebmaster',
4342                                     ($ENV{"SERVER_ADMIN"}));
4343    my $cSubject    = "WWWdb-Bugreport";
4344    my $cBody       = "$cMessagePI\n";
4345
4346    ($cMessage = $cMessagePI) =~ s/\n/\n<BR>/g;
4347
4348    print STDERR "DIE: $cMessage\n";
4349
4350    # this is for the table-stack (file, line, procedure)
4351    while (@lCallInfo = (caller($iRow++))[1..3])
4352    {
4353        $iCol = 0;
4354
4355        # the stack-fields
4356        foreach (@lCallInfo)
4357        {
4358            print STDERR $_ . " ";
4359        }
4360        print STDERR "\n";
4361    }
4362
4363    $oHtmlTableStack  = HTML::Table->new
4364        (BorderPar      => 1,
4365         BgColorPar     => &MyUserVal('Layout Table',
4366                                      'BgColor',
4367                                      $cBgColorMGL),
4368         WidthPar       => "100%",
4369         HeightPar      => "100%");
4370
4371    $oHtmlTableStack->Element
4372        (HTML::Table::APPEND, 0, 0,
4373         b(i18n("Oops! The following problem occured within " .
4374                "<B>WWWdb</B>!")));
4375    push @lColsWithFullWidth, $oHtmlTableStack->Element
4376        (HTML::Table::CURRENT, 0);
4377
4378    $oHtmlTableStack->Element(HTML::Table::APPEND, 0, 0,
4379                              ($_ . p(small($cMessage))));
4380    push @lColsWithFullWidth, $oHtmlTableStack->Element
4381        (HTML::Table::CURRENT, 0);
4382
4383    $oHtmlTableStack->Element(HTML::Table::APPEND, 0, 0,
4384                              b(i18n("Call-Stack:")));
4385    push @lColsWithFullWidth, $oHtmlTableStack->Element
4386        (HTML::Table::CURRENT, 0);
4387
4388    $oHtmlTableStack->Element(HTML::Table::APPEND,
4389                            HTML::TableRow->new());
4390
4391    $iCol = 0;
4392    # Generate the table-header
4393    foreach (i18n("File"),
4394             i18n("Line"),
4395             i18n("Procedure"))
4396    {
4397        $oHtmlTableStack->Element(HTML::Table::CURRENT, $iCol++, 0,
4398                                  small(b($_)));
4399    }
4400
4401    $iRow = 0;
4402
4403    # this is for the table-stack (file, line, procedure)
4404    while (@lCallInfo = (caller($iRow++))[1..3])
4405    {
4406
4407        $oHtmlTableStack->Element
4408            (HTML::Table::APPEND,
4409           HTML::TableRow->new(BgColorPar => ($iRow %2?
4410                                              "#eeeeee":
4411                                              "#ffffff")));
4412
4413        $iCol = 0;
4414
4415        # the stack-fields
4416        foreach (@lCallInfo)
4417        {
4418            $oHtmlTableStack->Element(HTML::Table::CURRENT, $iCol++, 0,
4419                                      small($_));
4420            $cBody .= " $_";
4421        }
4422
4423        $cBody .= "\n";
4424
4425    }
4426
4427    foreach ("LastBtn",
4428             "Lang",
4429             "BaseLang",
4430             "State",
4431             "RecordOk",
4432             "ScriptName",
4433             "HostName",
4434             "DebugLvl",
4435             "BaseDir",
4436             "DbDriver",
4437             "DbHandle",
4438             "ConfigPath",
4439             "ConfigFile",
4440             "SessionId",
4441             "UrlParams",
4442             "LogfileName",
4443             "HTMLfileName",
4444             "RecIdField",
4445             "RecId",
4446             "ObjectId")
4447    {
4448        $cBody .= sprintf("%s = '%s'\n",
4449                          $_, &GetAttr($_));
4450
4451    }
4452
4453    # make this rows full-sized
4454    foreach (@lColsWithFullWidth)
4455    {
4456        $_->setColspanPar($oHtmlTableStack->getMaxCol());
4457    }
4458
4459
4460    $cSubject =~ s/ /%20/g;
4461    $cBody    =~ s/ /%20/g;
4462    $cSubject =~ s/\n/%0D/g;
4463    $cBody    =~ s/\n/%0D/g;
4464
4465    $oHtmlTableStack->Element
4466        (HTML::Table::APPEND, 0, 0,
4467         a({HREF => "mailto:$cAdress?subject=$cSubject&body=$cBody"},
4468           i18n("Please send this bugreport!")));
4469
4470    # make this rows full-sized
4471    $oHtmlTableStack->Element(HTML::Table::CURRENT, 0)->
4472        setColspanPar($oHtmlTableStack->getMaxCol());
4473
4474    &Error($oHtmlTableStack->HtmlCode);
4475
4476} # sub MyDie
4477
4478
4479
4480=head2 Error - show a error-frame and leave
4481
4482    =over 2
4483
4484    =item B<DESCRIPTION>
4485
4486FIXME: add docs
4487
4488    - HTTP-link: http://<host>
4489    - WWWdb-link: wwwdb://<Config-file>[;<Par>=<Value> ...]
4490
4491    =item B<SYNOPSIS>
4492
4493    $http_ref = ResolveRefField($ref_field, $label);
4494
4495=item B<RETURN VALUE>
4496
4497    A correct HTML-Reference for the values, given as parameters.
4498
4499    =item B<EXAMPLE>
4500
4501    # Generate a Link to WWWdb:Index for the current session and db
4502    $hppt_ref = ResolveRefField("wwwdb://WWWdb:Index;Lang=de",
4503                                "Main-Index");
4504
4505=item B<SEE ALSO>
4506
4507=back
4508
4509=cut
4510
4511# --- Show an error frame --------------------------------------------------
4512    sub Error($) # HTML
4513{
4514    my $cMessagePI = shift;
4515
4516    my $cMessage = $cMessagePI . "<BR><BR>";
4517
4518    &OkForm("Die",
4519            "$cMessage");
4520
4521    $iCacheTimeoutMGL = 0;
4522
4523    &MyExit();
4524} # sub MyDie
4525
4526
4527
4528=head2 MyExit - leave WWWdb in a clean way
4529
4530=over 2
4531
4532=item B<DESCRIPTION>
4533
4534FIXME: add docs
4535
4536    - HTTP-link: http://<host>
4537    - WWWdb-link: wwwdb://<Config-file>[;<Par>=<Value> ...]
4538
4539=item B<SYNOPSIS>
4540
4541    $hppt_ref = ResolveRefField($ref_field, $label);
4542
4543=item B<RETURN VALUE>
4544
4545    A correct HTML-Reference for the values, given as parameters.
4546
4547=item B<EXAMPLE>
4548
4549    # Generate a Link to WWWdb:Index for the current session and db
4550    $hppt_ref = ResolveRefField("wwwdb://WWWdb:Index;Lang=de",
4551                                "Main-Index");
4552
4553=item B<SEE ALSO>
4554
4555=back
4556
4557=cut
4558
4559# --- exit this program in a clean way -------------------------------------
4560    sub MyExit() # HTML Db
4561{
4562    my $iDebugLvl = &GetAttr("DebugLvl");
4563
4564    # Update the DB now
4565  DBIx::Recordset::Undef("pDataSetMGL");
4566
4567  Plugin::_UndefAllPlugins();
4568
4569    if (defined $oFormMGL)
4570    {
4571        print $oFormMGL->HtmlCode();
4572    }
4573
4574    $oSessionGL   = undef;
4575    $oDbSessionGL = undef;
4576    $oDbTargetGL = undef;
4577
4578    close STDERR;
4579
4580    # in debugging-mode generate the whole logfile into HTML
4581    if ($iDebugLvl)
4582    {
4583        open LOGFILE, "<" . &GetAttr("LogfileName") or
4584            die (sprintf("Can't open Log-file %s!",
4585                         &GetAttr("LogfileName")));
4586
4587        print STDOUT "<SMALL><PRE>";
4588
4589        while (<LOGFILE>)
4590        {
4591            print STDOUT "$_<BR>";
4592        }
4593        print STDOUT "</PRE></SMALL>";
4594
4595        close LOGFILE;
4596
4597    }
4598
4599    # dump out the cache-file, when the timeout is set
4600    &CGI::Cache::Stop($iCacheTimeoutMGL? 1: 1);
4601
4602    # expire this document
4603    &CGI::Cache::Expire()
4604        unless $iCacheTimeoutMGL;
4605
4606    exit;
4607
4608}
4609
4610
4611# --- generate label for fields containing errors --------------------------
4612sub ErrLabel($) # HTML Plugin
4613{
4614    my $cFieldPI = shift;
4615
4616    return (defined($hFieldErrorsMGL{$cFieldPI})?
4617            font({-color => 'Red'},
4618                 b(" (*)")):
4619            "");
4620} # sub ErrLabel
4621
4622
4623
4624=head2 MyUserVal - Get an entry of the config-file, but look for session-data before
4625
4626=over 2
4627
4628=item B<DESCRIPTION>
4629
4630FIXME: add docs
4631
4632    - HTTP-link: http://<host>
4633    - WWWdb-link: wwwdb://<Config-file>[;<Par>=<Value> ...]
4634
4635=item B<SYNOPSIS>
4636
4637    $hppt_ref = ResolveRefField($ref_field, $label);
4638
4639=item B<RETURN VALUE>
4640
4641    A correct HTML-Reference for the values, given as parameters.
4642
4643=item B<EXAMPLE>
4644
4645    # Generate a Link to WWWdb:Index for the current session and db
4646    $hppt_ref = ResolveRefField("wwwdb://WWWdb:Index;Lang=de",
4647                                "Main-Index");
4648
4649=item B<SEE ALSO>
4650
4651=back
4652
4653=cut
4654
4655# --- Wrapper for MyVal looking in the SessionId-Table before -------------------
4656    sub MyUserVal($$;$) # SessionId ConfigFile
4657{
4658    my ($cSectionPI, $cEntryPI, $cDefaultPI) = @_;
4659
4660    my $cResult = undef;
4661
4662    $cResult = $oSessionGL->getState("[$cSectionPI] $cEntryPI")
4663        if defined($oSessionGL);
4664
4665    if (!defined $cResult)
4666    {
4667        $cResult = &MyVal($cSectionPI, $cEntryPI, $cDefaultPI)
4668        }
4669
4670    return $cResult;
4671}
4672
4673
4674
4675=head2 MyVal - Get an entry of the config-file
4676
4677=over 2
4678
4679=item B<DESCRIPTION>
4680
4681FIXME: add docs
4682
4683    - HTTP-link: http://<host>
4684    - WWWdb-link: wwwdb://<Config-file>[;<Par>=<Value> ...]
4685
4686=item B<SYNOPSIS>
4687
4688    $hppt_ref = ResolveRefField($ref_field, $label);
4689
4690=item B<RETURN VALUE>
4691
4692    A correct HTML-Reference for the values, given as parameters.
4693
4694=item B<EXAMPLE>
4695
4696    # Generate a Link to WWWdb:Index for the current session and db
4697    $hppt_ref = ResolveRefField("wwwdb://WWWdb:Index;Lang=de",
4698                                "Main-Index");
4699
4700=item B<SEE ALSO>
4701
4702=back
4703
4704=cut
4705
4706
4707# --- Wrapper for val, to read single-entries of the config-file -----------
4708    sub MyVal($$;$) # ConfigFile
4709{
4710    my ($cSectionPI, $cEntryPI, $cDefaultPI) = @_;
4711
4712    my $cResult = defined($cDefaultPI)? $cDefaultPI: "";
4713
4714    if (defined($oConfPoolGL))
4715    {
4716        my $cResultConfigPool =
4717            $oConfPoolGL->getValue($cSectionPI, $cEntryPI);
4718
4719        $cResult = $cResultConfigPool
4720            if (defined $cResultConfigPool);
4721
4722    }
4723
4724    return $cResult;
4725}
4726
4727
4728
4729=head2 MySetVal - Set an entry, defined in the config-file
4730
4731=over 2
4732
4733=item B<DESCRIPTION>
4734
4735FIXME: add docs
4736
4737    - HTTP-link: http://<host>
4738    - WWWdb-link: wwwdb://<Config-file>[;<Par>=<Value> ...]
4739
4740=item B<SYNOPSIS>
4741
4742    $hppt_ref = ResolveRefField($ref_field, $label);
4743
4744=item B<RETURN VALUE>
4745
4746    A correct HTML-Reference for the values, given as parameters.
4747
4748=item B<EXAMPLE>
4749
4750    # Generate a Link to WWWdb:Index for the current session and db
4751    $hppt_ref = ResolveRefField("wwwdb://WWWdb:Index;Lang=de",
4752                                "Main-Index");
4753
4754=item B<SEE ALSO>
4755
4756=back
4757
4758=cut
4759
4760# --- Wrapper for val, to read single-entries of the config-file -----------
4761    sub MySetVal($$@) # ConfigFile
4762{
4763    my $cSectionPI = shift;
4764    my $cEntryPI   = shift;
4765    my @pValuePI   = @_;
4766
4767    if (defined($oConfPoolGL))
4768    {
4769        $oConfPoolGL->setValue($cSectionPI, $cEntryPI, @pValuePI);
4770    }
4771}
4772
4773
4774
4775# --- Wrapper for val, to read list-entries of the config-file -------------
4776sub MyListVal($$;$) # ConfigFile
4777{
4778    my ($cSectionPI, $cEntryPI, $cDefaultPI) = @_;
4779
4780    my $cResult;
4781    my @lResult = ();
4782
4783    if (defined($oConfPoolGL))
4784    {
4785        my $cResultConfigPool =
4786            $oConfPoolGL->getValue($cSectionPI, $cEntryPI);
4787
4788
4789        @lResult = split "\n", $cResultConfigPool;
4790    }
4791
4792    return @lResult;
4793}
4794
4795=head2 GetSelRadioLabel - Get the label from a Select-Field or Radio-Box
4796
4797=over 2
4798
4799=item B<DESCRIPTION>
4800
4801    This function returns the value or values of an Selectbox or radiofield.
4802
4803=item B<SYNOPSIS>
4804
4805    $label = ResolveRefField($field[, $value]);
4806
4807=item B<RETURN VALUE>
4808
4809    If only the fieldname is passed, then the whole field/label-list
4810    is returned. If a valid value is passed too, then the corresponding
4811    label will be returned.
4812
4813=item B<EXAMPLE>
4814
4815    # Get the Label for the "status"-field
4816    $cLabel = &GetSelRadioLabel("status", $iStatus);
4817
4818=item B<SEE ALSO>
4819
4820=back
4821
4822=cut
4823
4824sub GetSelRadioLabel($;$)
4825{
4826    my $cFieldNamePI = shift;
4827    my $cValuePI     = shift;
4828
4829
4830
4831    unless (defined $hSelectCacheMGL{$cFieldNamePI})
4832    {
4833        my @lListValues;
4834        my %hLabels;
4835        my @lResult = &GetSelectboxValues($cFieldNamePI);
4836
4837        @lListValues = @{$lResult[0]};
4838        %hLabels     = %{$lResult[1]};
4839
4840        $hSelectCacheMGL{$cFieldNamePI} = \%hLabels;
4841    }
4842
4843    if(defined $cValuePI)
4844    {
4845        return $hSelectCacheMGL{$cFieldNamePI}->{$cValuePI};
4846    }
4847    else
4848    {
4849        return $hSelectCacheMGL{$cFieldNamePI};
4850    }
4851}
4852
4853
4854=head2 Redirect - redirect the browser to another HTML-page
4855
4856=over 2
4857
4858=item B<DESCRIPTION>
4859
4860FIXME: add docs
4861
4862    - HTTP-link: http://<host>
4863    - WWWdb-link: wwwdb://<Config-file>[;<Par>=<Value> ...]
4864
4865=item B<SYNOPSIS>
4866
4867    $hppt_ref = ResolveRefField($ref_field, $label);
4868
4869=item B<RETURN VALUE>
4870
4871    A correct HTML-Reference for the values, given as parameters.
4872
4873=item B<EXAMPLE>
4874
4875    # Generate a Link to WWWdb:Index for the current session and db
4876    $hppt_ref = ResolveRefField("wwwdb://WWWdb:Index;Lang=de",
4877                                "Main-Index");
4878
4879=item B<SEE ALSO>
4880
4881=back
4882
4883=cut
4884
4885    sub Redirect($$) # HTML
4886{
4887    my ($cSessionIdPI, $cConfigFilePI) = @_;
4888
4889    $oFormMGL = undef;
4890
4891    printf STDERR ("REDIRECT TO %s\n",
4892                   &CreateReference($cSessionIdPI, $cConfigFilePI))
4893        if &GetAttr("DebugLvl") > 2;
4894
4895    print redirect(&CreateReference($cSessionIdPI, $cConfigFilePI))
4896        if &GetAttr("DebugLvl") < 10;
4897
4898    $iCacheTimeoutMGL = 0;
4899
4900    &MyExit();
4901}
4902
4903
4904
4905
4906
4907=head2 CreateReference - makes an internal WWWdb-HTML-reference
4908
4909=over 2
4910
4911=item B<DESCRIPTION>
4912
4913FIXME: add docs
4914
4915    - HTTP-link: http://<host>
4916    - WWWdb-link: wwwdb://<Config-file>[;<Par>=<Value> ...]
4917
4918=item B<SYNOPSIS>
4919
4920    $hppt_ref = ResolveRefField($ref_field, $label);
4921
4922=item B<RETURN VALUE>
4923
4924    A correct HTML-Reference for the values, given as parameters.
4925
4926=item B<EXAMPLE>
4927
4928    # Generate a Link to WWWdb:Index for the current session and db
4929    $hppt_ref = ResolveRefField("wwwdb://WWWdb:Index;Lang=de",
4930                                "Main-Index");
4931
4932=item B<SEE ALSO>
4933
4934=back
4935
4936=cut
4937
4938
4939sub CreateReference($$) # HTML
4940{
4941    my ($cSessionIdPI, $cConfigFilePI) = @_;
4942
4943    my $cResult;
4944
4945    # FIXME: use $ENV{"SERVER_PROTOCOL"}
4946
4947    $cResult = sprintf("http%s://%s/%s%s/%s/%s",
4948                       &UnTaint($ENV{"HTTPS"})? "s": "",
4949                       &GetAttr("HostName"),
4950                       (&GetAttr("WWWdbDomain") eq "NULL"?
4951                        "":
4952                        &GetAttr("WWWdbDomain") . "/"),
4953                       $cSessionIdPI,
4954                       &GetAttr("DbDriver"),
4955                       $cConfigFilePI);
4956
4957    return $cResult;
4958
4959}
4960
4961
4962
4963
4964
4965=head2 ResolveRefField - Resolve a Reference of an wwwdb_object
4966
4967=over 2
4968
4969=item B<DESCRIPTION>
4970
4971    Resolve a Reference of an wwwdb_object to a correct HTTP-Url.
4972    This Reference can have one of the following forms:
4973
4974    - HTTP-link: http://<host>
4975    - WWWdb-link: wwwdb://<Config-file>[;<Par>=<Value> ...]
4976
4977=item B<SYNOPSIS>
4978
4979    $hppt_ref = &ResolveRefField($ref_field, $label);
4980
4981=item B<RETURN VALUE>
4982
4983    A correct HTML-Reference for the values, given as parameters.
4984
4985=item B<EXAMPLE>
4986
4987    # Generate a Link to WWWdb:Index for the current session and db
4988    $hppt_ref = ResolveRefField("wwwdb://WWWdb:Index;Lang=de",
4989                                "Main-Index");
4990
4991=item B<SEE ALSO>
4992
4993=back
4994
4995=cut
4996
4997    sub ResolveRefField($$) # HTML
4998{
4999    my $cRefFieldPI = shift;
5000    my $cLabelPI    = shift;
5001    my $cResult;
5002
5003    $cResult = "";
5004
5005    # WWWdb-Link (wwwdb://xxx)
5006    if($cRefFieldPI =~ "wwwdb://(.*)")
5007    {
5008        $cResult = a({href => &CreateReference
5009                          (&GetAttr("SessionId"), $1)},
5010                     &EncodeHtml(i18n($cLabelPI)));
5011    }
5012    # normal http-Link
5013    elsif($cRefFieldPI =~ "https?://.*")
5014    {
5015        $cResult = a({href   => $cRefFieldPI,
5016                      target => "_wwwdb_new"},
5017                     &EncodeHtml(i18n($cLabelPI)));
5018    }
5019    # mail-reference
5020    elsif($cRefFieldPI =~ "mailto:.*")
5021    {
5022        $cResult = a({href => $cRefFieldPI},
5023                     &EncodeHtml(i18n($cLabelPI)));
5024    }
5025    # file-reference
5026    elsif($cRefFieldPI =~ "file:.*")
5027    {
5028        $cResult = a({href => $cRefFieldPI},
5029                     &EncodeHtml(i18n($cLabelPI)));
5030    }
5031    # Anything else as Text
5032    else
5033    {
5034        $cResult = b(&EncodeHtml(i18n($cRefFieldPI)));
5035    }
5036
5037    return $cResult;
5038}
5039
5040# --- Include a image --------------------------------------------------
5041sub GenImage($;$$)
5042{
5043    my $cSrcPI    = shift;
5044    my $cAltPI    = shift;
5045    my $cBorderPI = shift;
5046
5047    my $cResult = "";
5048    my $cExt    = undef;
5049    my $cSrc    = ("/" .
5050                   &GetAttr("BaseDir") .
5051                   "/lib/" .
5052                   $cSrcPI);
5053
5054    foreach ("", ".jpg", ".png", ".gif", ".JPG", ".PNG", ".GIF")
5055    {
5056        $cExt = $_;
5057
5058        print STDERR "GRAFIK: $cSrc$_\n";
5059
5060        last
5061            if -f "$cSrc$_";
5062
5063        $cExt = undef;
5064    }
5065
5066    if (defined $cExt)
5067    {
5068        if (defined $cAltPI)
5069        {
5070            $cResult = img({SRC    => ("/" .
5071                                       &GetAttr("ScriptName") .
5072                                       "/lib/" .
5073                                       $cSrcPI .
5074                                       $cExt),
5075                                           ALT    => $cAltPI,
5076                                           BORDER => $cBorderPI});
5077        }
5078        else
5079        {
5080            $cResult =("/" .
5081                       &GetAttr("ScriptName") .
5082                       "/lib/" .
5083                       $cSrcPI .
5084                       $cExt);
5085        }
5086    }
5087    else
5088    {
5089        $cResult = "";
5090    }
5091
5092    return $cResult;
5093
5094}
5095
5096# --- Interface for internationalisation -------------------------------
5097{
5098sub i18n($)
5099{
5100   my $cMessage = shift;
5101
5102   my $cResult;
5103
5104   $cResult = $hMessagesGL{$cMessage} || $cMessage;
5105
5106   printf STDERR ("i18n(%s) => '%s'\n",
5107                  $cMessage,
5108                  $cResult)
5109       if &GetAttr("DebugLvl") > 3;
5110
5111   # This is for untranslated ones
5112   if($cResult =~ /^FIXME /)
5113   {
5114      $cResult =~ s/FIXME //;
5115
5116      $cResult = "[$cResult]"
5117          if &GetAttr("DebugLvl") > 9;
5118   }
5119
5120   $cResult = "($cResult)"
5121       if (&GetAttr("DebugLvl") > 9);
5122
5123
5124   return $cResult;
5125}
5126}
5127
5128
5129=head2 GetField - Get value of a Field in the HTML-Form
5130
5131=over 2
5132
5133=item B<DESCRIPTION>
5134
5135    Gets the current value of the field $field_name in the html-form and
5136    returns it.
5137
5138=item B<SYNOPSIS>
5139
5140    GetField (field_name)
5141
5142=item B<RETURN VALUE>
5143
5144    A string, containig the value of the input-field representing the
5145    field in the html-form. If the field-name does not exist,
5146    the function returns an empty string "".
5147
5148=item B<EXAMPLE>
5149
5150    # get the customer-id (custnum)
5151    $iCustNumber = &WWWDb::GetField("custnum");
5152
5153=item B<SEE ALSO>
5154
5155    SetField
5156
5157=back
5158
5159=cut
5160
5161# ------------------------------------------------------------------------------
5162sub GetField($) # Db-Record
5163{
5164    my $cFieldNamePI = shift;
5165
5166    my $cResult = &MyParam("Fld$cFieldNamePI");
5167
5168    print STDERR ">> GetField($cFieldNamePI)\n"
5169        if &GetAttr("DebugLvl");
5170
5171    print STDERR "<< GetField($cResult)\n"
5172        if &GetAttr("DebugLvl");
5173
5174    return $cResult;
5175}
5176
5177
5178
5179
5180
5181
5182=head2 SetField - Sets the value of a HTML-field
5183
5184=over 2
5185
5186=item B<DESCRIPTION>
5187
5188    Sets the value of the field $field_name in the HTML-Form to the value
5189    $value. In CGI it is threated as a parameter and passed via POST, so
5190    you can use it in the next turn again.
5191
5192=item B<SYNOPSIS>
5193
5194    SetField (field_name, $value);
5195
5196=item B<RETURN VALUE>
5197
5198    None.
5199
5200=item B<EXAMPLE>
5201
5202    # Set the Customer-id to 42
5203    &WWWdb::SetField("custnum", 42);
5204
5205=item B<SEE ALSO>
5206
5207    GetField
5208
5209=back
5210
5211=cut
5212
5213# ------------------------------------------------------------------------------
5214    sub SetField($$) # Db-Record
5215{
5216    my $cFieldNamePI = shift;
5217    my $cValuePI     = shift;
5218
5219    print STDERR ">> SetField($cFieldNamePI, '$cValuePI')\n"
5220        if &GetAttr("DebugLvl");
5221
5222    &MyParam("Fld$cFieldNamePI", $cValuePI);
5223    return;
5224}
5225
5226
5227
5228
5229
5230
5231
5232=head2 AddError - Add an error-message to the internal list
5233
5234=over 2
5235
5236=item B<DESCRIPTION>
5237
5238    Add an user-error-message to the internal error-message-list. This
5239    message is linked with the field $field_name. That means that
5240    this field is marked on the html-form and on the bottom of the form
5241    the $error_message is included in the list of errors.
5242
5243=item B<SYNOPSIS>
5244
5245    AddError ($field_name, $error_message);
5246
5247=item B<RETURN VALUE>
5248
5249    None.
5250
5251=item B<EXAMPLE>
5252
5253    # The field custnum must be filled
5254    if (&GetField("custnum"))
5255{
5256    &AddError("custnum", "Please enter a valid customer-number");
5257}
5258
5259=back
5260
5261=cut
5262
5263#-------------------------------------------------------------------------------
5264    sub AddError($$) # Db-Record
5265{
5266    my $cFieldNamePI = shift;
5267    my $cErrorTextPI = shift;
5268
5269    print STDERR ">> AddError($cFieldNamePI, $cErrorTextPI)\n"
5270        if &GetAttr("DebugLvl");
5271
5272    $hFieldErrorsMGL{"Fld$cFieldNamePI"} = $cErrorTextPI;
5273
5274    return;
5275}
5276
5277
5278
5279
5280
5281=head2 DecodeHtml - decodes HTML-formatted entities to normal Text
5282
5283=over 2
5284
5285=item B<DESCRIPTION>
5286
5287    Decodes HTML-formatted entities to normal Text. This means that, when
5288    you have HTML-Entities like &uuml;, but you want human-readable data,
5289    you have to convert it. This function does this conversion.
5290
5291
5292=item B<SYNOPSIS>
5293
5294    $decoded_text = DecodeHtml($encoded_text);
5295
5296=item B<RETURN VALUE>
5297
5298    The decoded text.
5299
5300=item B<EXAMPLE>
5301
5302    # We need a �-Sign
5303    $copyright_sign = DecodeHtml("&copy;");
5304
5305=item B<SEE ALSO>
5306
5307    EncodeHtml, SafeEncodeHtml
5308
5309=back
5310
5311=cut
5312
5313# ------------------------------------------------------------------------------
5314    sub DecodeHtml($) # HTML
5315{
5316    my @lMessagePI = @_;
5317
5318    print STDERR ">> DecodeHtml(@lMessagePI)\n"
5319        if &GetAttr("DebugLvl");
5320
5321    for (@lMessagePI)
5322    {
5323        $_ = decode_entities($_);
5324    }
5325
5326    return (wantarray? @lMessagePI: $lMessagePI[0]);
5327
5328}
5329
5330
5331=head2 EncodeHtml - encode normal text, to be HTML-save
5332
5333=over 2
5334
5335=item B<DESCRIPTION>
5336
5337    EncodeHtml encodes normal text, to be HTML-save. When you do this, any
5338    characters, which have a special meaning or coding in HTML, will be translated into
5339    correct HTML-entities. So you can savely use special characters like umlauts
5340    without caring, if HTML can display them correctly.
5341
5342    B<NOTE>: This function does NOT decode the HTML-characters <, >, &, ; and \"
5343
5344=item B<SYNOPSIS>
5345
5346    $encoded_text = EncodeHtml($text_to_encode);
5347
5348=item B<RETURN VALUE>
5349
5350    The encoded text.
5351
5352=item B<EXAMPLE>
5353
5354    # ��� -> &ouml;&auml;&uuml;
5355    $encoded_text = EncodeHtml("���");
5356
5357=item B<SEE ALSO>
5358
5359    SafeEncodeHtml
5360
5361=back
5362
5363=cut
5364
5365# --- encode HTML-Entities, but preserve HTML-Tags (� -> &uuml;) ----------------
5366    sub EncodeHtml($) # HTML
5367{
5368    my @lMessagePI = @_;
5369
5370    print STDERR ">> EncodeHtml(@lMessagePI)\n"
5371        if &GetAttr("DebugLvl");
5372
5373    for (@lMessagePI)
5374    {
5375        $_ = encode_entities($_, "\200-\377");
5376    }
5377
5378    return (wantarray? @lMessagePI: $lMessagePI[0]);
5379
5380}
5381
5382
5383
5384=head2 SafeEncodeHtml - extended encoding of HTML-Tags
5385
5386=over 2
5387
5388=item B<DESCRIPTION>
5389
5390    EncodeHtml encodes normal text, to be HTML-save. When you do this, any
5391    characters, which have a special meaning or coding in HTML, will be
5392    translated into correct HTML-entities. So you can savely use special
5393    characters like umlauts without caring, if HTML can display them
5394    correctly. So long this behaves as B<EncodeHtml>, but this function
5395    handles the HTML-characters <, >, &, ; and \" too.
5396
5397    You will need this function by example to secure user-input, which
5398    will be displayed later in HTML. Some bad guy could enter HTML-tags,
5399    which show things on your site, you want not to display.
5400
5401=item B<SYNOPSIS>
5402
5403    $encoded_text = SafeEncodeHtml($text_to_encode);
5404
5405=item B<RETURN VALUE>
5406
5407    The safe encoded text.
5408
5409=item B<EXAMPLE>
5410
5411    use CGI;
5412
5413# print input of user
5414print p(SafeEncodeHtml($input_from_user));
5415
5416=item B<SEE ALSO>
5417
5418    SafeEncodeHtml
5419
5420=back
5421
5422=cut
5423
5424# --- encode HTML-Entities, including <>&;" (� -> &uuml;) -----------------------
5425    sub SafeEncodeHtml($) # HTML
5426{
5427    my @lMessagePI = @_;
5428
5429    print STDERR ">> SafeEncodeHtml(@lMessagePI)\n"
5430        if &GetAttr("DebugLvl");
5431
5432    for (@lMessagePI)
5433    {
5434        $_ = encode_entities($_);
5435    }
5436
5437    return (wantarray? @lMessagePI: $lMessagePI[0]);
5438
5439}
5440
5441
5442# --- Create a reference for Scan-Doc ---------------------------------------
5443sub CreRef($$$)
5444{
5445    my $cPreTextPI  = shift;
5446    my $cRefPI      = shift;
5447    my $cPostTextPI = shift;
5448
5449    return ($cPreTextPI .
5450            &CreateReference(&GetAttr("SessionId"), $cRefPI) .
5451            $cPostTextPI);
5452}
5453
5454
5455# --- Scan HTML-Text and replace WWWdb-specific references ------------------
5456sub ScanDoc($)
5457{
5458    my $cText = shift;
5459    my $cAppl  = &GetAttr("ScriptName");
5460
5461    $cText =~ s!=\"?wwwdb://(.*?)\"?>!&CreRef("=", $1, ">")!gei;
5462
5463    $cText =~ s!src=[\"\']?/wwwdb/([^\"\'\s]+)[\"\']?\s*!SRC=\"/$cAppl/$1\" !gi;
5464
5465    return $cText;
5466}
5467
5468
5469
5470
5471
5472=head2 GetFieldTypeName - get the fieldtype-name of a given field
5473
5474=over 2
5475
5476=item B<DESCRIPTION>
5477
5478    This function returns the SQL-Fieldtype of the given field.
5479    This is a short text like "varchar", "integer", etc.
5480
5481=item B<SYNOPSIS>
5482
5483    $cust_type = GetFieldTypeName($field_name);
5484
5485=item B<RETURN VALUE>
5486
5487    The SQL-fieldtype or undef, if the field does not exist.
5488
5489=item B<EXAMPLE>
5490
5491    # Convert date fields
5492    if(&GetFieldTypeName($field) eq "date")
5493{
5494    &ConvertData($record{$field});
5495}
5496
5497=item B<SEE ALSO>
5498
5499    -
5500
5501=back
5502
5503=cut
5504
5505
5506# --- Get the field-type of the field -----------------------------------------
5507sub GetFieldTypeName($) # Database
5508{
5509    my $cFieldNamePI = shift;
5510
5511    my $cResult = undef;
5512
5513    print STDERR ">> GetFieldTypeName($cFieldNamePI)\n"
5514        if &GetAttr("DebugLvl");
5515
5516    if (defined $hTableInfoMGL{$cFieldNamePI})
5517    {
5518        $cResult = (defined $hTableInfoMGL{$cFieldNamePI}{"TYPE_NAME"}?
5519                    $hTableInfoMGL{$cFieldNamePI}{"TYPE_NAME"}:
5520                    undef);
5521
5522    }
5523
5524    print STDERR "<< GetFieldTypeName($cResult)\n"
5525        if &GetAttr("DebugLvl");
5526
5527    return $cResult;
5528
5529}
5530
5531
5532=head2 GetObjectId - get the id of the corresponding navigation-object
5533
5534=over 2
5535
5536=item B<DESCRIPTION>
5537
5538    FIXME
5539
5540    This procedure checks the existence of a session-parameter and those
5541    value.  If every thing is alright, the value 1 is returned. When the
5542    session-parameter is preceeded by a "!", the check is negated.
5543
5544=item B<SYNOPSIS>
5545
5546    $b_value = IsAttribOK($name_of_session_parameter);
5547
5548=item B<RETURN VALUE>
5549
5550    1 if the session-parameter exists, an has a value, else 0 (or vice
5551                                                               versa if negated)
5552
5553=item B<EXAMPLE>
5554
5555# Check, if we are logged in
5556    $bLoggedInCorrectly = IsAttribOK("ActualLogin");
5557
5558=item B<SEE ALSO>
5559
5560=back
5561
5562=cut
5563
5564
5565# --- Get the Object-Id of the current application --------------------------
5566    sub GetObjectId () # Nav (Database)
5567{
5568    my $iResult = 0;
5569
5570    my $cUrlParams = &GetAttr("UrlParams");
5571    my @lUrlParams = split ";", $cUrlParams;
5572    my $cLinkKey;
5573
5574    # the url-param overloads the value of the form
5575    foreach (@lUrlParams)
5576    {
5577
5578        $iResult = $1
5579            if (/^cat=(\d+)/);
5580    }
5581
5582
5583    $cLinkKey = ("wwwdb://" .
5584                 ($iResult?  "WWWdb:Nav": &GetAttr("ConfigFile")) .
5585                 ($cUrlParams? (";" . $cUrlParams): ""));
5586
5587    # get object-info
5588    $iResult = ($oDbSessionGL->SqlSelect
5589                ("SELECT
5590                   id_object
5591                 FROM
5592                   wwwdb_object
5593                 WHERE
5594                   ref_link = ?",
5595                 $cLinkKey))->[0]->[0];
5596
5597    # we had no success ... lets try it without the url-parameters
5598    if (!$iResult)
5599    {
5600
5601        $cLinkKey = ("wwwdb://" .
5602                     &GetAttr("ConfigFile"));
5603
5604        # get category-info
5605        $iResult = ($oDbSessionGL->SqlSelect
5606                    ("SELECT
5607                      id_object
5608                    FROM
5609                      wwwdb_object
5610                    WHERE
5611                      ref_link = ?",
5612                     $cLinkKey))->[0]->[0];
5613    }
5614
5615    return $iResult;
5616}
5617
5618# FIXME: implement GetCategoryId too
5619
5620=head2 IsAttribOK - check a navigation-attribute
5621
5622=over 2
5623
5624=item B<DESCRIPTION>
5625
5626    This procedure checks the existence of a session-parameter and those
5627    value.  If every thing is alright, the value 1 is returned. When the
5628    session-parameter is preceeded by a "!", the check is negated.
5629
5630=item B<SYNOPSIS>
5631
5632    $b_value = IsAttribOK($name_of_session_parameter);
5633
5634=item B<RETURN VALUE>
5635
5636    1 if the session-parameter exists, an has a value, else 0 (or vice
5637                                                               versa if negated)
5638
5639=item B<EXAMPLE>
5640
5641# Check, if we are logged in
5642    $bLoggedInCorrectly = IsAttribOK("ActualLogin");
5643
5644=item B<SEE ALSO>
5645
5646=back
5647
5648=cut
5649
5650
5651# --- check if the expression $cAttribPI is true ----------------------------
5652    sub IsAttribOK ($@) # Session-Id
5653{
5654    my $cAttribPI = shift;
5655    my $iResult   = 999;
5656
5657    my %hBuiltins = ("IsHidden"     => 1,
5658                     "IsSSL"        => 1,
5659                     @_);
5660
5661    my $cOp   = "";
5662    my $cAttr = $cAttribPI;
5663    printf STDERR "cAttrPI = '$cAttr'\n";
5664
5665    # pre-substitute all matching builtins
5666    foreach (keys %hBuiltins)
5667    {
5668        printf STDERR $hBuiltins{$_}." <= $_\n";
5669        $cAttr =~ s/$_/$hBuiltins{$_}/ge;
5670    }
5671
5672    # This application should be hidden in categories, etc
5673    printf STDERR "cAttr = '$cAttr'\n";
5674    if($cAttr ne "" && defined $oSessionGL)
5675    {
5676        $cAttr =~ s/([A-Za-z_]+)/$oSessionGL->getState($1)?1:0/ge;
5677        $cAttr = '$iResult = (' . $cAttr . ')';
5678
5679        $iResult = eval {
5680            eval $cAttr;
5681            printf STDERR "A: cAttr = '$cAttr' => '$iResult'\n";
5682            return $iResult;
5683        };
5684
5685        $iResult = -999
5686            if $@;
5687
5688        printf STDERR "B: cAttr = '$cAttr' => '$iResult'\n";
5689    }
5690    else
5691    {
5692        $iResult = 1;
5693    }
5694
5695    printf STDERR "B: iResult = '$iResult'\n";
5696
5697    return $iResult;
5698}
5699
5700
5701=head2 SQLSelectList - Get the SQL-SELECT-result as a list
5702
5703=over 2
5704
5705=item B<DESCRIPTION>
5706
5707    SQLSelectList executes the Statement, given as argument, and returns a
5708    list of all found records with the fields backslach and
5709    comma-separated (\\,).
5710
5711=item B<SYNOPSIS>
5712
5713    @result_list = SQLSelectList($sql_select_statement);
5714
5715=item B<RETURN VALUE>
5716
5717    A array, containing one elemen for each found record. Inside the
5718    record, all the fields are separated with commas. When used in a
5719    scalar-context, perl will return the number of selected rows.
5720
5721=item B<EXAMPLE>
5722
5723    # check if login for Joe User is ok
5724    if(&SQLSelectList("SELECT username
5725                    FROM users
5726                    WHERE username = 'joe user' AND
5727                          password = '42'"))
5728{
5729    print "ok, you are Joe User\n";
5730}
5731
5732# print all users
5733foreach (&SQLSelectList("SELECT username FROM users"))
5734{
5735    print "$_\n";
5736}
5737
5738=item B<SEE ALSO>
5739
5740    SQLDo
5741
5742=back
5743
5744=cut
5745
5746
5747# --- Execute the SQL-Select-statement and return the result as a list ---------
5748    sub SQLSelectList ($) # Database
5749{
5750    my $cSelectCmdPI = shift;
5751
5752    my $cRecord;
5753    my $cResult;
5754    my $pStmtHdl;
5755    my $phRecord;
5756    my @lResult;
5757
5758    print STDERR ">> SQLSelectList($cSelectCmdPI)\n"
5759        if &GetAttr("DebugLvl");
5760
5761    return undef
5762        if(!defined $pDbHdlMGL);
5763
5764    $pStmtHdl = $pDbHdlMGL->prepare($cSelectCmdPI);
5765    $pStmtHdl->execute();
5766
5767    if($pStmtHdl->err())
5768    {
5769        &MyDie(sprintf(i18n("Database Error occured during %s!") . "<BR>" .
5770                       i18n("    SQL-Error: (%d) %s") . "<BR>" .
5771                       i18n("    Statement: %s") . "<BR>",
5772                       "SQLSelectList",
5773                       $pStmtHdl->err,
5774                       $pStmtHdl->errstr,
5775                       $cSelectCmdPI));
5776    }
5777
5778    while ($cRecord = join "\\,", $pStmtHdl->fetchrow_array)
5779    {
5780        print STDERR "Select: $cRecord\n"
5781            if &GetAttr("DebugLvl");
5782
5783        push @lResult, $cRecord;
5784    }
5785
5786    $pStmtHdl->finish;
5787
5788    print STDERR "<< SQLSelectList(@lResult)\n"
5789        if &GetAttr("DebugLvl");
5790
5791    return @lResult;
5792
5793}
5794
5795
5796
5797=head2 SQLDo - executes the given SQL-statement
5798
5799=over 2
5800
5801=item B<DESCRIPTION>
5802
5803    SQLDo executes the Statement, given as argument, and returns the
5804    number of affected records
5805
5806=item B<SYNOPSIS>
5807
5808    $nr_of_records = SQLDo($sql_statement);
5809
5810=item B<RETURN VALUE>
5811
5812    The number of Rows affected
5813# FIXME: What comes if an error is detected
5814
5815=item B<EXAMPLE>
5816
5817    # create a login for Joe User
5818    $nr_fo_records = &SQLDo("INSERT INTO username (username, password)
5819                             VALUES ('joe user', '42')");
5820
5821=item B<SEE ALSO>
5822
5823    SQLSelectList
5824
5825=back
5826
5827=cut
5828
5829
5830# --- Execute the SQL-Select-statement and return the result as a list ---------
5831    sub SQLDo ($) # Database
5832{
5833    my $cSelectCmdPI = shift;
5834
5835    my $cRecord;
5836    my $cResult;
5837    my $pStmtHdl;
5838    my $phRecord;
5839
5840    print STDERR ">> SQLDo($cSelectCmdPI)\n"
5841        if &GetAttr("DebugLvl");
5842
5843    $pStmtHdl = $pDbHdlMGL->prepare($cSelectCmdPI);
5844    $cResult = $pStmtHdl->execute();
5845
5846    if($pStmtHdl->err())
5847    {
5848        &MyDie(sprintf(i18n("Database Error occured during %s!") . "<BR>" .
5849                       i18n("    SQL-Error: (%d) %s") . "<BR>" .
5850                       i18n("    Statement: %s") . "<BR>",
5851                       "SQLDo",
5852                       $pStmtHdl->err,
5853                       $pStmtHdl->errstr,
5854                       $cSelectCmdPI));
5855    }
5856
5857    $pStmtHdl->finish;
5858
5859    print STDERR "<< SQLDo($cResult)\n"
5860        if &GetAttr("DebugLvl");
5861
5862    return $cResult;
5863
5864}
5865
5866
5867
5868=head2 GetAttr - Get some internal WWWdb-attributes
5869
5870=over 2
5871
5872=item B<DESCRIPTION>
5873
5874    GetAttr gets the values of some WWWdb-attributes:
5875
5876    - LastBtn
5877    - State
5878    - RecordOk
5879    - ScriptName
5880    - HostName
5881    - BaseDir
5882    - DbDriver
5883    - ConfigPath
5884    - ConfigFile
5885    - SessionId
5886    - UrlParams
5887    - LogfileName
5888    - HTMLfileName
5889    - RecIdField
5890    - RecId
5891
5892
5893=item B<SYNOPSIS>
5894
5895    $value = GetAttr($attribute_name);
5896
5897=item B<RETURN VALUE>
5898
5899    The Value of the selected Attribute
5900
5901=item B<EXAMPLE>
5902
5903    # Get the Driver of the Database
5904    $db_driver = &GetAttr("DbDriver");
5905
5906=item B<SEE ALSO>
5907
5908=back
5909
5910=cut
5911
5912
5913# --- Execute the SQL-Select-statement and return the result as a list ---------
5914sub GetAttr ($) # CGI ENV ConfigFile
5915{
5916    my $cAttrTypePI = shift;
5917    my $cResult = undef;
5918
5919  switch: for ($cAttrTypePI)
5920  {
5921      /^LastBtn$/ && do {
5922          $cResult = &MyParam("WWWdbLastBtn");
5923          last switch;
5924      };
5925
5926      /^Lang$/ && do {
5927          $cResult = &MyUserVal('WWWdb', 'Lang', 'en');
5928          last switch;
5929      };
5930
5931      /^BaseLang$/ && do {
5932          $cResult = &MyVal('WWWdb', 'Lang', 'en');
5933          last switch;
5934      };
5935
5936      /^State$/ && do {
5937          $cResult = &MyParam("WWWdbState");
5938          last switch;
5939      };
5940
5941      /^RecordOk$/ && do {
5942          &CheckRecord();
5943
5944          $cResult = (%hFieldErrorsMGL)? "": "Yes";
5945          last switch;
5946      };
5947
5948      /^ScriptName$/ && do {
5949
5950          # same as basename
5951          ($cResult = &GetAttr("BaseDir")) =~ s{.*/}{};
5952          last switch;
5953      };
5954
5955      /^WWWdbDomain$/ && do {
5956
5957          $cResult = (&UnTaint($ENV{"WWWDB_DOMAIN"})?
5958                      &UnTaint($ENV{"WWWDB_DOMAIN"}):
5959                      "WWWdb");
5960
5961          last switch;
5962      };
5963
5964      /^HostName$/ && do {
5965          $cResult = &MyVal("WWWdb", "Hostname", &UnTaint($ENV{"HTTP_HOST"}));
5966          last switch;
5967      };
5968
5969      /^DebugLvl$/ && do {
5970          $cResult = &MyUserVal('Debug', 'Level', '10') &&
5971              !!&UnTaint($ENV{"HTTP_PRAGMA"});
5972          last switch;
5973      };
5974
5975      /^BaseDir$/ && do {
5976          $cResult = (&UnTaint($ENV{"WWWDB_BASE_PATH"})?
5977                      &UnTaint($ENV{"WWWDB_BASE_PATH"}):
5978                      &UnTaint($ENV{"DOCUMENT_ROOT"}) . "/WWWdb");
5979
5980          last switch;
5981      };
5982
5983      /^DbDriver$/ && do {
5984          $cResult = (&UnTaint($ENV{"WWWDB_DATABASE"})?
5985                      &UnTaint($ENV{"WWWDB_DATABASE"}):
5986                      "Default");
5987          last switch;
5988      };
5989
5990      /^DbHandle$/ && do {
5991          $cResult = $pDbHdlMGL;
5992          last switch;
5993      };
5994
5995      /^ConfigPath$/ && do {
5996          $cResult = (&UnTaint($ENV{"WWWDB_CONFIG_FILE"})?
5997                      &UnTaint($ENV{"WWWDB_CONFIG_FILE"}):
5998                      "WWWdb/Index");
5999          last switch;
6000      };
6001
6002      /^ConfigFile$/ && do {
6003          ($cResult = (&UnTaint($ENV{"WWWDB_CONFIG_FILE"})?
6004                       &UnTaint($ENV{"WWWDB_CONFIG_FILE"}):
6005                       "WWWdb:Index")) =~ tr !/!:!;
6006          last switch;
6007      };
6008
6009      /^SessionId$/ && do {
6010          $cResult = &UnTaint($ENV{"WWWDB_SESSION_ID"});
6011          last switch;
6012      };
6013
6014      /^UrlParams$/ && do {
6015          $cResult = &UnTaint($ENV{"WWWDB_PARAMS"});
6016          last switch;
6017      };
6018
6019      /^LogfileName$/ && do {
6020          $cResult =  (&GetAttr("BaseDir") .
6021                       "/tmp/" .
6022                       &GetAttr("ScriptName") .
6023                       ($iDevelopmentVersionMGL?
6024                        "$<-$$.log": # uid-pid
6025                        "$<.log"));
6026          last switch;
6027      };
6028
6029      /^HTMLfileName$/ && do {
6030          $cResult =  (&GetAttr("BaseDir") .
6031                       "/tmp/" .
6032                       &GetAttr("ScriptName") .
6033                       "$<-$$.html"); # uid-pid
6034          last switch;
6035      };
6036
6037      /^RecIdField$/ && do {
6038          $cResult = &MyVal("Data", "IdField", "");
6039          last switch;
6040      };
6041
6042      /^RecId$/ && do {
6043          my @lKeyFields = split /, /, &GetAttr("RecIdField");
6044
6045          # scan multiple primary-keys
6046          foreach (@lKeyFields)
6047          {
6048              $_ = &GetField($_);
6049          }
6050
6051          $cResult = join ",", @lKeyFields;
6052          last switch;
6053      };
6054
6055      /^ObjectId$/ && do {
6056          $cResult = &GetAttr("RecId");
6057          last switch;
6058      };
6059      /^AppId$/ && do {
6060          $cResult = md5_hex(&GetAttr("ConfigFile"));
6061          last switch;
6062      };
6063
6064      assert($cAttrTypePI eq "defined")
6065          if &MyUserVal('Debug', 'Level', '0');
6066  }
6067
6068    return $cResult;
6069
6070}
6071
6072
6073# --- At the moment this is only hiding tainted things, without
6074#     security-checks
6075sub UnTaint($;$)
6076{
6077    my $cUnTaintExprPI  = shift || "";
6078    my $cUnTaintRegexPI = shift || "^(.*)\$";
6079
6080    if ($cUnTaintExprPI =~ m/$cUnTaintRegexPI/)
6081    {
6082        # now untainted but dangerous!!!
6083        return $1;
6084    }
6085    else
6086    {
6087        return $cUnTaintExprPI;
6088    }
6089}
6090
6091
6092
6093=head1 AUTHOR
6094
6095    Klaus Reger <K.Reger@wwwdb.org>
6096
6097    Get WWWdb at http://wwwdb.org
6098
6099=cut
6100
6101
6102# run, run, run .....
6103&Main();
6104
61051;
6106
6107
6108# -----------------------------------------------------------------------------
6109# $Log: WWWdb.cgi,v $
6110# Revision 1.49  2003/04/16 11:25:21  k_reger
6111# - Help now implemented using documents
6112#
6113# Revision 1.48  2003/04/11 13:32:35  k_reger
6114# - Localisation included directly in WWWdb
6115#
6116# Revision 1.47  2002/11/19 12:21:01  k_reger
6117# - added function GetSelectboxValues($)
6118#
6119# Revision 1.46  2002/11/18 13:58:30  k_reger
6120# - Support Target-DB
6121#
6122# Revision 1.45  2002/04/08 04:59:01  k_reger
6123# - SQL-correction for Interbase
6124# - Switch temp. to devel-Version
6125#
6126# Revision 1.44  2002/03/18 15:24:57  k_reger
6127# - prepare for 0.8.2
6128#
6129# Revision 1.43  2002/03/15 08:59:58  k_reger
6130# - Bugfix: Selectfields / radiofields now correctly translated
6131# - Enter triggers default-button
6132#
6133# Revision 1.42  2002/03/05 16:16:10  k_reger
6134# - no "use lib"
6135# - untaint all ENV-Variables (not really)
6136# - set caching off by default
6137# - set VERSION directly here
6138#
6139# Revision 1.41  2001/01/25 11:52:27  k_reger
6140# - Better date-scanning and printing
6141# - enhanced order mechanism
6142#
6143# Revision 1.40  2000/11/30 13:58:46  k_reger
6144# - design separated from function via HTML::Templates
6145#
6146# Revision 1.39  2000/11/28 16:04:58  k_reger
6147# - Extended Attributes like H1 ... H6, PRE, etc.
6148# - SSL-Support
6149# - Design done by HTML::Templates
6150# - Navigation-Elements separated
6151# - Support of perl-locales
6152# - Debug-info only after reload
6153#
6154# Revision 1.38  2000/11/17 11:53:01  k_reger
6155# - Show sub-categories of the upper categoriy too
6156# - New Attribs H1 ... H4
6157# - Replaced some constants
6158#
6159# Revision 1.37  2000/11/15 12:08:42  k_reger
6160# - BUGFIX: Sort-buttons work again now
6161# - https-link-support
6162# - Browser can force WWWdb to ignore caching
6163#
6164# Revision 1.36  2000/11/03 11:36:20  k_reger
6165# - prepared for 0.8.0
6166#
6167# Revision 1.33  2000/09/29 11:16:21  k_reger
6168# - BUGFIX: check if plugin is readable
6169# - BUGFIX: handle blanks in generated links
6170# - better HTML-Cache-handling
6171# - new operator <> (like !=)
6172# - empty values can now be selected with "" or ''
6173# - check ExtraFields too
6174# - added MustMatch.Errmsg for a clear description of the regexp
6175# - now you can set the link-color with the entries [GUI]->Link, [GUI]->ALink, [GUI]->VLink,
6176# - removed WWWdb-specific plugins here
6177#
6178# Revision 1.32  2000/09/21 07:21:05  k_reger
6179# - Better Handling of Hidden-fields
6180# - CGI::Debug
6181# - Multiple-scrolling-lists work now
6182# - User-defined Buttons are placed behind the standard-buttons
6183#
6184# Revision 1.1  2000/05/10 13:39:04  work
6185# Initial revision
6186#
6187# Revision 1.29  2000/03/30 13:50:20  klaus
6188# Checkpoint before Release 0.0.7
6189#
6190# Revision 1.28  2000/03/24 09:49:20  klaus
6191# Checkpoint
6192#
6193# Revision 1.1  2000/03/06 14:10:09  work
6194# Initial revision
6195#
6196# Revision 1.27  2000/02/24 11:27:04  klaus
6197# - Internationalization
6198# - New OO-Classes
6199#
6200# Revision 1.1  2000/02/09 09:50:44  work
6201# Initial revision
6202#
6203# Revision 1.26  2000/02/02 23:38:48  klaus
6204# Second preparing WWWdb for 0.0.6
6205#
6206# Revision 1.25  2000/02/02 21:38:43  klaus
6207# Preparing WWWdb for 0.0.6
6208#
6209# Revision 1.24  2000/01/10 15:38:14  klaus
6210# Html-Tables in OO now
6211#
6212# Revision 1.23  1999/12/22 13:02:53  klaus
6213# Last corrections before 0.0.5
6214#
6215# Revision 1.22  1999/12/21 17:55:40  klaus
6216# New features of WWWdb-0.0.5:
6217#      System:
6218#          New General form layout (FormHeader, Navigation, TableHeader, Application-area,
6219#          TableFooter, FormFooter)
6220#          New Plugin: PreDoAction
6221#          New Plugins: FormHeader, TableHeader, TableFooter, FormFooter
6222#          Navigation through hierarchy
6223#          Navigation through search-words
6224#          Default-session-id is now 0000000000000000
6225#          File-hierarchy of configfiles is now possible: x/y/z => x:y:z
6226#          Passing parameters via URL in the form URL;Param=Value
6227#          New config-entries for simple field checking / converting: Mandatory, MustMatch,ToUpper, ToLower
6228#          The navigation column is generated from database
6229#          Query-fields can be attributed
6230#          Different ways to select a record in the browse: Btn, Check, None (implies selection via link)
6231#          Vertical alignment of single entries
6232#          Generate WWWdb-References in Labels
6233#     API:
6234#          ResolveRefField - Resolve a WWWdb-Reference for HTML
6235#          InternalFieldCheck - perform the default-checks for a field
6236#          Get-Attr - Get WWWdb Attributes
6237#          ConfigPath - the file-path of the config-file
6238#          UrlParams - the params passed by the URL
6239#          GetLastBtn - -deleted-
6240#     Applications:
6241#          Navigation in wwwdb via hierarchy or search-words
6242#          Edit navigation-categories
6243#          Edit navigation-objects
6244#          Link category and object
6245#          Edit docu-entries
6246#
6247# Revision 1.21  1999/12/06 10:44:26  klaus
6248# - implemented file-hierarchy
6249#
6250# Revision 1.20  1999/12/02 15:19:02  klaus
6251#  - New General Table-Layout
6252#  - If config-file is missing, we take Empty.rc
6253#  - New Plugins:
6254#    + PreDoAction
6255#    + FormHeader, TableHeader, TableFooter, FormFooter
6256#  - Generated menu-structure (from database)
6257#  - Different way to select records in Qry-Mode
6258#  - Default session-id is now 0000000000000000
6259#  - a : in url generates a file hierarchy (x:y:z => x/y/z)
6260#  - pass params via the url in the form url;param=value[;paramn=valuen]
6261#  - API-function GetLastBtn deleted
6262#
6263# Revision 1.19  1999/11/23 15:43:09  klaus
6264# New lib-directory
6265#
6266# Revision 1.18  1999/11/22 09:13:13  klaus
6267# - Last bugfixes before 0.0.4
6268#
6269# Revision 1.17  1999/11/19 14:29:10  klaus
6270# - Last corrections before 0.0.4
6271#
6272# Revision 1.16  1999/11/19 12:42:35  klaus
6273# - Corrections after installation on pc01
6274#
6275# Revision 1.15  1999/11/18 15:00:51  klaus
6276# - New Help-Interface
6277# - Login now crypted
6278#
6279# Revision 1.14  1999/11/15 13:52:36  klaus
6280# - HTML-output buffered
6281# - WWWdb_(Pre|Post).(rc|pl)
6282# - own tmp-directory
6283# - little customizations  for qry-mode
6284# - enhancement of debug-trace-utilities
6285# - API: GetAttr()
6286#
6287# Revision 1.13  1999/11/11 14:15:48  klaus
6288# Corrections after internal installation
6289#
6290# Revision 1.12  1999/11/11 13:22:49  klaus
6291# Snapshot for internal installation
6292#
6293# Revision 1.11  1999/11/02 12:01:58  klaus
6294# Check-in to store actual state
6295#
6296# Revision 1.10  1999/10/22 11:06:06  klaus
6297# - Corrections of the data-conversion between Db and Html-Form
6298#
6299# Revision 1.9  1999/10/21 13:35:05  klaus
6300# - Select and Radio-Fields can now be filled with SQL
6301# - WWWdb is now "-w"-proof
6302# - Database-Errors are now shown uniquely
6303#
6304# Revision 1.8  1999/10/20 13:01:34  klaus
6305# Version 1.0.3
6306# - Getting field-type-information
6307# - Plugins to convert DB-data to Form-data and vice versa
6308# - New API-functions
6309#    $current_state = GetState();
6310#    $cust_type = GetFieldTypeName($field_name);
6311#
6312# BUGFIX:
6313# -kfm, lynx and w3m seem to work now
6314#
6315# Revision 1.7  1999/10/08 13:48:09  klaus
6316# - Selection-Boxes and radio-fields now can have labels
6317# - plugins: API-Documentation
6318# - Perl-makefile integrated
6319#
6320# Revision 1.6  1999/10/07 13:56:20  klaus
6321# - Security-Bugfix: HTML-Entities decoded
6322# - Internal state perfixed with WWWdb
6323# - Adding file README.application
6324# - Enhancements of index.html
6325#
6326# Revision 1.5  1999/10/06 08:42:13  klaus
6327# Checkpoint before copying to WWW-server
6328#
6329# Revision 1.4  1999/10/06 06:49:19  klaus
6330# Sync 06.10.99
6331#
6332# Revision 1.3  1999/10/06 06:21:08  klaus
6333# Sync with KR's work at home.
6334#
6335# Revision 1.2  1999/09/28 13:12:53  klaus
6336# Bugfixes
6337#
6338# Revision 1.1.1.1  1999/09/27 08:50:26  klaus
6339# Integration in CVS
6340#
6341# Revision 1.1.1.1  1999/09/27 08:09:51  klaus
6342# Imported using tkCVS
6343#
6344# Revision 1.10  1999/09/21 08:34:33  klaus
6345# - Anzeige von Fehlern in der Konfigurations-Datei
6346# - Update/Query-Felder getrennt konfigurierbar
6347# - Neue Attribute:
6348#   Align, BgColor, NoWrap, Big, Blink, Bold, Italic, Small
6349#   Font, Disabled, Readonly, Tabindex, Title
6350# - Neue Input-Felder:
6351#   Password, Area, Hidden, Radio, Checkbutton
6352# - Position kann nun auch als Offset angegeben werden
6353#
6354# Revision 1.9  1999/09/17 14:07:26  klaus
6355# - Konfigurationsdatei zur Steuerung
6356#   + Datenbank-Verbindung
6357#   + Allgemeines Tabellenlayout
6358#   + Label
6359#   + Textfelder
6360#   + Select-Buttons
6361#
6362# Revision 1.8  1999/09/13 14:10:04  klaus
6363# - Hilfs-informationen
6364# - letzte Version vor Verallgemeinerung
6365#
6366# Revision 1.7  1999/09/07 09:33:40  klaus
6367# - Funktionen zum Browsen der Daten
6368# - Normierung der Telefon-Nummern
6369# - Assertions eingebaut
6370# - Fehler-Meldungen über OK-Form
6371#
6372# Revision 1.6  1999/09/02 12:43:22  klaus
6373# - Farb- und Font Korrekturen
6374# -> Dies ist die erste freigegebene Alpha-Version
6375#
6376# Revision 1.5  1999/09/01 13:55:40  klaus
6377# - Korrekte Fehlerbehandlung
6378# - Konsistente Verwaltung der Übergabe-Parameter
6379#
6380# Revision 1.4  1999/09/01 07:20:50  klaus
6381# - Folgende DB-Funktionen eingebaut:
6382#   + Änderung
6383#   + Löschung
6384# - Oracle-Anbindung läuft nun korrekt
6385# - DB-Meldungen als OK-Forms
6386#
6387# Revision 1.3  1999/08/31 10:46:13  klaus
6388# Nun funktionieren folgende DB-Funktionen:
6389# - Neuanlage
6390# - Suche
6391# - Auswahl von Sätzen
6392#
6393# Revision 1.2  1999/08/26 12:20:40  klaus
6394# Aller unnötiger HTML-Code entfernt
6395#
6396# Revision 1.1  1999/08/25 07:33:05  klaus
6397# Initial revision
6398#
6399#
6400# -----------------------------------------------------------------------------
6401