#!/usr/bin/perl -w
use strict;
use DBI;
use CGI qw/-no_xhtml :standard/;
use XML::Generator::DBI;
use XML::Handler::YAWriter;
use XML::LibXML::SAX::Builder;
use XML::LibXML;
use XML::LibXSLT;
use XML::XSLT;
use Template;
use Data::Dumper;
use Benchmark qw( cmpthese );
$Template::Config::STASH = 'Template::Stash';
my $dbh = DBI->connect( "dbi:Pg:dbname=monksdb", "", "" )
or die $DBI::errstr;
my $query = "SELECT id, name, xp, lat, long FROM monks ORDER BY lat LIMIT 25";
my $sth = $dbh->prepare_cached( $query ) or die $DBI::errstr;
my $ya = XML::Handler::YAWriter->new( AsString => 1 );
my $generator = XML::Generator::DBI->new(
Handler => $ya,
dbh => $dbh,
RowElement => "monk"
);
my $generator2 =
XML::Generator::DBI->new(
Handler => XML::LibXML::SAX::Builder->new(),
dbh => $dbh,
RowElement => "monk" );
my $tt2 = Template->new;
my $tt2_nonXML = "template1.tt2";
my $tt2_XML = "template2.tt2";
my $tt2_XPath = "template3.tt2";
my $parser = new XML::LibXML;
my $xslt = new XML::LibXSLT;
my $sheet = "xslt_sheet.xsl";
my $slt = $parser->parse_file( $sheet );
my $stylesheet = $xslt->parse_stylesheet( $slt );
my $stylesheet2 = XML::XSLT->new( $sheet, warnings => 1 );
open FILE, ">/dev/null" or die "Cannot write out: $!";
my $target = \*FILE;
cmpthese( 100,
{
"DBI and Print" => \&generate_from_straight_dbi_and_print,
"DBI and CGI" => \&generate_from_straight_dbi_and_cgi,
"DBI and TT2" => \&generate_from_straight_dbi_and_tt2,
"XML and TT2/Simple" => \&generate_from_xml_and_tt2_and_xmlsimple,
"XML and TT2/XPath" => \&generate_from_xml_and_tt2_and_xpath,
"XML and XSLT, String Intermediate, LibXSLT " => \&generate_from_xml_and_xslt_string,
"XML and XSLT, XML Intermediate, LibXSLT" => \&generate_from_xml_and_xslt_xml,
"XML and XSLT, String Intermediate, XML::XSLT" => \&generate_from_xmlxslt_xml
}
);
close FILE;
# Here, we use straight DBI calls and print calls to mark up
# the table
sub generate_from_straight_dbi_and_print {
# my $target = shift;
$sth->execute() or die $DBI::errstr;
my ( $id, $name, $xp, $lat, $long );
$sth->bind_columns( \$id, \$name, \$xp, \$lat, \$long );
print $target "Content-Type: text/html\n\n";
print $target "
\n";
my $colorrow = 0;
while ( $sth->fetch() ) {
$colorrow = !$colorrow;
my $color = ( $colorrow ) ? "#FFFFFF" : "#D0D0FF";
print $target <
$id |
$name |
$xp |
$lat |
$long |
ROW
;
}
print $target "
";
}
# Here, we group the results as to make it easier for CGI
# to print out (avoiding large HERE docs...)
sub generate_from_straight_dbi_and_cgi {
# my $target = shift;
$sth->execute() or die $DBI::errstr;
my ( $id, $name, $xp, $lat, $long );
$sth->bind_columns( \$id, \$name, \$xp, \$lat, \$long );
my @data;
while ( $sth->fetch ) { push @data, [$id, $name, $xp, $lat, $long]; }
my $colorrow = 0;
print $target
header('text/html'),
start_html,
table(
map { $colorrow = !$colorrow;
my $color = ( $colorrow ) ? "#FFFFFF" : "#D0D0FF";
Tr(
td( {-bgcolor=>$color}, $_ )
)
} @data
),
end_html;
}
# Here, we pass the results to Template Toolkit for printing
sub generate_from_straight_dbi_and_tt2 {
# my $target = shift;
$sth->execute() or die $DBI::errstr;
my ( $id, $name, $xp, $lat, $long );
$sth->bind_columns( \$id, \$name, \$xp, \$lat, \$long );
my @data;
while ( $sth->fetch ) { push @data, [$id, $name, $xp, $lat, $long]; }
print $target header;
$tt2->process( $tt2_nonXML, { monks => \@data }, $target ) or
die $tt2->error(),"\n";
}
# Use TT2 again, but now pass it XML and use the XPath module
# for parsing
sub generate_from_xml_and_tt2_and_xmlsimple {
# my $target = shift;
my $xml = $generator->execute( $query );
print $target header;
$tt2->process( $tt2_XML, { results => $xml }, $target ) or
die $tt2->error(), "\n";
}
# Use TT2 again, but now pass it XML and use the XPath module
# for parsing
sub generate_from_xml_and_tt2_and_xpath {
# my $target = shift;
my $xml = $generator->execute( $query );
print $target header;
$tt2->process( $tt2_XPath, { results => $xml }, $target ) or
die $tt2->error(), "\n";
}
# Use LibXML/LibXSLT to parse the results
sub generate_from_xml_and_xslt_string {
# my $target = shift;
my $xml = $generator->execute( $sth );
print $target header;
my $source = $parser->parse_string( $xml );
my $results = $stylesheet->transform( $source );
print $target $stylesheet->output_string( $results );
}
sub generate_from_xml_and_xslt_xml {
# my $target = shift;
my $xml = $generator2->execute( $sth );
print $target header;
my $results = $stylesheet->transform( $xml );
print $target $stylesheet->output_string( $results );
}
sub generate_from_xmlxslt_xml {
# my $target = shift;
my $xml = $generator->execute( $sth );
print $target header;
print $target $stylesheet2->serve( $xml );
}