t/load-save-speed.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Benchmark 'timethis';
   7 use JSON;
   8 use Sys::Hostname;
   9 use File::Path 'mkpath';
  10
  11 use Text::Tradition;
  12 use Text::Tradition::Directory;
  13 use Test::More;
  14
  15 ## Don't run this test when running make test or prove, to run it use perl -Ilib t/load-save-speed.t
  16
  17 if($ENV{HARNESS_ACTIVE}) {
  18     plan skip_all => 'Skipping performance tests under prove/make, run manually to test performance improvements';
  19 } else {
  20     plan 'no_plan';
  21 }
  22
  23 ## Using t/data/besoin.xml  / t/data/besoin.dot as a large test example:
  24 my $test_name = 'besoin';
  25 # my $test_name = 'simple';
  26
  27 ## Data file for repeated benchmarks:
  28 my $benchmark_file = 't/data/load-save-benchmark.json';
  29
  30 ## SQL file (previously dumped KiokuDB) for testing tradition directory loading:
  31 my $load_sql = 't/data/speed_test_load.sql';
  32
  33 ## uuid to load from the above stored db:
  34 my $load_uuid = '7D0AA7C0-92C2-11E1-98B2-D7BDA89F4671';
  35
  36 ## Pass the git hash to identify this performance improvement, if you
  37 ## want to save the results of this run. Pass nothing to just run a test
  38 ## of the current code against the previous best.
  39 my $git_hash = shift;
  40
  41 if($git_hash) {
  42     diag "Will save results using $git_hash as a key";
  43 } else {
  44     diag "No git hash passed in, just running test";
  45 }
  46
  47 ## Setup
  48 mkpath('t/var') if(!-d 't/var');
  49
  50 my $tradition = Text::Tradition->new(
  51    'input' => 'Self',
  52    'file'  => "t/data/${test_name}.xml"
  53     ## smaller for testing the test!
  54 #    'input' => 'Tabular',
  55 #    'file' => 't/data/simple.txt',
  56 );
  57 $tradition->add_stemma(dotfile => "t/data/${test_name}.dot");
  58
  59 #my $fh = File::Temp->new();
  60 #my $file = $fh->filename;
  61 #$fh->close;
  62 ## use t/var so you can look at the results after if neccessary:
  63
  64 my $load_db = 't/var/speed_test_load.db';
  65 unlink($load_db) if(-e $load_db);
  66 my $load_dsn = "dbi:SQLite:dbname=$load_db";
  67 ## Prime db from .sql file:
  68 ## ?? fails
  69 `sqlite3 $load_db < $load_sql`;
  70
  71 my $save_db = 't/var/speed_test_save.db';
  72 unlink($save_db) if(-e $save_db);
  73 my $save_dsn = "dbi:SQLite:dbname=${save_db}";
  74
  75 my $benchmark_data = load_benchmark($benchmark_file);
  76
  77 my $test_save = sub {
  78     unlink($save_db) if(-e $save_db);
  79
  80     my $dir = Text::Tradition::Directory->new(
  81         dsn => $save_dsn,
  82         extra_args => { create => 1 },
  83     );
  84     ## This seems to be a required magic incantation:
  85     my $scope = $dir->new_scope;
  86
  87     ## save the tradition (with stemma) to the db:
  88     my $uuid = $dir->save($tradition);
  89 #    print STDERR "UUID: $uuid\n";
  90
  91 };
  92
  93 my $test_load = sub {
  94     my $dir = Text::Tradition::Directory->new(
  95         dsn => $load_dsn,
  96     );
  97
  98     ## This seems to be a required magic incantation:
  99     my $scope = $dir->new_scope;
 100
 101     my $load_tradition = $dir->tradition($load_uuid);
 102 #    print STDERR $load_tradition->name, $tradition->name, "\n";
 103 };
 104
 105 ## Find most recent benchmark info on this hostname
 106 my ($last_benchmark) = grep { $_->{host} eq hostname() } (reverse @{$benchmark_data});
 107
 108 if(!$last_benchmark) {
 109     diag "Can't find last benchmark for " . hostname() . ", starting again";
 110     $last_benchmark = fresh_benchmark();
 111 }
 112
 113
 114 ## Benchmark current code:
 115 ## Should probably run the test the same number of times as the last time it ran
 116 ## Or compare results more sanely
 117 my $new_save_result = timethis(5, $test_save);
 118
 119 ok($new_save_result->[1] + $new_save_result->[2] < $last_benchmark->{save_times}[1] + $last_benchmark->{save_times}[2], 'Saving to a Tradition Directory got faster');
 120
 121 my $new_load_result = timethis(20, $test_load);
 122
 123 ok($new_load_result->[1] + $new_load_result->[2] < $last_benchmark->{load_times}[1] + $last_benchmark->{load_times}[2], 'Loading from a Tradition Directory got faster');
 124
 125 $test_load->();
 126
 127 if($git_hash) {
 128     push(@{ $benchmark_data }, {
 129         git_hash => $git_hash,
 130         host => hostname(),
 131         load_times => [@$new_load_result],
 132         save_times => [@$new_save_result],
 133     });
 134
 135     save_benchmark($benchmark_file, $benchmark_data);
 136 }
 137
 138 ## -----------------------------------------------------------------------------
 139
 140 sub load_benchmark {
 141     my ($filename) = @_;
 142
 143     my $loaded_data = [];
 144     if(-e $filename) {
 145         local $/;
 146         open( my $fh, '<', $filename ) || die "$!";
 147         my $json_text   = <$fh>;
 148         $fh->close();
 149         $loaded_data = decode_json( $json_text );
 150     } else {
 151         ## bare bones default table:
 152         $loaded_data = fresh_benchmark();
 153     }
 154
 155     return $loaded_data;
 156 }
 157
 158 sub fresh_benchmark {
 159     return
 160         [
 161          {
 162              git_hash => '',
 163              host => hostname(),
 164              load_times => [1000, 1000, 1000, 0, 0, 5],
 165              save_times => [1000, 1000, 1000, 0, 0, 20],
 166          }
 167     ];
 168 }
 169
 170 sub save_benchmark {
 171     my ($filename, $new_benchmarks) = @_;
 172
 173     my $json_text = JSON->new->utf8->allow_blessed->encode($new_benchmarks);
 174
 175     open(my $fh, '>', $filename) || die "$!";
 176     $fh->print($json_text);
 177     $fh->close();
 178 }