#!/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 < ROW ; } print $target "

$id

$name

$xp

$lat

$long

"; } # 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 ); }