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