#!/usr/bin/perl
#/*====================================================================
# * Babel Objects, Version 1.0
# * ====================================================================
# *
# * Copyright (c) 2000 The Babel Objects Network. All rights reserved.
# *
# * This source file is subject to version 1.1 of The Babel Objects
# * License, that is bundled with this package in the file LICENSE,
# * and is available through the world wide web at :
# *
# *          http://www.BabelObjects.Org/law/license/1.1.txt
# *
# * If you did not receive a copy of the Babel Objects license and are
# * unable to obtain it through the world wide web, please send a note
# * to license@BabelObjects.Org so we can mail you a copy immediately.
# *
# * --------------------------------------------------------------------
# *
# * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
# * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
# * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# * DISCLAIMED.  IN NO EVENT SHALL THE BABEL OBJECTS NETWORK OR
# * ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
# * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
# * USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
# * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
# * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
# * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# * SUCH DAMAGE.
# *
# * ====================================================================
# *
# * This software consists of voluntary contributions made by many
# * individuals on behalf of The Babel Objects Network.  For more
# * information on The Babel Objects Network, please see
# * <http://www.BabelObjects.org/>.
# *
# */

my $CFG_DIR = "/usr/local/babelobjects/conf";
my $CFG = "$CFG_DIR/bo.xml";

use Carp;
use strict;

use BabelObjects::Util::Dvlpt::Log;
use BabelObjects::Runner::Initializer;
use BabelObjects::Runner::RunData;
use BabelObjects::Runner::Dispatcher;

use CGI::Fast;
use XML::DOM;
 
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);

require Exporter;
require AutoLoader;

@ISA = qw(Exporter AutoLoader);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(
);
$VERSION = '1.00';

my $aLog;
my $doc;
my %parameters;
my $confParameters;
my $count = 0;
 
#
$aLog = new BabelObjects::Util::Dvlpt::Log;
init();
 
#my $q = new CGI;
while (my $q = new CGI::Fast) {
    service($q); 
}

##
 
sub init {
    initParameters(); 
} 
 
sub initParameters {
    my %parameters;
 
    $parameters{"cfg"} = $CFG;
    my $aInitializer = new BabelObjects::Runner::Initializer(\%parameters);
    $confParameters = $aInitializer->getParameters();
} 

sub service {
    my $req = shift;
 
    if ($req->param('init') eq "parameters") {
    }
 
    %parameters = ();

    $parameters{"req"} = $req;
    $parameters{"confParameters"} = $confParameters;
    my $aRunData = new BabelObjects::Runner::RunData(\%parameters);

    %parameters = ();

    $parameters{"runData"} = $aRunData;

    #print "CONF Parameter = ", $aRunData->getConfParameter(
    #                                         $aRunData->getParameter("module"),
    #                                         $aRunData->getParameter("parameter")); 

    my $aDispatcher = new BabelObjects::Runner::Dispatcher(\%parameters);
#    if () {
# 
#    } else {
        my $target = $aDispatcher->parseAndExecuteTransition();
        #$aLog->log("Target = $target");
        if ($target =~ m!^\w*://!) {
            # We consider it's an URL. We should do better
            print $req->redirect($target);
        } else {
            print("Content-type: text/html\r\n\r\n");
            $aDispatcher->parseFile($target);
        }
#    }
}
 
sub AUTOLOAD {
    my $self = shift;
    my $type = ref($self) or croak "$self is not an object";
 
    my $name = $AUTOLOAD;
    $name =~ s/.*://;   # strip fully-qualified portion
 
    unless (exists $self->{_permitted}->{$name} ) {
        #croak "Can't access `$name' field in class $type";
        # On intercepte ici les erreurs liées aux tentatives d'appel
        # des méthodes inexistantes
        #print "Dispatcher AUTOLOAD = $AUTOLOAD\n";
        return $AUTOLOAD;
    }
 
    if (@_) {
        return $self->{$name} = shift;
    } else {
        return $self->{$name};
    }
}
 
1;

__END__
# Below is the stub of documentation for your module. You better edit it!

=head1 NAME

BabelObjects::Runner::Controller - Perl extension for blah blah blah

=head1 SYNOPSIS

  use BabelObjects::Runner::Controller;
  blah blah blah

=head1 DESCRIPTION

Stub documentation for BabelObjects::Runner::Controller was created by h2xs. It looks like the author of the extension was negligent enough to leave the stub unedited.

Blah blah blah.

=head1 AUTHOR

Jean-Christophe Kermagoret jck@babelo.org (http://www.BabelObjects.Org)

=head1 SEE ALSO

perl(1).

=cut