Akron | aa229a2 | 2020-02-18 13:44:25 +0100 | [diff] [blame] | 1 | #!/usr/bin/env perl |
| 2 | use strict; |
| 3 | use warnings; |
| 4 | use Dumbbench; |
| 5 | use File::Basename 'dirname'; |
| 6 | use File::Spec::Functions qw/catfile rel2abs/; |
Akron | 2d547bc | 2020-07-04 10:34:35 +0200 | [diff] [blame^] | 7 | use File::Temp 'tempfile'; |
Akron | aa229a2 | 2020-02-18 13:44:25 +0100 | [diff] [blame] | 8 | use FindBin; |
| 9 | use Getopt::Long; |
| 10 | |
| 11 | BEGIN { |
| 12 | unshift @INC, "$FindBin::Bin/../lib"; |
| 13 | }; |
| 14 | |
Akron | 4f67cd4 | 2020-07-02 12:27:58 +0200 | [diff] [blame] | 15 | use KorAP::XML::TEI; |
| 16 | |
Akron | aa229a2 | 2020-02-18 13:44:25 +0100 | [diff] [blame] | 17 | my $columns = 0; |
| 18 | my $no_header = 0; |
| 19 | GetOptions( |
| 20 | 'columns|c' => \$columns, |
| 21 | 'no-header|n' => \$no_header, |
| 22 | 'help|h' => sub { |
| 23 | print "--columns|-c Print instances in columns\n"; |
| 24 | print "--no-header|-n Dismiss benchmark names\n"; |
| 25 | print "--help|-h Print this page\n\n"; |
| 26 | exit(0); |
| 27 | } |
| 28 | ); |
| 29 | |
| 30 | our $SCRIPT_NAME = 'tei2korapxml'; |
| 31 | |
| 32 | my $f = dirname(__FILE__); |
| 33 | my $script = rel2abs(catfile($f, '..', 'script', $SCRIPT_NAME)); |
| 34 | |
| 35 | # Load example file |
| 36 | my $file = rel2abs(catfile($f, '..', 't', 'data', 'goe_sample.i5.xml')); |
| 37 | |
| 38 | # Create a new benchmark object |
| 39 | my $bench = Dumbbench->new( |
| 40 | verbosity => 0 |
| 41 | ); |
| 42 | |
Akron | 4f67cd4 | 2020-07-02 12:27:58 +0200 | [diff] [blame] | 43 | my $result; |
Akron | 2d547bc | 2020-07-04 10:34:35 +0200 | [diff] [blame^] | 44 | my ($fh, $filename) = tempfile(); |
| 45 | |
| 46 | print $fh <<'HTML'; |
| 47 | mehrzeiliger |
| 48 | Kommentar |
| 49 | --><!-- Versuch |
| 50 | -->ist <!-- a --><!-- b --> ein Test |
| 51 | HTML |
| 52 | |
Akron | 4f67cd4 | 2020-07-02 12:27:58 +0200 | [diff] [blame] | 53 | |
Akron | aa229a2 | 2020-02-18 13:44:25 +0100 | [diff] [blame] | 54 | # Add benchmark instances |
| 55 | $bench->add_instances( |
| 56 | Dumbbench::Instance::PerlSub->new( |
| 57 | name => 'SimpleConversion', |
| 58 | code => sub { |
| 59 | `cat '$file' | perl '$script' > /dev/null 2>&1` |
| 60 | } |
Akron | 4f67cd4 | 2020-07-02 12:27:58 +0200 | [diff] [blame] | 61 | ), |
| 62 | Dumbbench::Instance::PerlSub->new( |
| 63 | name => 'delHTMLcom', |
| 64 | code => sub { |
| 65 | for (1..100_000) { |
| 66 | $result = KorAP::XML::TEI::delHTMLcom( |
| 67 | \*STDIN, |
| 68 | "This <!-- comment --> is a test " . $_ |
| 69 | ); |
| 70 | }; |
| 71 | } |
| 72 | ), |
Akron | 2d547bc | 2020-07-04 10:34:35 +0200 | [diff] [blame^] | 73 | Dumbbench::Instance::PerlSub->new( |
| 74 | name => 'delHTMLcom-long', |
| 75 | code => sub { |
| 76 | for (1..10_000) { |
| 77 | $result = KorAP::XML::TEI::delHTMLcom( |
| 78 | $fh, |
| 79 | "This <!--" . $_ |
| 80 | ); |
| 81 | seek($fh, 0, 0); |
| 82 | }; |
| 83 | } |
| 84 | ), |
Akron | aa229a2 | 2020-02-18 13:44:25 +0100 | [diff] [blame] | 85 | ); |
| 86 | |
| 87 | # Run benchmarks |
| 88 | $bench->run; |
| 89 | |
Akron | 2d547bc | 2020-07-04 10:34:35 +0200 | [diff] [blame^] | 90 | # Clean up |
| 91 | close($fh); |
| 92 | |
Akron | aa229a2 | 2020-02-18 13:44:25 +0100 | [diff] [blame] | 93 | # Output in a single row |
| 94 | if ($columns) { |
| 95 | unless ($no_header) { |
| 96 | print join("\t", map { $_->name } $bench->instances), "\n"; |
| 97 | }; |
| 98 | print join("\t", map { $_->result->raw_number } $bench->instances), "\n"; |
| 99 | exit(0); |
| 100 | }; |
| 101 | |
| 102 | # Output simple timings for comparation |
| 103 | foreach my $inst ($bench->instances) { |
| 104 | unless ($no_header) { |
| 105 | print $inst->name, ': '; |
| 106 | }; |
| 107 | print $inst->result->raw_number, "\n"; |
| 108 | }; |
| 109 | |
| 110 | exit(0); |
| 111 | |
| 112 | __END__ |