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