#!/usr/bin/perl -w

#######################################################################
#                                                                     #
#  This benchmark tests the various XML modules for which examples    #
#  have been provided. You can get the examples from                  #
#  standards.ieee.org/resources/spasystem/twig/perl_survey/           #
#  You will also need the test data from                              #
#  http://www.w3.org/TR/1998/REC-xml-19980210.xml                     #
#                                                                     #
#  This data is given just to give a feel of the various modules      #
#  speed, and should not be the only, nor even the main criteria to   #
#  choose one.  Especially as the transformation performed in the     #
#  examples is very simple.                                           # 
#                                                                     #
#  In addition to all the modules used in the examples you need to    #
#  have the Benchmark module installed in your system. To remove some #
#  tests just remove or comment out he relevant line in %test.        #
#                                                                     #
#######################################################################


use strict;
use XML::Parser;
use XML::DOM;
use XML::XQL;
use XML::Twig;
use XML::PYX;
use XML::DT;
use XML::XPath;
use XML::Grove;
use XML::XSLT;
use XML::LibXML;
use XML::LibXML::SAX;
use XML::SAX::Expat;
use XML::LibXSLT;
use XML::Parser::Lite;
use XML::TokeParser;
use XML::Stream::Parser;
use XML::Rules;

use Benchmark;

my %test=
   ('1 - XML::Parser'         => "perl ex_ps_parser        >/dev/null",
    '2 - XML::Parser (alt)'   => "perl ex_ps_parser_2      >/dev/null",
    '3 - Perl regexp'         => "perl ex_ps_regexp        >/dev/null",
    '4 - XML::Parser (subs)'  => "perl ex_ps_subs          >/dev/null",
    '5 - XML::DOM'            => "perl ex_ps_dom2          >/dev/null",
    '6 - XML::XQL'            => "perl ex_ps_xql           >/dev/null",
    '7 - XML::Twig'           => "perl ex_ps_twig          >/dev/null",
    '8 - XML::PYX'            => "perl ex_ps_pyx           >/dev/null",
    '9 - XML::DT'             => "perl ex_ps_dt            >/dev/null",
    'A - XML::XPath'          => "perl ex_ps_xpath         >/dev/null",
    'B - XML::Grove'          => "perl ex_ps_grove         >/dev/null",
    'C - XML::LibXML'         => "perl ex_ps_libxml        >/dev/null",
    'D - XML::LibXML::SAX'    => "perl ex_ps_sax_libxml    >/dev/null",
    'E - XML::SAX::Expat'     => "perl ex_ps_sax_expat     >/dev/null",
    'F - XML::XSLT'           => "perl ex_ps_xslt          >/dev/null",
    'G - XML::LibXSLT'        => "perl ex_ps_libxslt       >/dev/null",
    'H - XML::Parser::Lite'   => "perl ex_ps_lite          >/dev/null",
    'I - XML::TokeParser'     => "perl ex_ps_tokeparser    >/dev/null",
    'H - XML::Stream::Parser' => "perl ex_ps_stream_parser >/dev/null",
    'J - XML::Rules'          => "perl ex_ps_rules         >/dev/null",
  );

my %result;
my $base;

my %version=
    ( 'XML::Parser'         => $XML::Parser::VERSION,
      'XML::DOM'            => $XML::DOM::VERSION,
      'XML::XQL'            => $XML::XQL::VERSION,
      'XML::Twig'           => $XML::Twig::VERSION,
      'XML::PYX'            => $XML::PYX::VERSION,
      'XML::DT'             => $XML::DT::VERSION,
      'XML::XPath'          => $XML::XPath::VERSION,
      'XML::Grove'          => $XML::Grove::VERSION,
      'XML::XSLT'           => $XML::XSLT::VERSION,
      'XML::SAX::Expat'     => $XML::SAX::Expat::VERSION,
      'XML::LibXML'         => $XML::LibXML::VERSION,
      'XML::LibXSLT'        => $XML::LibXSLT::VERSION,
      'XML::Parser::Lite'   => $XML::Parser::Lite::VERSION,
      'XML::TokeParser'     => $XML::TokeParser::VERSION,
      'XML::Stream::Parser' => $XML::Stream::Parser::VERSION,
      'XML::Rules'          => $XML::Rules::VERSION,
    );

foreach my $module (sort keys %test)
  { print "Testing $module:\n";
    print "  $test{$module}\n";
    my $t0 = new Benchmark;
    system "$test{$module} 2>/dev/null";
    my $t1 = new Benchmark;
    my $td = timediff($t1, $t0);
    print "  " , timestr($td), "\n";
    my ($cusr, $csys)= (timestr($td)=~ /([\d\.]+) cusr\s*([\d\.]+) csys/);
    $result{$module}= $cusr+$csys;
    $base||= $result{$module};
  }

open( RESULT, ">ps_benchmark_result")
  or die "cannot open ps_benchmark_result: $!";

print RESULT qq{<table border="1">\n};
print RESULT qq{<tr><th align="left">Module</th>}
               . qq{<th align="left">Version</th>}
               . qq{<th align="left">Timing (benchmark)</th>}
               . qq{<th align="left">Factor</th></tr>\n};
foreach my $module (sort keys %test)
  { my $time= $result{$module};
    my $ratio= ($time * 100) / $base;
    $module=~ s{^[\dA-Z] - }{}; 
    #warn "module: /$module/, version: /$version{$module}/\n";
    my $version= $version{$module} || '&nbsp;';
    printf RESULT "<tr><td>%s</td><td>%s</td><td>%s</td><td>%3d</td></tr>\n", 
                  $module, $version, $time, $ratio;
  }
print RESULT "</table>\n";
print RESULT "<p><small>benchmark environment: perl $] on $^O - ", scalar localtime(), "</small></p>\n";
close RESULT;