← Back to branch summary

~ubuntu-branches/ubuntu/vivid/libxml-bare-perl/vivid

« back to all changes in this revision

Viewing changes to bench/onenotree.pl

  • Committer: Package Import Robot
  • Author(s): Nuno Carvalho, gregor herrmann, Salvatore Bonaccorso, Axel Beckert, Nuno Carvalho
  • Date: 2013-09-17 15:54:28 UTC
  • mfrom: (1.1.4)
  • Revision ID: package-import@ubuntu.com-20130917155428-4d0xb5cissw2323f
Tags: 0.53-1
* Team upload.

[ gregor herrmann ]
* debian/control: update {versioned,alternative} (build) dependencies.

[ Salvatore Bonaccorso ]
* Change Vcs-Git to canonical URI (git://anonscm.debian.org)
* Change search.cpan.org based URIs to metacpan.org based URIs

[ Axel Beckert ]
* debian/copyright: migrate pre-1.0 format to 1.0 using "cme fix dpkg-
  copyright"

[ Nuno Carvalho ]
* New upstream release.
* debian/copyright: update copyright years.
* debian/control: update standards version.
* debian/control: update debhelper required version, in order to pass all
  the hardening flags to EUMM.
* Add lintian override to apparently false-positive warning.
* Add set of patches accepted upstream but still not included in this
  release, visit https://rt.cpan.org/Public/Bug/Display.html?id=88155
  for details.

Show diffs side-by-side

added added

removed removed

Lines of Context:
bench/onenotree.pl
1
 
#!/usr/bin/perl
2
 
use strict;
3
 
 
4
 
my $div    = "\/";
5
 
my $maxlen = 26;
6
 
my $file   = $ARGV[1] || 'test.xml';
7
 
my ( $root, $s, $s2, $s3, $usec, $usec2, $usec3, $sa, $sb, $sc, $base1, $base2, $base3 );
8
 
 
9
 
my $onlyone = $ARGV[2] ? 1 : 0;
10
 
 
11
 
tabit( "-Module-", 'load    ', 'parse   ', 'total' ) if ( !$onlyone );
12
 
 
13
 
exit if ( !$ARGV[0] );
14
 
 
15
 
use Time::HiRes qw(gettimeofday);
16
 
 
17
 
# For fairness; try to get the file to be read into memory cache
18
 
{
19
 
    open( FILE, '<', $file ) or die "Couldn't open $!";
20
 
    local $/ = undef;
21
 
    my $cache = <FILE>;
22
 
    close(FILE);
23
 
}
24
 
 
25
 
if ( $ARGV[0] * 1 >= 0 ) {
26
 
    ( $s, $usec ) = gettimeofday();
27
 
    if ( eval('require XML::Bare;') ) {
28
 
        ( $s2, $usec2 ) = gettimeofday();
29
 
 
30
 
        my $ob = new XML::Bare( file => $file );
31
 
 
32
 
        ( $s3, $usec3 ) = gettimeofday();
33
 
        unload('XML::Bare');
34
 
        timeit( 'XML::Bare', 1 );
35
 
    }
36
 
}
37
 
 
38
 
if ( $ARGV[0] eq '1' ) {
39
 
    ( $s, $usec ) = gettimeofday();
40
 
    if ( eval('require XML::LibXML;') ) {
41
 
        ( $s2, $usec2 ) = gettimeofday();
42
 
 
43
 
        my $parser = XML::LibXML->new();
44
 
        my $doc    = $parser->parse_file($file);
45
 
 
46
 
        ( $s3, $usec3 ) = gettimeofday();
47
 
        unload('XML::LibXML');
48
 
        timeit('XML::LibXML');
49
 
    }
50
 
}
51
 
 
52
 
if ( $ARGV[0] eq '2' ) {
53
 
    ( $s, $usec ) = gettimeofday();
54
 
    if ( eval('require XML::Parser;') ) {
55
 
        ( $s2, $usec2 ) = gettimeofday();
56
 
 
57
 
        my $parser = new XML::Parser();
58
 
        my $doc    = $parser->parsefile($file);
59
 
 
60
 
        ( $s3, $usec3 ) = gettimeofday();
61
 
        unload('XML::Parser');
62
 
        timeit('XML::Parser');
63
 
    }
64
 
}
65
 
 
66
 
if ( $ARGV[0] eq '3' ) {
67
 
    ( $s, $usec ) = gettimeofday();
68
 
    if ( eval('require XML::Parser::Expat;') ) {
69
 
        ( $s2, $usec2 ) = gettimeofday();
70
 
 
71
 
        my $parser = new XML::Parser::Expat();
72
 
        sub noop { }
73
 
        $parser->setHandlers( 'Start' => \&noop, 'End' => \&noop, 'Char' => \&noop );
74
 
        open( FOO, $file ) or die "Couldn't open $!";
75
 
        $parser->parse(*FOO);
76
 
        close(FOO);
77
 
 
78
 
        ( $s3, $usec3 ) = gettimeofday();
79
 
        unload('XML::Parser::Expat');
80
 
        timeit('XML::Parser::Expat');
81
 
    }
82
 
}
83
 
 
84
 
if ( $ARGV[0] eq '4' ) {
85
 
    ( $s, $usec ) = gettimeofday();
86
 
    if ( eval('require XML::Descent;') ) {
87
 
        ( $s2, $usec2 ) = gettimeofday();
88
 
 
89
 
        my $p = XML::Descent->new( { Input => $file } );
90
 
        $p->on(
91
 
            item => sub {
92
 
                my ( $elem, $attr ) = @_;
93
 
                $p->walk;    # recurse
94
 
            }
95
 
        );
96
 
        $p->walk;
97
 
 
98
 
        ( $s3, $usec3 ) = gettimeofday();
99
 
        unload('XML::Descent');
100
 
        timeit('XML::Descent');
101
 
    }
102
 
}
103
 
 
104
 
if ( $ARGV[0] eq '5' ) {
105
 
    ( $s, $usec ) = gettimeofday();
106
 
    if ( eval('require XML::DOM;') ) {
107
 
        ( $s2, $usec2 ) = gettimeofday();
108
 
 
109
 
        my $parser = new XML::DOM::Parser;
110
 
        my $doc    = $parser->parsefile($file);    ##
111
 
 
112
 
        ( $s3, $usec3 ) = gettimeofday();
113
 
        unload('XML::DOM');
114
 
        timeit('XML::DOM');
115
 
    }
116
 
}
117
 
 
118
 
sub unload {
119
 
    my $module = shift;
120
 
    my @parts = split( ' ', $module );
121
 
    $module = $parts[0];
122
 
    $module =~ s/::/\//g;
123
 
    $module .= '.pm';
124
 
    delete $INC{$module};
125
 
}
126
 
 
127
 
sub timeit {
128
 
    my $name = shift;
129
 
    my $base = shift;
130
 
    $sa = $s2 - $s +  ( ( $usec2 - $usec ) / 1000000 );
131
 
    $sb = $s3 - $s2 + ( ( $usec3 - $usec2 ) / 1000000 );
132
 
    $sc = $s3 - $s +  ( ( $usec3 - $usec ) / 1000000 );
133
 
    if ($base) {
134
 
        $base1 = $sa;
135
 
        $base2 = $sb;
136
 
        $base3 = $sc;
137
 
    }
138
 
    $sa /= $base1;
139
 
    $sb /= $base2;
140
 
    $sc /= $base3;
141
 
    $sa = fixed($sa);
142
 
    $sb = fixed($sb);
143
 
    $sc = fixed($sc);
144
 
    if ( !$base || !$onlyone ) {
145
 
        tabit( $name, $sa, $sb, $sc );
146
 
    }
147
 
}
148
 
 
149
 
sub tabit {
150
 
    my ( $a, $b, $c, $d ) = @_;
151
 
    my $len = length($a);
152
 
    print $a;
153
 
    for ( 0 .. ( $maxlen - $len ) ) { print ' '; }
154
 
    print "$b $c $d\n";
155
 
}
156
 
 
157
 
sub fixed {
158
 
    my $in = shift;
159
 
    $in *= 10000;
160
 
    $in = int($in);
161
 
    $in /= 10000;
162
 
    my $a   = "$in";
163
 
    my $len = length($a);
164
 
    if ( $len > 8 ) { $a = substr( $a, 8 ); }
165
 
    if ( $len < 8 ) {
166
 
        while ( $len < 8 ) {
167
 
            $a   = "${a} ";
168
 
            $len = length($a);
169
 
        }
170
 
    }
171
 
    return $a;
172
 
}