Commit | Line | Data |
c4b7a40d |
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( |
dcfafc0e |
86 | dsn => $load_dsn, |
c4b7a40d |
87 | ); |
88 | |
89 | ## This seems to be a required magic incantation: |
90 | my $scope = $dir->new_scope; |
91 | |
dcfafc0e |
92 | my $load_tradition = $dir->tradition($load_uuid); |
93 | # print STDERR $load_tradition->name, $tradition->name, "\n"; |
c4b7a40d |
94 | }; |
95 | |
96 | my $last_benchmark = $benchmark_data->[-1]; |
dcfafc0e |
97 | |
c4b7a40d |
98 | ## Benchmark current code: |
dcfafc0e |
99 | ## Should probably run the test the same number of times as the last time it ran |
100 | ## Or compare results more sanely |
c4b7a40d |
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 | |
dcfafc0e |
109 | $test_load->(); |
110 | |
c4b7a40d |
111 | if($git_hash) { |
112 | push(@{ $benchmark_data }, { |
113 | git_hash => $git_hash, |
dcfafc0e |
114 | load_times => [@$new_load_result], |
115 | save_times => [@$new_save_result], |
c4b7a40d |
116 | }); |
117 | |
dcfafc0e |
118 | save_benchmark($benchmark_file, $benchmark_data); |
c4b7a40d |
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], |
dcfafc0e |
139 | save_times => [1000, 1000, 1000, 0, 0, 20], |
c4b7a40d |
140 | } |
141 | ]; |
142 | } |
143 | |
144 | return $loaded_data; |
145 | } |
146 | |
147 | sub save_benchmark { |
148 | my ($filename, $new_benchmarks) = @_; |
149 | |
dcfafc0e |
150 | my $json_text = JSON->new->utf8->allow_blessed->encode($new_benchmarks); |
c4b7a40d |
151 | |
152 | open(my $fh, '>', $filename) || die "$!"; |
153 | $fh->print($json_text); |
154 | $fh->close(); |
155 | } |