use Benchmark; use Getopt::Long; use File::Basename; use XML::XPath; use strict; $|++; my @default_drivers = qw( LibXSLT Sablotron ); use vars qw( $component $iter $ms $kb_in $kb_out $kb_sec $result $ref_size ); my @getopt_args = ( 'c=s', # config file 'n=i', # number of benchmark times 'd=s@', # drivers 't', # only 1 iteration per test 'v', # verbose 'h', # help 'x', # XSLTMark emulation ); my %options; Getopt::Long::config("bundling"); unless (GetOptions(\%options, @getopt_args)) { usage(); } usage() if $options{h}; $options{c} ||= 'testcases/default.conf'; my $basedir = dirname($options{c}); $options{d} ||= [@default_drivers]; $options{n} ||= 1; # load drivers for my $driver (@{$options{d}}) { warn "Loading $driver Driver\n" if $options{v}; require "Driver/$driver.pm"; } # load config my @config; open(CONFIG, $options{c}) || die "Can't open config file '$options{c}' : $!"; my $current = {}; while(my $line = ) { if ($line =~ /^\s*$/m && %$current) { push @config, $current; $current = {}; } # ignore comments and full line comments $line =~ s/#.*$//; next unless $line =~ /\S/; if ($line =~ /^\s*\[(.*)\]\s*$/) { $current->{component} = $1; } elsif ($line =~ /^(.*?)\s*=\s*(.*)$/) { $current->{$1} = $2; } } for my $driver (@{$options{d}}) { my $pkg = "Driver::${driver}"; $pkg->can('init')->(verbose => $options{v}); $pkg->can('chdir')->($basedir); print "Testing: $driver\n\n"; print_header(); my %totals; COMPONENT: for my $cmp (@config) { warn "Running test: $cmp->{component}\n" if $options{v}; for (1..$options{n}) { $component = $cmp->{component}; $iter = $ms = $kb_in = $kb_out = $kb_sec = $ref_size = 0; if ($cmp->{skipdriver} =~ /\b\Q$driver\E\b/) { $result = 'SKIPPED'; print_output() unless $cmp->{written}; $cmp->{written}++; next COMPONENT; } eval { $pkg->can('load_stylesheet')->($cmp->{stylesheet}); $pkg->can('load_input')->($cmp->{input}); $iter = $cmp->{iterations}; $iter = 1 if $options{t}; my $bench = timeit($iter, sub { $pkg->can('run_transform')->($cmp->{output}); }); my $str = timestr($bench, 'all', '5.4f'); if ($str =~ /\((\d+\.\d+)/) { $ms = $1; $ms *= 1000; } $kb_in = (stat($cmp->{input}))[7]; if ($options{x}) { $kb_in /= 1000; } else { $kb_in += (stat($cmp->{stylesheet}))[7]; $kb_in /= 1024; } $kb_in *= $iter; $kb_out = (stat($cmp->{output}))[7]; $kb_out /= 1024; $kb_out *= $iter; die "failed - no output\n" unless $kb_out > 0; $kb_sec = ($kb_in + $kb_out) / ( $ms / 500 ); if ($cmp->{reference}) { $ref_size = (stat($cmp->{reference}))[7]; $ref_size /= 1024; open(REFERENCE, $cmp->{reference}) || die "Can't open reference '$cmp->{reference}' : $!"; open(NEW, $cmp->{output}) || die "Can't open transform output '$cmp->{output}' : $!"; local $/; my $ref = ; my $new = ; close REFERENCE; close NEW; $new =~ s/\A<\?xml.*?\?>\s*//; $new =~ s/\A\s*//; if (!length($new)) { die "output length failed\n"; } if ($new eq $ref) { $result = 'OK'; } else { $result = 'CHECK OUTPUT'; eval { my $rpp = XML::XPath->new(xml => $ref); my $ppp = XML::XPath::XMLParser->new(xml => $new); my $npp; eval { $npp = $ppp->parse; }; if ($@) { $npp = $ppp->parse("$new"); } my @rnodes = $rpp->findnodes('//*'); my @nnodes = $npp->findnodes('//*'); # warn "ref nodes: ", scalar(@rnodes), "\n"; # warn "new nodes: ", scalar(@nnodes), "\n"; if (@rnodes == @nnodes) { $result = 'COUNT OK'; } }; if ($@) { warn $@ if $options{v}; } } } else { $result = 'NO REFERENCE'; } }; if ($@) { warn "$component failed: $@" if $options{v}; $result = 'ERROR'; } if (($result =~ /OK/) || ($result eq 'NO REFERENCE')) { $totals{iter} += $iter; $totals{ms} += $ms; $totals{kb_in} += $kb_in; $totals{kb_out} += $kb_out; } print_output() unless $cmp->{written}; $cmp->{written}++; } # $options{n} loop delete $cmp->{written}; } # each component $pkg->can('shutdown')->(); $component = 'total'; $iter = $totals{iter}; $ms = $totals{ms}; $kb_in = $totals{kb_in}; $kb_out = $totals{kb_out}; $kb_sec = ($kb_in + $kb_out) / ( $ms / 500 ); $ref_size = 0; $result = ''; print_output(); } sub usage { print < load configuration from defaults to testcases/default.conf -n run each test case times. Default = 1. -t only one iteration per test case (note this is different to -n 1) -d test . Use multiple -d options to test more than one driver. Defaults are set in this script (the \@default_drivers variable). -x XSLTMark emulation. Infuriatingly XSLTMark thinks there are 1000 bytes in a Kilobyte. Someone please tell them some basic computer science... Without this option, this benchmark also includes the size of the stylesheet in the KB In figure. -v be verbose. Copyright 2001 AxKit.com Ltd. This is free software, you may use it and distribute it under either the GNU GPL Version 2, or under the Perl Artistic License. EOT exit(0); } sub print_header { print STDOUT <<'EOF'; Test Component Iter ms KB In KB Out KB/s Result ========================================================================== EOF } sub print_output { printf STDOUT "%-15.15s %5.0d %5.0d %7.0f %7.0f %9.2f %-15.15s\n", $component, $iter, $ms, $kb_in, $kb_out, $kb_sec, $result; }