| 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 | Hailo::Storage::Schema::sth |
| 1 | 1 | 1 | 43µs | 144µs | Hailo::Storage::Schema::BEGIN@9 |
| 1 | 1 | 1 | 23µs | 23µs | Hailo::Storage::Schema::BEGIN@2 |
| 1 | 1 | 1 | 15µs | 15µs | Hailo::Storage::Schema::CORE:sort (opcode) |
| 1 | 1 | 1 | 14µs | 102µs | Hailo::Storage::Schema::BEGIN@9.8 |
| 1 | 1 | 1 | 13µs | 18µs | Hailo::Storage::Schema::BEGIN@10 |
| 1 | 1 | 1 | 5µs | 5µs | Hailo::Storage::Schema::BEGIN@5 |
| 0 | 0 | 0 | 0s | 0s | Hailo::Storage::Schema::deploy |
| 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 |