Commits

Tim Brody  committed 8416fb5

Moved Benchmarking utils to a benchmark/ sub-directory and removed them from the MANIFEST, which causes us headaches in CPAN because it thinks we own 'Driver'.

  • Participants
  • Parent commits ec1d0cf

Comments (0)

Files changed (9)

File Driver/BaseClass.pm

-# base class.
-
-package Driver::BaseClass;
-
-use Carp;
-
-sub init {
-    my %options = @_;
-}
-
-sub chdir {
-    my ($dir) = @_;
-    chdir($dir);
-}
-
-sub load_stylesheet {
-    my ($filename) = @_;
-    croak("load_stylesheet(filename) unimplemented");
-}
-
-sub load_input {
-    my ($filename) = @_;
-    croak("load_input(filename) unimplemented");
-}
-
-sub run_transform {
-    my ($output) = @_;
-    croak("run_transform(output) unimplemented");
-}
-
-sub shutdown {
-}
-
-1;

File Driver/LibXSLT.pm

-# base class.
-package Driver::LibXSLT;
-
-use Driver::BaseClass;
-@ISA = qw(Driver::BaseClass);
-
-use XML::LibXSLT;
-use XML::LibXML;
-
-use vars qw(
-        $parser
-        $xslt
-        $stylesheet
-        $input
-        );
-
-sub init {
-    $parser = XML::LibXML->new();
-    $xslt = XML::LibXSLT->new();
-}
-
-sub load_stylesheet {
-    my ($filename) = @_;
-    my $styledoc = $parser->parse_file($filename);
-    $stylesheet = $xslt->parse_stylesheet($styledoc);
-}
-
-sub load_input {
-    my ($filename) = @_;
-    $input = $parser->parse_file($filename);
-}
-
-sub run_transform {
-    my ($output) = @_;
-    my $results;
-    $results = $stylesheet->transform($input);
-    $stylesheet->output_file($results, $output);
-#    print STDERR "\n";
-}
-
-1;

File Driver/Sablotron.pm

-# base class.
-package Driver::Sablotron;
-
-use Driver::BaseClass;
-@ISA = qw(Driver::BaseClass);
-
-use XML::Sablotron;
-use IO::File;
-
-use vars qw(
-        $xslt
-        $stylesheet
-        $input
-        $handler
-        );
-
-sub init {
-    my %options = @_;
-    $xslt = XML::Sablotron->new();
-    $handler = Driver::Sablotron::Handler->new(%options);
-    $xslt->RegHandler(0, $handler);
-}
-
-sub shutdown {
-    $xslt->ClearError();
-    $xslt->UnregHandler(0, $handler);
-    undef $handler;
-    undef $xslt;
-    undef $input;
-    undef $stylesheet;
-}
-
-sub load_stylesheet {
-    my ($filename) = @_;
-    my $fh = new IO::File;
-    if ($fh->open("< $filename")) {
-        local $/;        
-        $stylesheet = <$fh>;
-        $fh->close;
-    }
-}
-
-sub load_input {
-    my ($filename) = @_;
-    my $fh = new IO::File;   
-    if ($fh->open("< $filename")) { 
-        local $/; 
-        $input = <$fh>;   
-        $fh->close;       
-    }    
-}
-
-use Cwd;
-
-sub run_transform {
-    my ($output) = @_;
-    $handler->{show_error} = 1;
-    open(OUT, ">$output")
-            || die "Can't write $output : $!";
-
-    my $result = '';
-    my $args = ['template', "$stylesheet", 'xml_resource', "$input"];
-
-    my $retcode = $xslt->RunProcessor("arg:/template", "arg:/xml_resource", "arg:/result",                                                [], $args);
-    $result = $xslt->GetResultArg("result");
-
-    print OUT $result;
-    close OUT;
-}
-
-package Driver::Sablotron::Handler;
-
-sub new {
-    my $class = shift;
-    my %options = @_;
-    bless \%options, $class;
-}
-
-sub MHMakeCode {
-    my $self = shift;
-    my $processor = shift;
-
-    my ($severity, $facility, $code) = @_;
-    return $code;
-}
-
-sub MHLog {
-    return 1;
-}
-
-sub MHError {
-    my $self = shift;
-    my $processor = shift;
-    my ($code, $level, @fields) = @_;
-    
-    return unless $self->{show_error};
-    $self->{show_error} = 0;
-    
-    warn "Sablotron [Error]: ", join(' :: ', @fields), "\n" if $self->{verbose};
-    return 1;
-}
-
-1;
-benchmark.pl
 Changes
-Driver/BaseClass.pm
-Driver/LibXSLT.pm
-Driver/Sablotron.pm
 example/1.xml
 example/1.xsl
 example/2.xml

File benchmark.pl

-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 = <CONFIG>) {
-    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 = <REFERENCE>;
-                    my $new = <NEW>;
-                    close REFERENCE;
-                    close NEW;
-                    $new =~ s/\A<\?xml.*?\?>\s*//;
-                    $new =~ s/\A<!DOCTYPE.*?>\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("<norm>$new</norm>");
-                            }
-                            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 <<EOT;
-usage: $0 [options]
-
-    options:
-
-        -c <file>   load configuration from <file>
-                    defaults to testcases/default.conf
-                    
-        -n <num>    run each test case <num> times. Default = 1.
-        
-        -t          only one iteration per test case (note this
-                    is different to -n 1)
-        
-        -d <Driver> test <Driver>. 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;
-}

