#################### 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...

	Alfresco 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 ZymonicMP;

use strict;
use warnings;

use Zymonic;
use Zymonic::Session;
use Zymonic::Config;
use Zymonic::DB;
use Zymonic::Auth;
use Zymonic::Utils qw(clean debug);
use XML::Simple;

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

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

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;

    # Config Vars
    my $saxon = 0;

    # System locked flag (when updating DB/Cache copy)
    my $locked_and_type = 0;

    # XML out
    my $xmlout;

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

    # Set up debug file if parameter defined
    if ( $r->dir_config('ZymonicDebugFile') )
    {
        open $fh, ">" . $r->dir_config('ZymonicDebugFile');
        $Zymonic::Utils::debugfile = $fh;
    }

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

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

    # Create a session object
    my $session = Zymonic::Session->new(
        cgi        => CGI::Apache2::Wrapper->new($r),
        r          => $r,
        ip_address => $ENV{REMOTE_ADDR},
        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.
    my $system = $session->system_name( clean( $r->hostname, "-_" ), "/etc/zymonic" );

    # Create a DB object for this instance

    debug("Zymonic starting... system: $system");
    unless ( ref( $Zymonic::ZCONFIG{$system} ) =~ /Config/ )
    {
        eval {

            # TODO don't send remote_ip and protocol
            $Zymonic::ZCONFIG{$system} = Zymonic::Config->new(
                system_name => $system,
                config_dir  => "/etc/zymonic",

                #   ip_address  => $r->connection->remote_ip,
                #   protocol    => $r->protocol
            );
            1;
          } or do
        {
            my $exception = $@;
            if (    $exception
                and !$exception->isa('Zymonic::Exception::Db::Locked')
                and !$exception->isa('Zymonic::Exception::Session::Config::Locked') )
            {
                ref $exception ? $exception->rethrow : die $exception;
            }
            elsif ( $exception->isa('Zymonic::Exception::Db::Locked') )
            {
                $locked_and_type = 1;
            }
            elsif ( $exception->isa('Zymonic::Exception::Session::Config::Locked') )
            {
                $locked_and_type = 2;
            }
          }
    }

    if ( !$locked_and_type )
    {

        # 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).
        my $db = Zymonic::DB->new( config => $Zymonic::ZCONFIG{$system} );

        $session->DB($db);

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

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

        $xmlout = $session->view_control;
    }
    else
    {
        if ( $locked_and_type == 1 )
        {
            $xmlout = { updating => { content => 'Updating DB...' } };
        }
        elsif ( $locked_and_type == 2 )
        {
            $xmlout = { updating => { content => 'Updating Config/cache...' } };

        }
    }

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

    # Output the XML
    if ( $session->clean_param("notransform") )
    {
        print $session->header( type => 'text/xml' );
        print XMLout(
            $xmlout,
            KeyAttr       => [],
            RootName      => "Zymonic",
            NoEscape      => 1,
            SuppressEmpty => 1
        );
    }
    else
    {
        if ( !$saxon )
        {
            if ($locked_and_type)
            {
                print $session->cgi->header( { 'Content-Type' => 'text/xml' } );
            }
            else
            {
                print $session->header( type => 'text/xml' );
                print "<?xml-stylesheet href=\""
                  . ( $Zymonic::ZCONFIG{$system}->xslt || '' )
                  . "\" type=\"text/xsl\"?>\n";
            }

            print XMLout(
                $xmlout,
                KeyAttr       => [],
                RootName      => "Zymonic",
                NoEscape      => 1,
                SuppressEmpty => 1
            );
        }
        else
        {
            open( XT, ">/tmp/xml.$$" );
            print XT XMLout(
                $xmlout,
                KeyAttr       => [],
                RootName      => "Zymonic",
                NoEscape      => 1,
                SuppressEmpty => 1
            );
            close(XT);
            if ($locked_and_type)
            {
                print $session->cgi->header( { 'Content-Type' => 'text/xml' } );
            }
            else
            {
                print $session->header( type => 'text/xml' );
            }
            my $xsl_on_disk = $Zymonic::ZCONFIG{$system}->htmlroot . $Zymonic::ZCONFIG{$system}->xslt;
            print `/usr/local/bin/saxon /tmp/xml.$$ $xsl_on_disk`;
        }
    }

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

    if ( !$locked_and_type )
    {

        $session->{DB}->close_db_connection();
    }
    return Apache2::Const::OK;

}

#################### 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 = {};

    eval {
        $resp = $class->inner_handler($r);
        1;
      }
      or do
    {
        Zymonic::Utils::death_handler( $@, 'from mod_perl' );
    };

    return $resp;

}

1;