6 use Benchmark 'timethis';
8 use File::Path 'mkpath';
11 use Text::Tradition::Directory;
14 ## Don't run this test when running make test or prove, to run it use perl -Ilib t/load-save-speed.t
16 if($ENV{HARNESS_ACTIVE}) {
17 plan skip_all => 'Skipping performance tests under prove/make, run manually to test performance improvements';
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';
26 ## Data file for repeated benchmarks:
27 my $benchmark_file = 't/data/load-save-benchmark.json';
29 ## SQL file (previously dumped KiokuDB) for testing tradition directory loading:
30 my $load_sql = 't/data/speed_test_load.sql';
32 ## uuid to load from the above stored db:
33 my $load_uuid = '7D0AA7C0-92C2-11E1-98B2-D7BDA89F4671';
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.
41 diag "Will save results using $git_hash as a key";
43 diag "No git hash passed in, just running test";
47 mkpath('t/var') if(!-d 't/var');
49 my $tradition = Text::Tradition->new(
51 'file' => "t/data/${test_name}.xml"
52 ## smaller for testing the test!
53 # 'input' => 'Tabular',
54 # 'file' => 't/data/simple.txt',
56 $tradition->add_stemma(dotfile => "t/data/${test_name}.dot");
58 #my $fh = File::Temp->new();
59 #my $file = $fh->filename;
61 ## use t/var so you can look at the results after if neccessary:
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:
68 `sqlite3 $load_db < $load_sql`;
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}";
74 my $benchmark_data = load_benchmark($benchmark_file);
77 unlink($save_db) if(-e $save_db);
79 my $dir = Text::Tradition::Directory->new(
81 extra_args => { create => 1 },
83 ## This seems to be a required magic incantation:
84 my $scope = $dir->new_scope;
86 ## save the tradition (with stemma) to the db:
87 my $uuid = $dir->save($tradition);
88 # print STDERR "UUID: $uuid\n";
93 my $dir = Text::Tradition::Directory->new(
97 ## This seems to be a required magic incantation:
98 my $scope = $dir->new_scope;
100 my $load_tradition = $dir->tradition($load_uuid);
101 # print STDERR $load_tradition->name, $tradition->name, "\n";
104 my $last_benchmark = $benchmark_data->[-1];
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);
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');
113 my $new_load_result = timethis(20, $test_load);
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');
120 push(@{ $benchmark_data }, {
121 git_hash => $git_hash,
122 load_times => [@$new_load_result],
123 save_times => [@$new_save_result],
126 save_benchmark($benchmark_file, $benchmark_data);
129 ## -----------------------------------------------------------------------------
134 my $loaded_data = [];
137 open( my $fh, '<', $filename ) || die "$!";
138 my $json_text = <$fh>;
140 $loaded_data = decode_json( $json_text );
142 ## bare bones default table:
146 load_times => [1000, 1000, 1000, 0, 0, 5],
147 save_times => [1000, 1000, 1000, 0, 0, 20],
156 my ($filename, $new_benchmarks) = @_;
158 my $json_text = JSON->new->utf8->allow_blessed->encode($new_benchmarks);
160 open(my $fh, '>', $filename) || die "$!";
161 $fh->print($json_text);