remove some debugging statements
[scpubgit/stemmatology.git] / t / load-save-speed.t
CommitLineData
fc7b6388 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6use Benchmark 'timethis';
7use JSON;
8use Sys::Hostname;
9use File::Path 'mkpath';
10
11use Text::Tradition;
12use Text::Tradition::Directory;
13use 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
17if($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:
24my $test_name = 'besoin';
25# my $test_name = 'simple';
26
27## Data file for repeated benchmarks:
28my $benchmark_file = 't/data/load-save-benchmark.json';
29
30## SQL file (previously dumped KiokuDB) for testing tradition directory loading:
31my $load_sql = 't/data/speed_test_load.sql';
32
33## uuid to load from the above stored db:
34my $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.
39my $git_hash = shift;
40
41if($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
48mkpath('t/var') if(!-d 't/var');
49
50my $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
64my $load_db = 't/var/speed_test_load.db';
65unlink($load_db) if(-e $load_db);
66my $load_dsn = "dbi:SQLite:dbname=$load_db";
67## Prime db from .sql file:
68## ?? fails
69`sqlite3 $load_db < $load_sql`;
70
71my $save_db = 't/var/speed_test_save.db';
72unlink($save_db) if(-e $save_db);
73my $save_dsn = "dbi:SQLite:dbname=${save_db}";
74
75my $benchmark_data = load_benchmark($benchmark_file);
76
77my $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
93my $load_tradition;
94my $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
107my ($last_benchmark) = grep { $_->{host} eq hostname() } (reverse @{$benchmark_data});
108
109if(!$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
118my $new_save_result = timethis(5, $test_save);
119
120my $new_save = $new_save_result->[1] + $new_save_result->[2];
121use Data::Dump;
122
123my $old_save = $last_benchmark->{save_times}[1] + $last_benchmark->{save_times}[2];
124ok( $new_save < $old_save, "Saving to a Tradition Directory got faster: $new_save vs $old_save");
125
126my $new_load_result = timethis(20, $test_load);
127
128my $new_load = $new_load_result->[1] + $new_load_result->[2];
129my $old_load = $last_benchmark->{load_times}[1] + $last_benchmark->{load_times}[2];
130ok($new_load < $old_load, "Loading from a Tradition Directory got faster: $new_load vs $old_load");
131
132$test_load->();
133isa_ok($load_tradition, 'Text::Tradition');
134ok($load_tradition->collation->as_svg());
135
136if($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
149sub 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
167sub 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
176sub 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}