#################### main pod documentation begin ###################

=head1 NAME

  ZymonicMP - Zymonic mod_perl Handler module

=head1 SYNOPSIS

TODO

=head1 DESCRIPTION

TODO

=head1 INSTALLATION

1. When using ZymonicMP it's extremely important to make sure
MaxClients is less than max number of connections allowed by
Apache.

=head1 USAGE

=head1 BUGS

None we're aware of...

=head1 SUPPORT

As in the license, Zymonic is provided without warranty or support
unless purchased separately, however... If you email 
zymonic-support@zednax.com your issue will   be noted and may 
receive a response.

For security issues, please contact zymonic-security@zednax.com and
someone will respond within 8 working hours.


=head1 AUTHOR

    Alex Masidlover et al.
    CPAN ID: MODAUTHOR
    Zednax Limited
    alex.masidlover@zednax.com
    http://www.zednax.com

=head1 COPYRIGHT

This program is free software licensed under the...

	Zymonic Public License 1.0

The full text of the license can be found in the
LICENSE file included with this module.

Other licenses may be acceptable if including
parts of Zymonic in larger projects, please
contact Zednax for details. 


=head1 SEE ALSO

perl(1).

=cut

#################### main pod documentation end ###################

package Zymonic::MP;

use strict;
use warnings;

use Zymonic;
use Zymonic::Session;
use Zymonic::Config;
use Zymonic::DB;
use Zymonic::Auth;
use Zymonic::Utils qw(clean debug rethrow_exception deep_replace_card_numbers);

use Data::Dumper;
use XML::Simple;

use Apache2::RequestRec ();
use Apache2::RequestIO  ();
use Apache2::Connection ();
use Apache2::Response   ();
use Apache2::Cookie;
use Apache2::Const;
use CGI::Apache2::Wrapper;
use CGI::Apache2::Wrapper::Cookie;

use Apache2::Const -compile => qw(OK :http);

BEGIN
{
    use Exporter ();
    use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
    $VERSION = '0.01';
    @ISA     = qw(Exporter);

    #Give a hoot don't pollute, do not export more than needed by default
    @EXPORT      = qw();
    @EXPORT_OK   = qw();
    %EXPORT_TAGS = ();
}

#################### subroutine header begin ####################

=head2 inner_handler

 Usage     : ZymonicMP::inner_handler
 Purpose   : Is a mod_perl response handler for Zymonic. The 
 'inner' version does the work and can be wrapped in an eval
 for exception handling purposes.
 Returns   : a suitable response for mod_perl.
 Argument  : a mod_perl reference
 Throws    : nothing
 Comment   : TODO

See Also   : 

=cut

#################### subroutine header end ####################

