Commit | Line | Data |
fc7b6388 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Benchmark 'timethis'; |
7 | use JSON; |
8 | use Sys::Hostname; |
9 | use File::Path 'mkpath'; |
10 | |
11 | use Text::Tradition; |
12 | use Text::Tradition::Directory; |
13 | use Test::More; |
f3f26624 |
14 | use Test::Memory::Cycle; |
fc7b6388 |
15 | |
16 | ## Don't run this test when running make test or prove, to run it use perl -Ilib t/load-save-speed.t |
17 | |
18 | if($ENV{HARNESS_ACTIVE}) { |
19 | plan skip_all => 'Skipping performance tests under prove/make, run manually to test performance improvements'; |
20 | } else { |
21 | plan 'no_plan'; |
22 | } |
23 | |
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'; |
27 | |
28 | ## Data file for repeated benchmarks: |
29 | my $benchmark_file = 't/data/load-save-benchmark.json'; |
30 | |
31 | ## SQL file (previously dumped KiokuDB) for testing tradition directory loading: |
f3f26624 |
32 | # my $load_sql = 't/data/speed_test_load.sql'; |
fc7b6388 |
33 | |
34 | ## uuid to load from the above stored db: |
35 | my $load_uuid = 'load-test'; |
36 | |
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. |
40 | my $git_hash = shift; |
41 | |
42 | if($git_hash) { |
43 | diag "Will save results using $git_hash as a key"; |
44 | } else { |
45 | diag "No git hash passed in, just running test"; |
46 | } |
47 | |
48 | ## Setup |
49 | mkpath('t/var') if(!-d 't/var'); |
50 | |
51 | my $tradition = Text::Tradition->new( |
52 | 'input' => 'Self', |
53 | 'file' => "t/data/${test_name}.xml" |
54 | ## smaller for testing the test! |
55 | # 'input' => 'Tabular', |
56 | # 'file' => 't/data/simple.txt', |
57 | ); |
951ddfe8 |
58 | #$tradition->add_stemma(dotfile => "t/data/${test_name}.dot"); |
fc7b6388 |
59 | |
60 | #my $fh = File::Temp->new(); |
61 | #my $file = $fh->filename; |
62 | #$fh->close; |
63 | ## use t/var so you can look at the results after if neccessary: |
64 | |
f3f26624 |
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"; |
fc7b6388 |
68 | ## Prime db from .sql file: |
69 | ## ?? fails |
f3f26624 |
70 | |
71 | #`sqlite3 $load_db < $load_sql`; |
fc7b6388 |
72 | |
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}"; |
76 | |
77 | my $benchmark_data = load_benchmark($benchmark_file); |
78 | |
79 | my $test_save = sub { |
80 | unlink($save_db) if(-e $save_db); |
81 | |
82 | my $dir = Text::Tradition::Directory->new( |
83 | dsn => $save_dsn, |
84 | extra_args => { create => 1 }, |
85 | ); |
86 | ## This seems to be a required magic incantation: |
87 | my $scope = $dir->new_scope; |
88 | |
89 | ## save the tradition (with stemma) to the db: |
f3f26624 |
90 | $dir->save($load_uuid => $tradition); |
fc7b6388 |
91 | # print STDERR "UUID: $uuid\n"; |
92 | |
93 | }; |
94 | |
fc7b6388 |
95 | my $test_load = sub { |
96 | my $dir = Text::Tradition::Directory->new( |
f3f26624 |
97 | dsn => $save_dsn, |
fc7b6388 |
98 | ); |
99 | |
100 | ## This seems to be a required magic incantation: |
101 | my $scope = $dir->new_scope; |
f3f26624 |
102 | my $t = $dir->tradition($load_uuid); |
103 | return $t; |
fc7b6388 |
104 | # print STDERR $load_tradition->name, $tradition->name, "\n"; |
105 | }; |
106 | |
107 | ## Find most recent benchmark info on this hostname |
108 | my ($last_benchmark) = grep { $_->{host} eq hostname() } (reverse @{$benchmark_data}); |
109 | |
110 | if(!$last_benchmark) { |
111 | diag "Can't find last benchmark for " . hostname() . ", starting again"; |
112 | $last_benchmark = fresh_benchmark(); |
113 | } |
114 | |
115 | |
f3f26624 |
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 |
fc7b6388 |
119 | my $new_save_result = timethis(5, $test_save); |
120 | |
121 | my $new_save = $new_save_result->[1] + $new_save_result->[2]; |
f3f26624 |
122 | #use Data::Dump; |
fc7b6388 |
123 | |
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"); |
126 | |
f3f26624 |
127 | my $new_load_result = timethis(5, $test_load); |
fc7b6388 |
128 | |
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"); |
132 | |
f3f26624 |
133 | my $load_tradition = $test_load->(); |
fc7b6388 |
134 | isa_ok($load_tradition, 'Text::Tradition'); |
135 | ok($load_tradition->collation->as_svg()); |
136 | |
137 | if($git_hash) { |
138 | push(@{ $benchmark_data }, { |
139 | git_hash => $git_hash, |
140 | host => hostname(), |
141 | load_times => [@$new_load_result], |
142 | save_times => [@$new_save_result], |
143 | }); |
144 | |
145 | save_benchmark($benchmark_file, $benchmark_data); |
146 | } |
147 | |
f3f26624 |
148 | # ----------------------------------------------------------------------------- |
fc7b6388 |
149 | |
150 | sub load_benchmark { |
151 | my ($filename) = @_; |
152 | |
153 | my $loaded_data = []; |
154 | if(-e $filename) { |
155 | local $/; |
156 | open( my $fh, '<', $filename ) || die "$!"; |
157 | my $json_text = <$fh>; |
158 | $fh->close(); |
159 | $loaded_data = decode_json( $json_text ); |
160 | } else { |
161 | ## bare bones default table: |
162 | $loaded_data = fresh_benchmark(); |
163 | } |
164 | |
165 | return $loaded_data; |
166 | } |
167 | |
168 | sub fresh_benchmark { |
169 | return { |
170 | git_hash => '', |
171 | host => hostname(), |
172 | load_times => [1000, 1000, 1000, 0, 0, 5], |
173 | save_times => [1000, 1000, 1000, 0, 0, 20], |
174 | } |
175 | } |
176 | |
177 | sub save_benchmark { |
178 | my ($filename, $new_benchmarks) = @_; |
179 | |
180 | my $json_text = JSON->new->utf8->allow_blessed->encode($new_benchmarks); |
181 | |
182 | open(my $fh, '>', $filename) || die "$!"; |
183 | $fh->print($json_text); |
184 | $fh->close(); |
185 | } |