package PXSQL::XML_RDB;
#------------------------------------------------------------------
# Project  : Perl_xsql
# Name     : XML_RDB.pm
# Language : 5.005_03 built for i386-linux
# OS       : linux RedHat 6.2 kernel 2.2.14-5.0smp
# Author   : Gilles Darold, gilles __AT__ darold __DOT__ net
# Copyright: (c) 2000 Gilles Darold
# Function : XML code generator from database resultset
# Usage    : See documentation.
#------------------------------------------------------------------
# Version control :
# $Id$
#------------------------------------------------------------------
use vars qw($VERSION %XMLCHARS);

use strict;

$VERSION = '1.0';

%XMLCHARS = (
	'&' => '&',
	'<' => '&lt;',
	'>' => '&gt;',
	'"' => '&quot;',
);

=head1 NAME

PXSQL::XML_RDB - Perl extension for creating XML from existing DBI datasources

=head1 SYNOPSIS

  use PXSQL::XML_RDB;

  my $xmlout = PXSQL::XML_RDB->new($dbh, $noheader);
  $xmlout->DoSqlPlus($cgi,"RESULTSET", "ROW", $sql_query, $perlcode);
  print $xmlout->GetData;

=head1 DESCRIPTION

This module is a simple creator of XML data from DBI datasources. It allows you to
easily extract data from a database, and manipulate later using XML::Parser or other.

This tool simply dumps the result of a SQL query from a database into an XML string.

It is based on the DBIx_XML_RDB perl module written by matt Sergeant

=head1 FUNCTIONS

=head2 new

	new ( $dbh, $noheader )

This method accept only two parameter, the first one is required, this is the
database connection handler, and the second parameter is a boolean to specify
if the module must skip the XML header or not. Default is do not skip.

The XML header is as follow:

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

Note that the end tag </PXSQL> will be closed by PXSQL::XCGI if require.

=cut

sub new
{
	my $this = shift;
	my $class = ref($this) || $this;
	my $self = {};
	bless $self, $class;
	$self->_init(@_) || return undef;
	return $self;
}

=head2 xmlenc

Replace non HTML characters to their equivalent into HTML encoding

=cut