sub inner_handler : method
{
    my ( $class, $r ) = @_;
    my $fh;

    # Clear the globals
    $Zymonic::session                             = '';
    $Zymonic::system                              = '';
    $Zymonic::Utils::debug_function_nesting_level = 0;
    @Zymonic::Utils::debug_function_times         = ();

    # Config Vars
    my $saxon = 0;

    # XML out
    my $xmlout;

    # Global objects
    my $db;
    my $auth;

    # Clear @HISTORY first...
    Zymonic::Utils::clear_history();

    my $protocol = ( ( defined( $ENV{HTTPS} ) and $ENV{HTTPS} eq 'on' ) ? 'https' : 'http' );

    # Clean path
    $ENV{PATH} = "/bin:/sbin:/usr/bin:/usr/sbin:/usr/local/sbin:/bin:/usr/bin:/sbin:/usr/sbin";

    # set binmode for STDOUT and STDERR to handle unicode
    binmode STDOUT, ':utf8';
    binmode STDERR, ':utf8';

    # setup the field factory
    $Zymonic::field_factory = Zymonic::FieldFactory->new();

    # enable cache for table includes and relationship permissions
    $Zymonic::object_cache = { 'Zymonic::TableInclude' => {}, 'Zymonic::RelationshipPermissions' => {}, };

    # reset tabindex for this request
    $Zymonic::tabindex = 0;

    # Create a session object
    $Zymonic::session = Zymonic::Session->new(
        parent          => $class,
        cgi             => CGI::Apache2::Wrapper->new($r),
        r               => $r,
        ip_address      => clean( $ENV{REMOTE_ADDR} ),
        x_forwarded_for => clean( $ENV{HTTP_X_FORWARDED_FOR} ) || '',
        protocol        => $protocol
    );

    # Load the config - use the requested system config, or the system config for the server
    # or the first system found in the config directory.
    $Zymonic::system = $Zymonic::session->system_name( clean( $r->hostname, "-_" ), "/etc/zymonic" );

    # Create a DB object for this instance

    debug("Zymonic starting... system: $Zymonic::system");
    if ( ref( $Zymonic::ZCONFIG{$Zymonic::system} ) =~ /Config/ )
    {
        $Zymonic::ZCONFIG{$Zymonic::system}->load_system_definition();
        $Zymonic::ZCONFIG{$Zymonic::system}->load();
    }
    else
    {
        $Zymonic::ZCONFIG{$Zymonic::system} = Zymonic::Config->new(
            parent      => $class,
            system_name => $Zymonic::system,
            config_dir  => "/etc/zymonic",
        );

    }

    # Check for no display mode
    my $no_display_attributes = $Zymonic::session->no_display_attributes;

    my $redirect_url = '';

    # Make the database connection (Config already has a connection
    # but we can't use that as its global to all the instances and in
    # a multi-threaded environment its not possible to rule out a
    # future set-up where one instance may get another's last_insert_id).
    $db = Zymonic::DB->new( parent => $class, config => $Zymonic::ZCONFIG{$Zymonic::system} );

    $Zymonic::session->{DB} = $db;

    $auth = Zymonic::Auth->new(
        parent      => $class,
        config      => $Zymonic::ZCONFIG{$Zymonic::system},
        session     => $Zymonic::session,
        DB          => $db,
        user        => '',
        credentials => '',
        logged_in   => '',
        ip_address  => $Zymonic::session->{ip_address}
    );

    # Initialise the session fully
    $Zymonic::session->initialise_session(
        {
            config => $Zymonic::ZCONFIG{$Zymonic::system},
            auth   => $auth,
            DB     => $db
        }
    );

    # check if servside xslt is required
    $saxon = $Zymonic::session->server_side_xslt();

    # build documentation if needed
    if ( $Zymonic::session->build_documentation )
    {
        eval {
            $Zymonic::ZCONFIG{$Zymonic::system}->build_documentation($auth);
            1;
        } or do
        {

            # don't let any exceptions here bring the system down
            # debug it but ignore it
            my $exception = $@;
            if ($exception)
            {
                if ( ref($exception) and $exception->isa('Zymonic::Exception') )
                {
                    debug_exception($exception);
                }
                else
                {
                    debug( 'Unknown Exception (or a die): ' . Dumper($exception) );
                }
            }
        };
    }

    eval {
        $xmlout = $Zymonic::session->view_control($no_display_attributes);
        1;
    }
      or do
    {
        my $exception = $@;
        if ( $exception and ref($exception) and $exception->isa('Zymonic::Exception::State::Redirect') )
        {
            $redirect_url = $exception->redirect_url;
        }
        else
        {
            rethrow_exception($exception);
        }
    };

    unless ( defined( $xmlout->{css} ) and $xmlout->{css} )
    {
        $xmlout->{css} = "/ZymonicDefault.css";
    }

    # check for custom xsl
    my $zz_xsl = $Zymonic::session->clean_param( 'ZZxsl', '/\\-._' );
    my $xsl = $zz_xsl || $Zymonic::session->xsl();
    my $xsl_with_path = $Zymonic::ZCONFIG{$Zymonic::system}->{htmlroot};
    unless ($xsl)
    {
        if ( ref( $xmlout->{currentpage} ) && $xmlout->{currentpage}->{xsl} )
        {
            $xsl = $xmlout->{currentpage}->{xsl};
        }
        elsif ( $Zymonic::ZCONFIG{$Zymonic::system} )
        {
            $xsl = $Zymonic::ZCONFIG{$Zymonic::system}->{xslt};
        }
    }

    my $language = $Zymonic::session->language;

    if (  -f $Zymonic::ZCONFIG{$Zymonic::system}->{htmlroot} . "/"
        . $language->{lang_code} . "-"
        . $language->{subset} . "/"
        . $xsl )
    {
        $xsl = "/" . $language->{lang_code} . "-" . $language->{subset} . "/" . $xsl;
    }

    if ($redirect_url)
    {
        print $Zymonic::session->redirect($redirect_url);
    }
    else
    {

        # Output the XML
        my $output_xml_string = $Zymonic::session->convert_to_xml($xmlout);
        if (   $Zymonic::ZCONFIG{$Zymonic::system}->{debug_io_xml}
            && $Zymonic::ZCONFIG{$Zymonic::system}->{debug_io_xml} eq 'true' )
        {
            debug( "Outgoing XML: " . deep_replace_card_numbers($output_xml_string), 'true' );
        }

        # if no ZZxsl and param to suppress XSL or API mode, then don't output XSL info
        if ( !$zz_xsl && ( $Zymonic::session->clean_param("notransform") or $no_display_attributes ) )
        {
            print $Zymonic::session->header;
            print $output_xml_string;
        }
        elsif ( !$saxon )
        {
            print $Zymonic::session->header;
            print "<?xml-stylesheet href=\"" . $xsl . "\" type=\"text/xsl\"?>\n";
            print $output_xml_string;
        }
        else
        {
            open( XT, ">:encoding(UTF-8)", "/tmp/xml.$$" );
            print XT $output_xml_string;
            close(XT);

            debug("Server Side XSLT: /usr/local/bin/saxon /tmp/xml.$$ $xsl_with_path/$xsl");
            print $Zymonic::session->header( type => 'text/html' );
            `/usr/local/bin/saxon /tmp/xml.$$ $xsl_with_path/$xsl >/tmp/html.$$`;
            open( HT, "<:encoding(UTF-8)", "/tmp/html.$$" );
            print $_ while (<HT>);
            close(HT);
            `rm /tmp/html.$$`;
        }
    }

    if ( defined $fh )
    {
        close($fh);
    }

    $Zymonic::session->{DB}->close_db_connection();
    $Zymonic::session->DESTROY;

    # Clear the globals
    $Zymonic::session = '';
    $Zymonic::system  = '';
    return ( !$redirect_url ) ? Apache2::Const::OK : Apache2::Const::HTTP_MOVED_TEMPORARILY;

}

#################### subroutine header begin ####################

=head2 handler

 Usage     : ZymonicMP::handler
 Purpose   : Is a mod_perl response handler for Zymonic.
 Returns   : a suitable response for mod_perl.
 Argument  : a mod_perl reference
 Throws    : nothing
 Comment   : TODO

See Also   : 

=cut

#################### subroutine header end ####################

sub handler : method
{
    my ( $class, $r ) = @_;

    my $resp = {};

    my $error;

    eval {
        $resp = $class->inner_handler($r);
        1;
    }
      or do
    {
        if ( ref($@) and ref($@) =~ /Zymonic::Exception::Session::URI_ERROR/ )
        {
            $resp = Apache2::Const::NOT_FOUND;
        }
        else
        {

            $error = Zymonic::Utils::death_handler( $@, 'from mod_perl', 'return_error' );
            $r->custom_response( Apache2::Const::SERVER_ERROR, $error->{message}->{content} );
            $resp = Apache2::Const::SERVER_ERROR;
        }
    };

    return $resp;

}

1;