# <COPYRIGHT>
# Copyright 2002 Joachim Schrod Network and Publication Consultance GmbH,
#                Gerd Stolpmann
#
# <GPL>
# This file is part of WDialog.
#
# WDialog is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# WDialog is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with WDialog; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
# </>
#

# $Id: Stubs.pm,v 3.3 2002/02/28 18:50:44 stolpmann Exp $
# ----------------------------------------------------------------------
#

package UI::Stubs;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

use vars qw($WDIALOG_MAJOR_VERSION);   # new with version 2

use vars qw($back_button $cgi_for_parsing $cgi_for_printing $mod_perl);

require Exporter;
require DynaLoader;
require AutoLoader;

use File::Basename;

@ISA = qw(Exporter DynaLoader);
@EXPORT_OK = qw( init reset work param );
$VERSION = '0.01';

# Turn on special checking for Doug MacEachern's modperl
if (exists $ENV{'GATEWAY_INTERFACE'}) {
    $mod_perl = $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl\//;
};

$WDIALOG_MAJOR_VERSION = 2;

$cgi_for_parsing = $mod_perl;
# Whether to use Perl's CGI module to parse the arguments

$cgi_for_printing = $mod_perl;
# Whether to use Perl's CGI module to print the result

$back_button = 0;
# Whether to allow the back button

# Load the O'Caml interpreter:
bootstrap UI::Stubs $VERSION;

# Look up the file stubs.byte containing the O'Caml bytecode:
my $stubsdir;
foreach my $d (@INC) {
    if (-e "$d/UI.byte") {
	$stubsdir = $d;
	last;
    }
}
UI::Stubs::caml_startup("$stubsdir/UI.byte");

# Make that the dependent libraries of the O'Caml interpreter can
# link with the interpreter (= RTLD_GLOBAL):
sub dl_load_flags { 0x01 }


# Preloaded methods go here.

sub reset {
  UI::Stubs::caml_reset(1);
}


sub init {
    my %options = @_;

    $cgi_for_parsing  = $options{'CGI_for_parsing'} != 0;
    $cgi_for_printing = $options{'CGI_for_printing'} != 0;
    $back_button      = $options{'Back_button'} != 0;
}


sub work {
    my ($error_handler) = @_;

    # Parse the application etc.
    my $uifile;
    my $self_url;

    my $script_name = $ENV{'SCRIPT_NAME'};
    my ($script_base, $script_path, $suffix) =
      fileparse($script_name, '\.[a-zA-Z0-9]*');

    if ($script_base eq '') {
	$script_base = 'index';
	$suffix = '.cgi';
    };

    if (-e "$script_base.ui.bin") {
	$uifile = "$script_base.ui.bin"
    } elsif (-e "$script_base.ui") {
	$uifile = "$script_base.ui";
    } else {
	die "No ui file";
    };

    $self_url = "./$script_base$suffix";

    UI::Stubs::setup($uifile);

    if ($cgi_for_parsing) {
	i_want_perl_cgi();
    };

    my $error_page = sub {
	my ($msg) = @_;
	if (defined($error_handler)) {
	    return &$error_handler($msg);
	} else {
	    return "O'Caml Error: $msg\n";
	};
    };

    if ($cgi_for_printing) {
	require CGI;
	my $query = new CGI;
	my $result = UI::Stubs::process_request_noprint($error_page, $self_url, 1);
	if ($back_button) {
	    print $query->header(-type => 'text/html');
	} else {
	    print $query->header(-type => 'text/html',
				 -cache_control => 'no-cache',
				 -pragma => 'no-cache');
	};
	print $result;
    } else {
      UI::Stubs::process_request( $error_page, $self_url,  ! $back_button );
    };

    UI::Stubs::reset();
}


use Carp;

sub param {
    my ($name) = @_;
    return UI::Stubs::cgi_param("$name");
}


