#!/usr/bin/perl
# -----------------------------------------------------------------------------
# TWC
# Treuwert-Computer GmbH
# Schloßbergring 9
# 79098 Freiburg
#
# -----------------------------------------------------------------------------
# Program-Data
# -----------------------------------------------------------------------------
# Project  :
# System   :
# Program  :
# Modul    : $RCSfile: TestWWWdb.pl,v $
# Version  : $Revision: 1.3 $
# Date     : $Date: 2003/04/16 11:35:16 $
# State    : $State: Exp $
#
# Description:
#   This module maps adresses of the form
#   http://myhost/wwwdb/<Database>/<config-file>
#   to the real call of WWWDb
#
# -----------------------------------------------------------------------------

use Getopt::Std;
use File::Basename;
use English;

use vars qw($opt_b $opt_c $opt_d $opt_D $opt_V);
use strict;

use constant APACHE_BASE_PATH => "/var/www/";

$main::cVersionMGL = '$Date: 2003/04/16 11:35:16 $$Revision: 1.3 $ ';
$main::cProgramMGL = basename($0);


getopts("b:cdDV") || Usage();

# Print version
if ($opt_V)
{
    print "$0: $main::cVersionMGL\n";
    exit;
}

Usage() unless @ARGV;

Start_WWWdb(shift);


# --- show the usage of the script  ---------------------------------------------
sub Usage()
{
    print <<EOF;

$main::cProgramMGL: usage
     $main::cProgramMGL [-D] [-b <Button>] URI

        -b      Emulates the Button Btn<Button>
        -c      Detect the Coverage (module Devel::Coverage needed)
        -d      Start the normal perl Debugger
        -D      Start the graphicla debugger DDD

    Description:
        $main::cProgramMGL is a Debugging-frontend for WWWdb.cgi.

EOF
    exit 0;
}



# --- This Routine gets linked into the Apache-Server -----------------------
sub ConvertUri ($)
{
   my $cOrigUri = shift;

   my $cApplication;
   my $cDatabase;
   my $cJunk;
   my $cNewUri;
   my $cParam;
   my $cSessionId;
   my $cWWWdb;
   my @lRest;



   ($cWWWdb, @lRest) = split '/', $cOrigUri;

   unless ($cWWWdb =~ /^wwwdb(_devel)?$/)
   {
      return 0;
   }

   $cWWWdb =~ s/www/WWW/;

   $cNewUri = "/cgi-bin/$cWWWdb.cgi";

   # Look, if we have a session-id
   if ($lRest[0] =~ /^[0-9a-h]{16}$/)
   {
      $cSessionId = shift @lRest;
   }
   else
   {
      $cSessionId = "ffffffffffffffff";
   }

   $ENV{'WWWDB_SESSION_ID'} = $cSessionId;

   $cDatabase    = (@lRest)? shift @lRest: 'Default';
   $cApplication = (@lRest)? shift @lRest: 'WWWdb/Index';
   $cParam       = "";

   # Generate a directory-path
   $cApplication =~ s.:./.g;

   $ENV{'WWWDB_BASE_PATH'}   = (APACHE_BASE_PATH .
                                "$cWWWdb");
   $ENV{'WWWDB_DATABASE'}    = $cDatabase;


   if ($cApplication =~ /([^;]*)(;(.*))/)
   {
      $cApplication = $1;
      $cParam       = $3;
   }

   $ENV{'WWWDB_CONFIG_FILE'} = $cApplication;
   $ENV{'WWWDB_PARAMS'}      = $cParam;

   return $cNewUri;
}



sub Start_WWWdb()
{
   my $cUri = shift;
   my $cBaseName;
   my $cScriptName;
   my $cStateFile;
   my $cCmd;

   &ConvertUri($cUri);

   ($cBaseName = $ENV{'WWWDB_BASE_PATH'}) =~ s{.*/}{};
   $cStateFile = ($ENV{'WWWDB_BASE_PATH'} .
                  "/tmp/" .
                  $cBaseName .
                  "_state.log");

   $cCmd = (($opt_b? "echo Btn$opt_b=$opt_b | ": "") .
            "cat - $cStateFile | " .
            ($opt_D? "ddd ": "perl ") .
            ($opt_d? "-d ": "") .
            ($opt_c? "-d:Coverage ": "") .
            $ENV{'WWWDB_BASE_PATH'} .
            "/" .
            "WWWdb.cgi" .
            " <" .
            $cStateFile
            );

   print STDERR ("Perl Command:\n$cCmd\n");
   print STDERR ("ENV:\n");
   foreach (grep /^WWWDB/, keys %ENV)
   {
      print STDERR ("$_ => $ENV{$_}\n");

   }

   print STDERR "Use this CGI-Params:\n" .
       `cat $cStateFile`;

   system($cCmd);

   print "\n";
}