#!/usr/bin/perl
#
# ModPerlWrap.pm
# Eric Rollins 2005
#
use strict;
use warnings;

package Genezzo::Contrib::Clustered::ModPerlWrap;

use File::Path;
use File::Spec;
use Data::Dumper;
use Genezzo::GenDBI;
use Genezzo::Contrib::Clustered;
use Genezzo::Contrib::Clustered::GLock::GLock;
use POSIX;

require Exporter;
our @ISA = ("Exporter");

our @EXPORT = qw(PrintForm StartPage ProcessStmt Rollback Commit 
		 Connect FinishPage);

our $dbh;
our $query_num = 0;
our $dbi_gzerr;

sub entry {
    my $sigset = POSIX::SigSet->new(POSIX::SIGUSR2);
    my $old_sigset = POSIX::SigSet->new;
    POSIX::sigprocmask(POSIX::SIG_BLOCK, $sigset, $old_sigset)
		     or die "Error blocking SIGUSR2: $!\n";
}

sub normal_exit {
    my $sigset = POSIX::SigSet->new(POSIX::SIGUSR2);
    my $old_sigset = POSIX::SigSet->new;
    POSIX::sigprocmask(POSIX::SIG_UNBLOCK, $sigset, $old_sigset)
		     or die "Error unblocking SIGUSR2: $!\n";

    # Apache remaps this to ModPerl::Util::exit()
    exit();
}

$dbi_gzerr = sub {
    my %args = (@_);

    return
	unless (exists($args{msg}));

    my $sev = "UNKNOWN";
    
    if (exists($args{severity}))
    {
	$sev = uc($args{severity});
    
	$sev = 'WARNING'
	    if ($sev =~ m/warn/i);

	# don't print 'INFO' 
	if ($args{severity} =~ m/info/i)
	{
	    return;
	}
    }

    # log error
    print STDERR "ERROR $sev", __PACKAGE__, ": ",  $args{msg};

    print "<error>\n";
    print "  <error-severity>";
    print $sev;
    print "</error-severity>\n";
    print "  <error-message>";
    print __PACKAGE__, ": ",  $args{msg};
    print "</error-message>\n";
    print "</error>\n";
};

sub return_error
{
    my ($where) = @_;

    print "  <error-location>", $where, "</error-location>\n";
    print "</results>\n";
    normal_exit();
};

sub sig_handler {
    if(Genezzo::Contrib::Clustered::GLock::GLock::ast_poll()){
	# message print may not be signal-safe.
	print STDERR "\n$$ Exiting immediately due to lock request\n";
	CORE::exit();
    }
}

BEGIN {
}

sub Connect {
    my ($gnz_home) = @_;

    # also covered in StartPage()
    entry();

    if(defined($dbh)){
	return;  # already connected
    }

    # Perl "safe" signals prevent signals from being recd during Apache 
    # event loop.
    #$SIG{USR2} = \&sig_handler;
    my $sigActionObj  =POSIX::SigAction->new(\&sig_handler);
    $sigActionObj->flags(&POSIX::SA_RESTART);
    POSIX::sigaction(POSIX::SIGUSR2,$sigActionObj)                     
	or die "Error setting SIGUSR2 handler: $!\n";

    Genezzo::Contrib::Clustered::GLock::GLock::set_notify();

    $query_num = 1;  # already incr from zero in StartPage()

    $dbh = Genezzo::GenDBI->connect($gnz_home, 
				    "NOUSER", 
				    "NOPASSWORD",
				    {GZERR => $dbi_gzerr,
				     PrintError => 0,
				     RaiseError => 0});

    if(defined($dbh)){
	$dbh->do("startup"); # start the database

	my $ret = $dbh->do("rollback");  # Grab shared locks.

	if(!defined($ret)){
	    return_error("rollback");
	}
    }
}

use CGI qw(:standard escapeHTML);

# This routine is not protected against interruption.
sub PrintForm {
    print header();
    print start_html("Genezzo");
    print "  <h2>Enter Genezzo SQL Statement:</h2>\n";
    print "  <form>\n";
    print "    <textarea rows=\"5\" cols=\"60\" name=\"query\"></textarea>\n";
    print "    <p>\n";
    print "    <input type=\"submit\"/>\n";
    print "  </form>\n";
    print end_html();
}