sub xmlenc
{
    my $str = shift;
    $str =~ s/([&<>"])/$XMLCHARS{$1}/ge;
    return $str;
}

=head2 _init

This method initialize the PXSQL::XML_RDB instance and the XML output.

=cut

sub _init
{
	my $self = shift;

	$self->{noheader} = shift || '';

	$self->{output} = "<?xml version=\"1.0\"?>\n<PXSQL>\n" if (!$self->{noheader});
	$self->{output} .= "<DBI>\n";

        $self->{resultset} = 'RESULTSET';
        $self->{row} = 'ROW';

	return 1;
}

=head2 DESTROY

We provide a DESTROY method so that the autoloader
doesn't bother trying to find it.

=cut

sub DESTROY { }


=head2 DoSqlPlus

	DoSqlPlus ( $resultset, $row, $sql_query, $perlcode )

Where $resultset and $row are the wanted XML element name for resultset and row tag.
Param $query is the SQL query to execute and $perlcode is the perlcode retrieved from
the XML <code> element into the XML-SQL file.

The result set will be appended to the output. Subsequent calls to DoSqlPlus don't overwrite
the output, rather they append to it. This allows you to call DoSqliPlus multiple times before
getting the output via GetData() method.

=cut

sub DoSqlPlus
{

        my $self = shift;
        my $dbh = shift;
        my $cgi = shift;
        $self->{resultset} = shift(@_);
        $self->{row} = shift(@_);
	my $query = shift(@_);
	my @param = ();

        if ($#_ == 0) {
		no strict;
                eval "sub foo_$$_fct {$_[0]}";
                if ($@) {
                        die "Perl XSQL error: Perl code is invalid: $@\n";
                }
                @param = &{"foo_$$_fct"}($self, $cgi);
		undef &{"foo_$$_fct"};
		use strict;
        }

        $self->{sth} = $dbh->prepare($query) || die "Perl XSQL error: " . $dbh->errstr . "\n";
	if ($query =~ /\?/) {
        	$self->{sth}->execute(@param);
	} else {
        	$self->{sth}->execute();
	}
        if ($query =~ /^[\n\t\s]*SELECT/i) {
                $self->_CreateOutput($cgi);
        } else {
                $self->_CreateErrorOutput($self->{sth}->errstr, $query, @param);
        }
        $self->{sth}->finish;
}


=head2 _CreateOutput

This function is called internally by the DoSqlPlus() method and generate the
XML output for each tuples returned.

If you want to do pagination into the perl code the CGI parameters 'page' and 'plage'
must be set. If CGI param 'plage' is not set then all data are extracted. This provide
a pagination method for leak of this functionnality into RDBMS.

=cut

sub _CreateOutput
{
	my $self = shift;
	my $cgi = shift;

	my $fields = $self->{sth}->{NAME};

	# Now insert the actual data.

	$self->{output} .= "\t<$self->{resultset} ";

	my $row = 0;
	my $data = $self->{sth}->fetchall_arrayref;
	$self->{output} .= "count=\"" . ($#{$data} + 1) . "\">\n";
	my $begin = 0;
	if ( $cgi->param('page') && $cgi->param('plage') ) {
		$begin = ($cgi->param('page') - 1) * $cgi->param('plage');
	}
	my $count = 1;
	for (my $x=0; $x<=$#{$data}; $x++) {
		if ($self->{row} eq 'INTERNAL.PAGE') {
			next if ($x < $begin);
			last if ($cgi->param('plage') && ($count > $cgi->param('plage')));
		}
		print STDERR "Row: ", $row++, "\n" if $self->{verbose};
		$self->{output} .= "\t\t<$self->{row}>\n";
		my $i = 0;
		foreach my $f (@{$data->[$x]}) {
			if (defined $f) {
				$self->{output} .= "\t\t\t<" . $fields->[$i] . '>' . xmlenc($f) . '</' . $fields->[$i] . ">\n";
			}
			$i++;
		}
		$self->{output} .= "\t\t</$self->{row}>\n";
		$count++;
	}
	$self->{output} .= "\t</$self->{resultset}>\n";
}


=head2 _CreateErrorOutput

This method is called internally to generate error message into the XML code if
an update, insert or delete query fail.

=cut

sub _CreateErrorOutput {
        my $self = shift;

        my $error = shift;
        my $query = shift;

        # Now insert the actual data.
        if ($error) {
                $self->{output} .= "<error>-2</error>";
                print STDERR "$error: $query\n";
                print STDERR "Param: @_\n";
        } else {
                $self->{output} .= "<error>0</error>";
        }

}

=head2 GetData

Simply returns the XML generated from this SQL call.

The format of the XML output is something like this:

	<?xml version="1.0"?>
	<PXSQL>
	<DBI>
		<RESULTSET count="n">
			<ROW>
			<Col1Name>Data</Col1Name>
			<Col2Name>Data</Col2Name>
			...
			</ROW>
			<ROW>
			...
			</ROW>
		</RESULTSET>
		<RESULTSET count="n">
		...
		</RESULTSET>
	</DBI>

This is quite easy to parse using any XML Parser.

=cut

sub GetData {
	my $self = shift;
	my $output = '';
	$output .= "<DBI>" if ($self->{output} !~ /<DBI>/s);
	$output .= $self->{output};
	$output .= "</DBI>\n" if ($self->{output} !~ /<\/DBI>/s);

	return $output;
}


=head2 SetData

This method is provide to suppress all XML output previously generated.
To use if you have temporary SQL queries that doesn't need XML output.

=cut

sub SetData {
        my $self = shift;

        $self->{output} = shift;
}

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::XSQL>

=cut