File benchmark/Driver/BaseClass.pm

+# base class.
+
+package Driver::BaseClass;
+
+use Carp;
+
+sub init {
+    my %options = @_;
+}
+
+sub chdir {
+    my ($dir) = @_;
+    chdir($dir);
+}
+
+sub load_stylesheet {
+    my ($filename) = @_;
+    croak("load_stylesheet(filename) unimplemented");
+}
+
+sub load_input {
+    my ($filename) = @_;
+    croak("load_input(filename) unimplemented");
+}
+
+sub run_transform {
+    my ($output) = @_;
+    croak("run_transform(output) unimplemented");
+}
+
+sub shutdown {
+}
+
+1;

File benchmark/Driver/LibXSLT.pm

+# base class.
+package Driver::LibXSLT;
+
+use Driver::BaseClass;
+@ISA = qw(Driver::BaseClass);
+
+use XML::LibXSLT;
+use XML::LibXML;
+
+use vars qw(
+        $parser
+        $xslt
+        $stylesheet
+        $input
+        );
+
+sub init {
+    $parser = XML::LibXML->new();
+    $xslt = XML::LibXSLT->new();
+}
+
+sub load_stylesheet {
+    my ($filename) = @_;
+    my $styledoc = $parser->parse_file($filename);
+    $stylesheet = $xslt->parse_stylesheet($styledoc);
+}
+
+sub load_input {
+    my ($filename) = @_;
+    $input = $parser->parse_file($filename);
+}
+
+sub run_transform {
+    my ($output) = @_;
+    my $results;
+    $results = $stylesheet->transform($input);
+    $stylesheet->output_file($results, $output);
+#    print STDERR "\n";
+}
+
+1;

File benchmark/Driver/Sablotron.pm

+# base class.
+package Driver::Sablotron;
+
+use Driver::BaseClass;
+@ISA = qw(Driver::BaseClass);
+
+use XML::Sablotron;
+use IO::File;
+
+use vars qw(
+        $xslt
+        $stylesheet
+        $input
+        $handler
+        );
+
+sub init {
+    my %options = @_;
+    $xslt = XML::Sablotron->new();
+    $handler = Driver::Sablotron::Handler->new(%options);
+    $xslt->RegHandler(0, $handler);
+}
+
+sub shutdown {
+    $xslt->ClearError();
+    $xslt->UnregHandler(0, $handler);
+    undef $handler;
+    undef $xslt;
+    undef $input;
+    undef $stylesheet;
+}
+
+sub load_stylesheet {
+    my ($filename) = @_;
+    my $fh = new IO::File;
+    if ($fh->open("< $filename")) {
+        local $/;        
+        $stylesheet = <$fh>;
+        $fh->close;
+    }
+}
+
+sub load_input {
+    my ($filename) = @_;
+    my $fh = new IO::File;   
+    if ($fh->open("< $filename")) { 
+        local $/; 
+        $input = <$fh>;   
+        $fh->close;       
+    }    
+}
+
+use Cwd;
+
+sub run_transform {
+    my ($output) = @_;
+    $handler->{show_error} = 1;
+    open(OUT, ">$output")
+            || die "Can't write $output : $!";
+
+    my $result = '';
+    my $args = ['template', "$stylesheet", 'xml_resource', "$input"];
+
+    my $retcode = $xslt->RunProcessor("arg:/template", "arg:/xml_resource", "arg:/result",                                                [], $args);
+    $result = $xslt->GetResultArg("result");
+
+    print OUT $result;
+    close OUT;
+}
+
+package Driver::Sablotron::Handler;
+
+sub new {
+    my $class = shift;
+    my %options = @_;
+    bless \%options, $class;
+}
+
+sub MHMakeCode {
+    my $self = shift;
+    my $processor = shift;
+
+    my ($severity, $facility, $code) = @_;
+    return $code;
+}
+
+sub MHLog {
+    return 1;
+}
+
+sub MHError {
+    my $self = shift;
+    my $processor = shift;
+    my ($code, $level, @fields) = @_;
+    
+    return unless $self->{show_error};
+    $self->{show_error} = 0;
+    
+    warn "Sablotron [Error]: ", join(' :: ', @fields), "\n" if $self->{verbose};
+    return 1;
+}
+
+1;

File benchmark/benchmark.pl

+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 = <CONFIG>) {
+    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 = <REFERENCE>;
+                    my $new = <NEW>;
+                    close REFERENCE;
+                    close NEW;
+                    $new =~ s/\A<\?xml.*?\?>\s*//;
+                    $new =~ s/\A<!DOCTYPE.*?>\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("<norm>$new</norm>");
+                            }
+                            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 <<EOT;
+usage: $0 [options]
+
+    options:
+
+        -c <file>   load configuration from <file>
+                    defaults to testcases/default.conf
+                    
+        -n <num>    run each test case <num> times. Default = 1.
+        
+        -t          only one iteration per test case (note this
+                    is different to -n 1)
+        
+        -d <Driver> test <Driver>. 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;
+}