package PXSQL::XSQL;
#------------------------------------------------------------------
# Project  : Perl XSQL
# Name     : XSQL.pm
# Author   : Gilles Darold, gilles __AT__ darold __DOT__ net
# Copyright: Copyright (c) 2001 Gilles Darold
# Function : SQL / XML gateway
# Usage    : See documentation.
#------------------------------------------------------------------
# Version control :
# $Id$
#------------------------------------------------------------------
use vars qw($VERSION);

use strict qw/vars sub/;

use PXSQL::XML_RDB;

$VERSION = '1.0';


=head1 NAME

XSQL - A perl module for building XML from SQL query

=head1 SYNOPSIS

    use PXSQL::XSQL;
    use CGI qw(:standard);
    use DBI;
    use DBD::Pg;
    
    my $XSQL_ROOT_DIR = '/usr/local/apache/cgi-bin/PXSQL/examples';
    
    # Load the configuration file containing the template aliases
    my %XSL = &PXSQL::XSQL::load_templates("./template.lst";
    
    # Display an error message when a template doesn't exists
    if ( !exists $aliases{$template} ) {
            print $cgi->header(-type=>'text/html', -status => '404 Not Found'),
            $cgi->start_html(-title=>'404 Not Found'),
            qq{
            <H1>Not Found</H1>
            The requested URL $ENV{SCRIPT_NAME}?template=$template was not found on this server.<P>
            <HR>
            </BODY>
            </HTML>
            };
            exit 1;
    }
    
    # Connect to the database
    my $dbh = DBI->connect(
                    "dbi:Pg:dbname=xsql_test;host=localhost;port=5432",
                    'test',
                    'test',
                    { RaiseError => 0 }
            );
    
    # Create e new instance of the XSQL perl module
    my $xsql = new PXSQL::XSQL($dbh);
    
    # Set the directory where XSQL files can be found. This path will be
    # prepend to aliases xml/sql files
    $xsql->set_xml_sql_documents($XSQL_ROOT_DIR);
    
    # Get XML output as string resulting from the SQL queries
    my $xmldata = $xsql->get_xml_data($cgi, $aliases{$template}[1] || '');


=head1 DESCRIPTION

This module is a simple creator of XML data from DBI
datasources. It allow you to easily extract data from a
database, and manipulate them later using XML::Parser
or in association with a XSL template file to a XSLT parser
like Sablotron or Gnome libxsl.

This allow you to create dynamic web application by simply
set your SQL queries into a XML file and generate the HTML
output using a XSL template. It acts exactly as the Oracle
XSQL servlet.

=head1 METHODS

=head2 new

Create a new instance of this module.

  new ( $dbh, $noheader )

  $dbh     : DBI database handler.
  $noheader: Boolean to write XML header or not.

XML header constist in the following XML data:

	<?xml version="1.0"?>
	<PXSQL>

and also append this line at the end of the output

	</PXSQL>

You may want to provide your own, so set $noheader to 1 will skip
this output.

=cut

sub new
{
        my ($class, @options) = @_;

        # Construct the class
        my $self = {};
        bless $self, $class;

        # Initialize all variables
        $self->_init(@options);

        # Return the instance
        return($self);

}

=head2 load_templates

This method load the configuration file given as argument and containing
all association between XSL templates, XML/SQL files and aliases.

Return a hash of array containing the realname XSL, XML/SQL files associated
to an alias name used as the keys in the hash.

This file imust have the following format:

	template_alias:xsl_to_html_file.xsl:xml_sql_file.xml

template_alias		: alias used into template CGI parameter.
xsl_to_html_file	: XSL file used to format the HTML output.
xml_sql_file		: XML / SQL file used to execute SQL queries.

Comment lines begin with a '#'.

If you don't want to use this configuration file to speed up things,
just create a hash as follow:

my %XSL = ( 'template_alias' => (xsl_to_html_file,xml_sql_file) );

This method must be call into the CGI frontend script.

=cut

sub load_templates
{
	my ($path) = @_;

	local (*TMPL) = '';
	open(TMPL, "$path") or die "Perl_xsql error: can't load file $path, $!\n";

	my %aliases = ();
	while (my $l = <TMPL>) {
		chomp($l);
		next if ( ($l =~ /[\s\t]*#/) || ($l eq "") );
		my @arry = split(/:/, $l);
		my $alias = shift(@arry);
		$aliases{$alias} = [ @arry ];
	}
	close TMPL;

	return %aliases;
}

=head2 set_xml_sql_documents

This function is used to set the repository where XML / SQL files can
be found with the given path.

This is the place where the module will look for XML SQL definition
file associated to a template. When the program will look for the
template file it will prepend this path to his serach path.

=cut

sub set_xml_sql_documents
{
	my ($self, $path) = @_;

	if (!-d "$path") {
		die "XML/SQL documents repository $path doesn't exist\n";
	}

	$self->{xml_sql} = $path;

}


=head2 _init

This private method initialize the PXSQL::XSQL perl 00 instance.
It is call internally by method new().

=cut

sub _init
{
	my ($self, $dbh, $noheader) = @_;

	die "Error: Default database connection is not provided.\n" if (ref($dbh) ne 'DBI::db');

        $self->{dbh} = $dbh;

        $self->{noheader} = $noheader;

	$self->{xml_sql} = '';
	$self->{xmlout} = '';

}


# We provide a DESTROY method so that the autoloader
# doesn't bother trying to find it.
sub DESTROY
{
	my $self = shift;

	$self->{dbh}->disconnect;

}


=head2 get_xml_data

This method execute the SQL queries found in the XML / SQL file and call
the PXSQL::XML_RDB perl OO module to produce the XML output.

The SQL queries are loaded into an array of ref array, which have the
following structure:

	$req[$i] = [ ("resultset_name", "row_name", "sql_query", @dbparam) ];

If a XML / SQL file in the templates aliases configuration file is replaced
by a perl function name, the program will try to execute this function.
This is what I call Extended XSQL. This function must be written into an
external module and must be exported from this perl module. The external
module must be load into the parl script serving as CGI frontend.

If the parsing is done onto a XML/SQL file then the referenced array can
take an other element representing the perl code to execute:

	$req[$i] = [ ("resultset_name", "row_name", "sql_query", @dbparam, "perlcode") ];

Each part of this array is passed to the PXSQL::XML_RDB::DoSqlPlus function
to be executed.

In a Extended XSQL perl module you must set this array as describe above and
it must be return by the function.

The array @dbparam contain the database connection parameters defined into the
XML/SQL file to overide default database connection. Its structure is as follow:

@dbparam = (
	datasource,
	dbuser,
	dbpassword,
	raise_error
)

=cut

sub get_xml_data
{
	my ($self, $cgi, $template, @req) = @_;

	$self->{xmlout} = PXSQL::XML_RDB->new($self->{noheader});

	if (!$self->{xmlout}) {
		print "Failed to create a new instance of PXSQL::XML_RDB\n";
		exit(0);
	}

	my @request = ();

	my $file = "$self->{xml_sql}/$template";

	if (($#req < 0) && -f "$file") {
		@request = $self->parse_xml_sql($cgi, "$file");
	} elsif ($#req < 0) {
		$template =~ s/\..*$//;
		my $func = 'main::' . lc($template);
		eval { @request = &{$func}($self, $cgi) };
		$@ = '';
	} else {
		@request = @req;
	}

	foreach (@request) {
		if (@{$_}[3]) {
			my $dbh_old = $self->{dbh};
			@{$_}[6] = 1 if (@{$_}[6] eq '');
			$self->{dbh} = DBI->connect(@{$_}[3], @{$_}[4], @{$_}[5], { RaiseError => @{$_}[6] });
			splice(@{$_}, 3, 4);
			$self->{xmlout}->DoSqlPlus($self->{dbh}, $cgi, @{$_});
			$self->{dbh}->disconnect();
			$self->{dbh} = $dbh_old if ($dbh_old);
		} else {
			splice(@{$_}, 3, 4);
			$self->{xmlout}->DoSqlPlus($self->{dbh}, $cgi, @{$_});
		}
	}

	my $xmldata = $self->{xmlout}->GetData;

	if ($#req < 0) {
		$self->{xmlout}->SetData('');
	}

	$xmldata =~ s/\x0//g;

	return $xmldata;
}


=head2 get_sql_data

This method act directly with the database to extract data as an array of ref
array and return these data.

It is used internally by the PXSQL::XML_RDB perl OO module.

=cut

sub get_sql_data
{
	my ($self, $req) = @_;

	my @data = ();
	my $sth = $self->{dbh}->prepare($req) || die $self->{dbh}->errstr;
	$sth->execute;
	while (my $row = $sth->fetch) {
		push(@data, $row);
	}
	$sth->finish;

	# This could help with Oracle database
	#$xmldata =~ s/\x0//g;

	return @data;

}


=head2 insert_data

This method first call the PXSQL::XML_RDB perl OO module to insert
data into the database and then get the output to report any error.

=cut

sub insert_data
{
	my ($self, $cgi, @req) = @_;

	foreach (@req) {
		$self->{xmlout}->DoSqlPlus($cgi, @{$_});
	}

	my $xmldata = $self->{xmlout}->GetData;
	$self->{xmlout}->SetData('');

	return $xmldata;

}


=head2 parse_xml_sql

This method parse a XML/SQL file to extract the composition of a SQL
query. The parsing of the XML do not use an external parser like expat
or other because of the simplicity of the XML structure. This XML
structure is not intended to change.

It also change the connection to the database if necessary.

See documentation on the XML/SQL syntax.

=cut

sub parse_xml_sql
{
	my ($self, $cgi, $template) = @_;

	return if (!$template);

	my @ret = ();

	local (*XML) = '';
	unless( open(XML, "$template") ) {
		print "Error: Can't open file $template, $!\n";
		exit 0;
	}
	$/ = undef;
	my $content = <XML>;
	close XML;
	$/ = "\n";

	&replace_cgi_call($cgi, \$content);

	my @resultset = split(/<[\/]*resultset[>]*/, $content);

	my $conn = shift(@resultset);

	my @dbconn = ('','','','');
        $dbconn[0] = $1 if ($conn =~ /datasource="([^"]+)"/s);
        $dbconn[1] = $1 if ($conn =~ /user="([^"]+)"/s);
        $dbconn[2] = $1 if ($conn =~ /password="([^"]+)"/s);
        $dbconn[3] = $1 if ($conn =~ /error="([^"]+)"/s);

        for (my $i=0; $i < $#resultset; $i+=2) {
                $resultset[$i] =~ s/^[^>]*name="([^"]*)"[^>]*>//s;
                my $res = $1;

                my $perlcode = '';
                if ($resultset[$i] =~ s/<code>(.*)<\/code>//s) {
                        $perlcode = $1;
                }

                my @line = split(/<[\/]*row[>]*/, $resultset[$i]);
                shift(@line);
                $line[0] =~ s/^[^>]*name="([^"]*)"[^>]*>//s;
                my $row = $1;

                my @q = split(/<[\/]*query>/, $line[0]);
                shift(@q);
                my $query = $q[0];
                $query =~ s/^[^a-z]*//i;

                if ($perlcode) {
                        push(@ret, [ ($res, $row, $query, @dbconn, $perlcode) ]);
                } else {
                        push(@ret, [ ($res, $row, $query, @dbconn) ]);
                }
        }

	return @ret;
}


=head2 replace_cgi_call

This method replace all call to CGI variable replacement into the
XML/SQL file. 

The call to this replacement must be used like that:

	CGI::param_name

This function will then replace this string by the value of the named
CGI parameter.

=cut

sub replace_cgi_call
{
	my ($cgi, $data) = @_;

	my @param = $cgi->param();
	foreach my $name (@param) {
		my $val = $cgi->param($name);
		$$data =~ s/\bCGI::$name\b/$val/gs;
	}

}

1;

__END__


=head1 AUTHOR

Gilles Darold <gilles __AT__ darold __DOT__ net>

=head1 COPYRIGHT

Copyright (c) 2001 Gilles Darold - All rights reserved.

This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=head1 SEE ALSO

L<PXSQL::XCGI>, L<PXSQL::XML_RDB>

=cut