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