Filename | /mnt/stuff/src/my-cpan/hailo/lib/Hailo/Storage/Schema.pm |
Statements | Executed 67 statements in 1.18ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 194µs | 1.91ms | sth | Hailo::Storage::Schema::
1 | 1 | 1 | 118µs | 2.61ms | deploy | Hailo::Storage::Schema::
1 | 1 | 1 | 58µs | 151µs | BEGIN@3 | Hailo::Storage::Schema::
1 | 1 | 1 | 13µs | 93µs | BEGIN@3.13 | Hailo::Storage::Schema::
1 | 1 | 1 | 13µs | 18µs | BEGIN@4 | Hailo::Storage::Schema::
1 | 1 | 1 | 9µs | 9µs | CORE:sort (opcode) | Hailo::Storage::Schema::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package Hailo::Storage::Schema; | ||||
2 | |||||
3 | 4 | 74µs | 3 | 324µs | use 5.010; # spent 151µs making 1 call to Hailo::Storage::Schema::BEGIN@3
# spent 93µs making 1 call to Hailo::Storage::Schema::BEGIN@3.13
# spent 80µs making 1 call to feature::import |
4 | 2 | 580µs | 2 | 24µs | # spent 18µs (13+5) within Hailo::Storage::Schema::BEGIN@4 which was called:
# once (13µs+5µs) by Hailo::Storage::BEGIN@7 at line 4 # spent 18µs making 1 call to Hailo::Storage::Schema::BEGIN@4
# spent 6µs making 1 call to strict::import |
5 | |||||
6 | ## Soup to spawn the database itself / create statement handles | ||||
7 | # spent 2.61ms (118µs+2.49) within Hailo::Storage::Schema::deploy which was called:
# once (118µs+2.49ms) by Hailo::Storage::_engage at line 109 of lib/Hailo/Storage.pm | ||||
8 | 1 | 3µs | my (undef, $dbd, $dbh, $order) = @_; | ||
9 | 1 | 5µs | my @orders = (0 .. $order-1); | ||
10 | |||||
11 | 1 | 2µs | my $int_primary_key = "INTEGER PRIMARY KEY AUTOINCREMENT"; | ||
12 | 1 | 2µs | $int_primary_key = "INTEGER PRIMARY KEY AUTO_INCREMENT" if $dbd eq "mysql"; | ||
13 | 1 | 2µs | $int_primary_key = "SERIAL UNIQUE" if $dbd eq "Pg"; | ||
14 | |||||
15 | 1 | 2µs | my $text = 'TEXT'; | ||
16 | 1 | 1µs | $text = 'VARCHAR(255)' if $dbd eq 'mysql'; | ||
17 | |||||
18 | 1 | 2µs | my $text_primary = 'TEXT NOT NULL PRIMARY KEY'; | ||
19 | 1 | 1µs | $text_primary = 'TEXT NOT NULL' if $dbd eq 'mysql'; | ||
20 | |||||
21 | 1 | 900ns | my @tables; | ||
22 | |||||
23 | 1 | 3µs | push @tables => <<"TABLE"; | ||
24 | CREATE TABLE info ( | ||||
25 | attribute $text_primary, | ||||
26 | text TEXT NOT NULL | ||||
27 | ); | ||||
28 | TABLE | ||||
29 | |||||
30 | 1 | 3µs | push @tables => <<"TABLE"; | ||
31 | CREATE TABLE token ( | ||||
32 | id $int_primary_key, | ||||
33 | spacing INTEGER NOT NULL, | ||||
34 | text $text NOT NULL, | ||||
35 | count INTEGER NOT NULL | ||||
36 | ); | ||||
37 | TABLE | ||||
38 | |||||
39 | 1 | 6µs | my $token_n = join ",\n ", map { "token${_}_id INTEGER NOT NULL REFERENCES token (id)" } @orders; | ||
40 | 1 | 3µs | push @tables => <<"TABLE"; | ||
41 | CREATE TABLE expr ( | ||||
42 | id $int_primary_key, | ||||
43 | $token_n | ||||
44 | ); | ||||
45 | TABLE | ||||
46 | |||||
47 | 1 | 2µs | push @tables => <<"TABLE"; | ||
48 | CREATE TABLE next_token ( | ||||
49 | id $int_primary_key, | ||||
50 | expr_id INTEGER NOT NULL REFERENCES expr (id), | ||||
51 | token_id INTEGER NOT NULL REFERENCES token (id), | ||||
52 | count INTEGER NOT NULL | ||||
53 | ); | ||||
54 | TABLE | ||||
55 | |||||
56 | 1 | 2µs | push @tables => <<"TABLE"; | ||
57 | CREATE TABLE prev_token ( | ||||
58 | id $int_primary_key, | ||||
59 | expr_id INTEGER NOT NULL REFERENCES expr (id), | ||||
60 | token_id INTEGER NOT NULL REFERENCES token (id), | ||||
61 | count INTEGER NOT NULL | ||||
62 | ); | ||||
63 | TABLE | ||||
64 | |||||
65 | 1 | 2µs | for my $i (@orders) { | ||
66 | 2 | 7µs | push @tables => "CREATE INDEX expr_token${i}_id on expr (token${i}_id);" | ||
67 | } | ||||
68 | |||||
69 | 1 | 4µs | my $columns = join(', ', map { "token${_}_id" } @orders); | ||
70 | 1 | 2µs | push @tables => "CREATE INDEX expr_token_ids on expr ($columns);"; | ||
71 | |||||
72 | 1 | 1µs | push @tables => 'CREATE INDEX token_text on token (text);'; | ||
73 | 1 | 1µs | push @tables => 'CREATE INDEX next_token_expr_id ON next_token (expr_id);'; | ||
74 | 1 | 2µs | push @tables => 'CREATE INDEX prev_token_expr_id ON prev_token (expr_id);'; | ||
75 | |||||
76 | |||||
77 | 1 | 3µs | for (@tables) { | ||
78 | 11 | 114µs | 22 | 4.92ms | $dbh->do($_); # spent 2.49ms making 11 calls to DBI::db::do, avg 227µs/call
# spent 2.43ms making 11 calls to DBD::SQLite::db::do, avg 221µs/call |
79 | } | ||||
80 | |||||
81 | 1 | 6µs | return; | ||
82 | } | ||||
83 | |||||
84 | # create statement handle objects | ||||
85 | # spent 1.91ms (194µs+1.72) within Hailo::Storage::Schema::sth which was called:
# once (194µs+1.72ms) by Hailo::Storage::_build_sth at line 84 of lib/Hailo/Storage.pm | ||||
86 | 1 | 2µs | my (undef, $dbd, $dbh, $order) = @_; | ||
87 | 1 | 3µs | my @orders = (0 .. $order-1); | ||
88 | 1 | 5µs | my @columns = map { "token${_}_id" } 0 .. $order-1; | ||
89 | 1 | 2µs | my $columns = join(', ', @columns); | ||
90 | 1 | 3µs | my @ids = join(', ', ('?') x @columns); | ||
91 | 1 | 2µs | my $ids = join(', ', @ids); | ||
92 | |||||
93 | 1 | 1µs | my $q_rand = 'RANDOM()'; | ||
94 | 1 | 2µs | $q_rand = 'RAND()' if $dbd eq 'mysql'; | ||
95 | |||||
96 | 1 | 2µs | my $q_rand_id = "(abs($q_rand) % (SELECT max(id) FROM expr))"; | ||
97 | 1 | 900ns | $q_rand_id = "(random()*id+1)::int" if $dbd eq 'Pg'; | ||
98 | |||||
99 | my %state = ( | ||||
100 | set_info => qq[INSERT INTO info (attribute, text) VALUES (?, ?);], | ||||
101 | |||||
102 | random_expr => qq[SELECT * FROM expr WHERE id >= $q_rand_id LIMIT 1;], | ||||
103 | token_id => qq[SELECT id FROM token WHERE spacing = ? AND text = ?;], | ||||
104 | token_info => qq[SELECT spacing, text FROM token WHERE id = ?;], | ||||
105 | token_similar => qq[SELECT id, spacing FROM token WHERE text = ? ORDER BY $q_rand LIMIT 1;] , | ||||
106 | add_token => qq[INSERT INTO token (spacing, text, count) VALUES (?, ?, 0)], | ||||
107 | inc_token_count => qq[UPDATE token SET count = count + 1 WHERE id = ?], | ||||
108 | |||||
109 | # ->stats() | ||||
110 | expr_total => qq[SELECT COUNT(*) FROM expr;], | ||||
111 | token_total => qq[SELECT COUNT(*) FROM token;], | ||||
112 | prev_total => qq[SELECT COUNT(*) FROM prev_token;], | ||||
113 | next_total => qq[SELECT COUNT(*) FROM next_token;], | ||||
114 | |||||
115 | # Defaults, overriden in SQLite | ||||
116 | last_expr_rowid => qq[SELECT id FROM expr ORDER BY id DESC LIMIT 1;], | ||||
117 | last_token_rowid => qq[SELECT id FROM token ORDER BY id DESC LIMIT 1;], | ||||
118 | |||||
119 | next_token_count => qq[SELECT count FROM next_token WHERE expr_id = ? AND token_id = ?;], | ||||
120 | prev_token_count => qq[SELECT count FROM prev_token WHERE expr_id = ? AND token_id = ?;], | ||||
121 | next_token_inc => qq[UPDATE next_token SET count = count + 1 WHERE expr_id = ? AND token_id = ?], | ||||
122 | prev_token_inc => qq[UPDATE prev_token SET count = count + 1 WHERE expr_id = ? AND token_id = ?], | ||||
123 | next_token_add => qq[INSERT INTO next_token (expr_id, token_id, count) VALUES (?, ?, 1);], | ||||
124 | prev_token_add => qq[INSERT INTO prev_token (expr_id, token_id, count) VALUES (?, ?, 1);], | ||||
125 | next_token_get => qq[SELECT token_id, count FROM next_token WHERE expr_id = ?;], | ||||
126 | prev_token_get => qq[SELECT token_id, count FROM prev_token WHERE expr_id = ?;], | ||||
127 | |||||
128 | token_count => qq[SELECT count FROM token WHERE id = ?;], | ||||
129 | |||||
130 | add_expr => qq[INSERT INTO expr ($columns) VALUES ($ids)], | ||||
131 | 1 | 29µs | expr_id => qq[SELECT id FROM expr WHERE ] . join(' AND ', map { "token${_}_id = ?" } @orders), | ||
132 | ); | ||||
133 | |||||
134 | 1 | 3µs | for (@orders) { | ||
135 | 2 | 8µs | $state{"expr_by_token${_}_id"} = qq[SELECT * FROM expr WHERE token${_}_id = ? ORDER BY $q_rand LIMIT 1;]; | ||
136 | } | ||||
137 | |||||
138 | # DBD specific queries / optimizations / munging | ||||
139 | 1 | 2µs | given ($dbd) { | ||
140 | 1 | 3µs | when ('SQLite') { | ||
141 | # Optimize these for SQLite | ||||
142 | 1 | 2µs | $state{expr_total} = qq[SELECT seq FROM sqlite_sequence WHERE name = 'expr';]; | ||
143 | 1 | 2µs | $state{token_total} = qq[SELECT seq FROM sqlite_sequence WHERE name = 'token';]; | ||
144 | 1 | 1µs | $state{prev_total} = qq[SELECT seq FROM sqlite_sequence WHERE name = 'prev_token';]; | ||
145 | 1 | 1µs | $state{next_total} = qq[SELECT seq FROM sqlite_sequence WHERE name = 'next_token';]; | ||
146 | } | ||||
147 | } | ||||
148 | |||||
149 | # Sort to make error output easier to read if this fails. The | ||||
150 | # order doesn't matter. | ||||
151 | 1 | 25µs | 1 | 9µs | my @queries = sort keys %state; # spent 9µs making 1 call to Hailo::Storage::Schema::CORE:sort |
152 | 1 | 234µs | 52 | 3.27ms | my %sth = map { $_ => $dbh->prepare($state{$_}) } @queries; # spent 1.71ms making 26 calls to DBI::db::prepare, avg 66µs/call
# spent 1.56ms making 26 calls to DBD::SQLite::db::prepare, avg 60µs/call |
153 | |||||
154 | 1 | 9µs | return \%sth; | ||
155 | } | ||||
156 | |||||
157 | 1 | 3µs | 1; | ||
158 | |||||
159 | =head1 NAME | ||||
160 | |||||
161 | Hailo::Storage::Schema - Deploy the database schema Hailo uses | ||||
162 | |||||
163 | =head1 DESCRIPTION | ||||
164 | |||||
165 | Implements functions to create the database schema and prepared | ||||
166 | database queries L<Hailo::Storage> needs. | ||||
167 | |||||
168 | This class is internal to Hailo and has no public interface. | ||||
169 | |||||
170 | =head1 AUTHOR | ||||
171 | |||||
172 | E<AElig>var ArnfjE<ouml>rE<eth> Bjarmason <avar@cpan.org> | ||||
173 | |||||
174 | =head1 LICENSE AND COPYRIGHT | ||||
175 | |||||
176 | Copyright 2010 E<AElig>var ArnfjE<ouml>rE<eth> Bjarmason | ||||
177 | |||||
178 | This program is free software, you can redistribute it and/or modify | ||||
179 | it under the same terms as Perl itself. | ||||
180 | |||||
181 | =cut | ||||
# spent 9µs within Hailo::Storage::Schema::CORE:sort which was called:
# once (9µs+0s) by Hailo::Storage::Schema::sth at line 151 |