sub StartPage {
    entry();
    print "Content-type: text/xml\n\n";
    print '<?xml version="1.0" encoding="iso-8859-1"?>';
    print "\n";
    print "<results>\n"; 
    print "<query_num>$query_num</query_num>\n";   # to debug mod_perl reuse
    print "<os_pid>$$</os_pid>\n";
    $query_num++;
}

# For queries prints results as XML.
sub ProcessStmt {
    my ($stmt) = @_;

    if(!defined($dbh)){
	return_error("connect");
    }

    my $sth = $dbh->prepare($stmt);

    if(!defined($sth)){
	return_error("prepare");
    }

    my $ret = $sth->execute();

    if(!defined($ret)){
	$dbh->do("rollback"); 
	return_error("execute");
    }

    my $numFields = $sth->{NUM_OF_FIELDS};

    if(!defined($numFields)){
	return;
    }

    while (1)
    {
	my @ggg = $sth->fetchrow_array();

	last
	    unless (scalar(@ggg));

	print "   <row>\n";
 
	my $i;

	for($i = 0; $i < $numFields; $i++){
	    print "      <", $sth->{NAME}->[$i], ">";
	    print $ggg[$i];
	    print "</", $sth->{NAME}->[$i], ">";
	    print "\n";
	}

	print "   </row>\n";
    }

    # Can fatal errors occur during fetch, requiring rollback?
}

sub Rollback {
    my $ret = $dbh->do("rollback");
    
    if(!defined($ret)){
	return_error("rollback");
    }
}

sub Commit {
    my $ret = $dbh->do("commit");
    
    if(!defined($ret)){
	return_error("commit");
    }
}

sub FinishPage {    
    print "</results>\n";
    normal_exit();
}

1;

__END__

=head1 NAME

Genezzo::Contrib::Clustered::ModPerlWrap - Mod Perl wrappers for Genezzo

=head1 SYNOPSIS
    
    StartPage();
    Connect("/dev/raw");
    ProcessStmt("insert into t1 values (10, 'test10')");
    ProcessStmt("insert into t1 values (11, 'test11')");
    Commit();
    FinishPage();

or

    StartPage();
    Connect("/dev/raw");
    ProcessStmt("select * from t1");
    FinishPage();

=head1 DESCRIPTION

The Apache web server is used to provide multi-user XML over HTTP access 
to the Clustered Genezzo database.  A page containing multiple SQL statements
acts much like a stored procedure.  The web page
parameters are used like stored procedure parameters, and the
processing on the page forms the transaction boundary.

Note control flow on page does not continue after errors or FinishPage().

See genezzo_form.pl for examples.

May use "PerlModule ModPerlWrap" in apache2.conf.  This preloads this
module and the rest of the Genezzo modules so they are (initially)
shared between all apache processes, saving memory.  

=head1 FUNCTIONS

=over 4

=item Connect GNZ_HOME

Connects to Clustered Genezzo database with home GNZ_HOME.  Only performed
once per process.

=item PrintForm

Prints form which can be used to sent SQL statements to web server.

=item StartPage

Prints initial HTML and XML at beginning of response.

=item ProcessStmt STMT

Processes SQL statement.  Result rows are wrapped in XML and printed.
On execute errors automatically does rollback and ends page processing.

=item Rollback

Rolls back transaction.  Often unnecessary as ProcessStmt execute errors are
automatically rolled back.

=item Commit

Commits transaction.

=item Finish Page

Prints final closing XML tags and ends page processing.  Note control flow
does not continue beyond this point.

=back

=head2 EXPORT

none

=head1 LIMITATIONS

Requires Apache 2 and Perl 5.8.4+.  On Apache 1.3 SIGUSR2 delivery is 
often delayed.
Note the standard web server on Mac OS X is Apache 1.3.

This is pre-alpha software; don't use it to store any data you hope
to see again!

=head1 SEE ALSO

L<http://www.genezzo.com>

L<http://eric_rollins.home.mindspring.com/genezzo/ClusteredGenezzoDesign.html>

L<http://eric_rollins.home.mindspring.com/genezzo/cluster.html>

=head1 AUTHOR

Eric Rollins, rollins@acm.org

=head1 COPYRIGHT AND LICENSE

    Copyright (C) 2005 by Eric Rollins.  All rights reserved.

    This program 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
    any later version.

    This program 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 this program; if not, write to the Free Software
    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

Address bug reports and comments to rollins@acm.org

=cut