6 use Benchmark 'timethis';
9 use File::Path 'mkpath';
12 use Text::Tradition::Directory;
14 use Test::Memory::Cycle;
16 ## Don't run this test when running make test or prove, to run it use perl -Ilib t/load-save-speed.t
18 if($ENV{HARNESS_ACTIVE}) {
19 plan skip_all => 'Skipping performance tests under prove/make, run manually to test performance improvements';
24 ## Using t/data/besoin.xml / t/data/besoin.dot as a large test example:
25 my $test_name = 'besoin';
26 # my $test_name = 'simple';
28 ## Data file for repeated benchmarks:
29 my $benchmark_file = 't/data/load-save-benchmark.json';
31 ## SQL file (previously dumped KiokuDB) for testing tradition directory loading:
32 # my $load_sql = 't/data/speed_test_load.sql';
34 ## uuid to load from the above stored db:
35 my $load_uuid = 'load-test';
37 ## Pass the git hash to identify this performance improvement, if you
38 ## want to save the results of this run. Pass nothing to just run a test
39 ## of the current code against the previous best.
43 diag "Will save results using $git_hash as a key";
45 diag "No git hash passed in, just running test";
49 mkpath('t/var') if(!-d 't/var');
51 my $tradition = Text::Tradition->new(
53 'file' => "t/data/${test_name}.xml"
54 ## smaller for testing the test!
55 # 'input' => 'Tabular',
56 # 'file' => 't/data/simple.txt',
58 #$tradition->add_stemma(dotfile => "t/data/${test_name}.dot");
60 #my $fh = File::Temp->new();
61 #my $file = $fh->filename;
63 ## use t/var so you can look at the results after if neccessary:
65 #my $load_db = 't/var/speed_test_load.db';
66 #unlink($load_db) if(-e $load_db);
67 #my $load_dsn = "dbi:SQLite:dbname=$load_db";
68 ## Prime db from .sql file:
71 #`sqlite3 $load_db < $load_sql`;
73 my $save_db = 't/var/speed_test_save.db';
74 unlink($save_db) if(-e $save_db);
75 my $save_dsn = "dbi:SQLite:dbname=${save_db}";
77 my $benchmark_data = load_benchmark($benchmark_file);
80 unlink($save_db) if(-e $save_db);
82 my $dir = Text::Tradition::Directory->new(
84 extra_args => { create => 1 },
86 ## This seems to be a required magic incantation:
87 my $scope = $dir->new_scope;
89 ## save the tradition (with stemma) to the db:
90 $dir->save($load_uuid => $tradition);
91 # print STDERR "UUID: $uuid\n";
96 my $dir = Text::Tradition::Directory->new(
100 ## This seems to be a required magic incantation:
101 my $scope = $dir->new_scope;
102 my $t = $dir->tradition($load_uuid);
104 # print STDERR $load_tradition->name, $tradition->name, "\n";
107 ## Find most recent benchmark info on this hostname
108 my ($last_benchmark) = grep { $_->{host} eq hostname() } (reverse @{$benchmark_data});
110 if(!$last_benchmark) {
111 diag "Can't find last benchmark for " . hostname() . ", starting again";
112 $last_benchmark = fresh_benchmark();
116 # Benchmark current code:
117 # Should probably run the test the same number of times as the last time it ran
118 # Or compare results more sanely
119 my $new_save_result = timethis(5, $test_save);
121 my $new_save = $new_save_result->[1] + $new_save_result->[2];
124 my $old_save = $last_benchmark->{save_times}[1] + $last_benchmark->{save_times}[2];
125 ok( $new_save < $old_save, "Saving to a Tradition Directory got faster: $new_save vs $old_save");
127 my $new_load_result = timethis(5, $test_load);
129 my $new_load = $new_load_result->[1] + $new_load_result->[2];
130 my $old_load = $last_benchmark->{load_times}[1] + $last_benchmark->{load_times}[2];
131 ok($new_load < $old_load, "Loading from a Tradition Directory got faster: $new_load vs $old_load");
133 my $load_tradition = $test_load->();
134 isa_ok($load_tradition, 'Text::Tradition');
135 ok($load_tradition->collation->as_svg());
138 push(@{ $benchmark_data }, {
139 git_hash => $git_hash,
141 load_times => [@$new_load_result],
142 save_times => [@$new_save_result],
145 save_benchmark($benchmark_file, $benchmark_data);
148 # -----------------------------------------------------------------------------
153 my $loaded_data = [];
156 open( my $fh, '<', $filename ) || die "$!";
157 my $json_text = <$fh>;
159 $loaded_data = decode_json( $json_text );
161 ## bare bones default table:
162 $loaded_data = fresh_benchmark();
168 sub fresh_benchmark {
172 load_times => [1000, 1000, 1000, 0, 0, 5],
173 save_times => [1000, 1000, 1000, 0, 0, 20],
178 my ($filename, $new_benchmarks) = @_;
180 my $json_text = JSON->new->utf8->allow_blessed->encode($new_benchmarks);
182 open(my $fh, '>', $filename) || die "$!";
183 $fh->print($json_text);