sub i_want_perl_cgi {
    require CGI;
    my $query = new CGI;
    $query->private_tempfiles(0);      # do not immediately delete tempfiles
    my @names = $query->param();
    foreach my $name (@names) {
	# I do not know how to distinguish between normal parameters and
        # file upload parameters in general. So we use the name.
	if ($name =~ /^upload_/) {
	    my $file = $query->param($name);
	    my $info = $query->uploadInfo($file);
	    my $mimetype = $info->{'Content-Type'};
	    # Undocumented knowledge about CGI.pm:
	    my $sysfile = $query->tmpFileName($file);
  	    UI::Stubs::cgi_add_upload($name, "$file", $mimetype, $sysfile);
	} else {
	    my $value = $query->param($name);
	    UI::Stubs::cgi_add_param($name, $value);
	};
    };
    UI::Stubs::cgi_set(1);
}

# Register cleanup:
#if ($mod_perl) {
#    # DOES NOT WORK YET!!!
#    my $r = Apache->request();
#    $r->register_cleanup( sub {
#      UI::Stubs::reset;
#    });
#}


# Autoload methods go after =cut, and are processed by the autosplit program.

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

=head1 NAME

UI::Stubs - Interface to the UI object toolkit

=head1 SYNOPSIS

  use UI::Stubs;

  UI::Stubs::init(CGI_for_parsing => 1, CGI_for_printing => 1, Back_button => 1);

  UI::Stubs::reset();

  UI::Stubs::work();

  my $value = UI::Stubs::param("name");


=head1 DESCRIPTION

This is the low-level component of the UI object toolkit. There are many
functions, but most of them are only provided as stub functions for the
other UI modules. You may invoke the functions 'init', 'reset', 'work'
and 'param'.


=head1 init

1) Configures whether the CGI implementation of perl or the CGI implementation
of O'Caml is used. The subroutine has two named parameters:

  init(CGI_for_parsing => 1, CGI_for_printing => 0);

Setting the parameter C<CGI_for_parsing> to 1 lets the system use the
implementation of Perl to parse CGI parameters (input side). 0 means
to use O'Caml's implementation.

Setting the parameter C<CGI_for_printing> to 1 lets the system use the
implementation of Perl to print the result (output side). 0 means
to use O'Caml's implementation.

By default, the O'Caml implementation is selected. However, if the
module is used in a modperl environment, only the Perl implementation
works and is selected automatically.

2) Configures whether the "Back button" of the browser works:

  init(Back_button => 1);


=head1 reset

Resets the internal state of the system.


=head1 work

This is the main entry point to the XML processor. Invoking C<work> loads
the ui definition, parses the CGI parameters, and processes the request.
Finally, the generated HTML page is written to stdout.

This function has an optional argument: the error handler. If passed,
this argument must be a closure that returns the HTML text to display
in the browser. The closure gets the error message as input. Example:

work( sub { my $msg = shift; return "<B>Error: $msg</B>" } )


=head1 param

You can get the value of the CGI parameter $n by calling

    my $value = param($n);

This works independently of the selected CGI implementation.


=head1 AUTHOR

Gerd Stolpmann, NPC GmbH

=cut

# ======================================================================
# History:
#
# $Log: Stubs.pm,v $
# Revision 3.3  2002/02/28 18:50:44  stolpmann
# 	Continued with perlapi (lots of bugfixes)
#
# Revision 3.2  2002/02/14 16:24:13  stolpmann
# 	Added copyright notice
#
# Revision 3.1  2002/02/12 23:11:25  stolpmann
# 	Initial revision at sourceforge
#
# Revision 1.7  2002/01/21 14:25:36  gerd
# 	Changed for upcoming WDialog 2
#
# Revision 1.6  2000/12/13 17:18:32  gerd
# 	Another mini bugfix
#
# Revision 1.5  2000/12/13 17:14:36  gerd
# 	Fix for NS Enterprise.
#
# Revision 1.4  2000/12/06 17:53:36  gerd
# 	Updated.
#
# Revision 1.3  2000/05/17 13:54:00  gerd
# 	Minor fix.
#
# Revision 1.2  2000/04/17 10:12:55  gerd
# 	Improved file upload.
# 	Furthermore, the traditional CGI.pm package can be used,
# if the user prefers this.
#
# Revision 1.1  2000/04/13 17:42:52  gerd
# 	Initial revision.
#
#