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 = 'load-test';
  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 $load_tradition;
  94 my $test_load = sub {
  95     my $dir = Text::Tradition::Directory->new(
  96         dsn => $load_dsn,
  97     );
  98
  99     ## This seems to be a required magic incantation:
 100     my $scope = $dir->new_scope;
 101
 102     $load_tradition = $dir->tradition($load_uuid);
 103 #    print STDERR $load_tradition->name, $tradition->name, "\n";
 104 };
 105
 106 ## Find most recent benchmark info on this hostname
 107 my ($last_benchmark) = grep { $_->{host} eq hostname() } (reverse @{$benchmark_data});
 108
 109 if(!$last_benchmark) {
 110     diag "Can't find last benchmark for " . hostname() . ", starting again";
 111     $last_benchmark = fresh_benchmark();
 112 }
 113
 114
 115 ## Benchmark current code:
 116 ## Should probably run the test the same number of times as the last time it ran
 117 ## Or compare results more sanely
 118 my $new_save_result = timethis(5, $test_save);
 119
 120 my $new_save = $new_save_result->[1] + $new_save_result->[2];
 121 use Data::Dump;
 122
 123 my $old_save = $last_benchmark->{save_times}[1] + $last_benchmark->{save_times}[2];
 124 ok( $new_save < $old_save, "Saving to a Tradition Directory got faster: $new_save vs $old_save");
 125
 126 my $new_load_result = timethis(20, $test_load);
 127
 128 my $new_load = $new_load_result->[1] + $new_load_result->[2];
 129 my $old_load = $last_benchmark->{load_times}[1] + $last_benchmark->{load_times}[2];
 130 ok($new_load < $old_load, "Loading from a Tradition Directory got faster: $new_load vs $old_load");
 131
 132 $test_load->();
 133 isa_ok($load_tradition, 'Text::Tradition');
 134 ok($load_tradition->collation->as_svg());
 135
 136 if($git_hash) {
 137     push(@{ $benchmark_data }, {
 138         git_hash => $git_hash,
 139         host => hostname(),
 140         load_times => [@$new_load_result],
 141         save_times => [@$new_save_result],
 142     });
 143
 144     save_benchmark($benchmark_file, $benchmark_data);
 145 }
 146
 147 ## -----------------------------------------------------------------------------
 148
 149 sub load_benchmark {
 150     my ($filename) = @_;
 151
 152     my $loaded_data = [];
 153     if(-e $filename) {
 154         local $/;
 155         open( my $fh, '<', $filename ) || die "$!";
 156         my $json_text   = <$fh>;
 157         $fh->close();
 158         $loaded_data = decode_json( $json_text );
 159     } else {
 160         ## bare bones default table:
 161         $loaded_data = fresh_benchmark();
 162     }
 163
 164     return $loaded_data;
 165 }
 166
 167 sub fresh_benchmark {
 168     return {
 169              git_hash => '',
 170              host => hostname(),
 171              load_times => [1000, 1000, 1000, 0, 0, 5],
 172              save_times => [1000, 1000, 1000, 0, 0, 20],
 173          }
 174 }
 175
 176 sub save_benchmark {
 177     my ($filename, $new_benchmarks) = @_;
 178
 179     my $json_text = JSON->new->utf8->allow_blessed->encode($new_benchmarks);
 180
 181     open(my $fh, '>', $filename) || die "$!";
 182     $fh->print($json_text);
 183     $fh->close();
 184 }