Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/x86_64-linux/DBD/SQLite.pm |
Statements | Executed 1683 statements in 7.94s |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
71 | 1 | 1 | 11.0ms | 7.93s | do | DBD::SQLite::db::
145 | 2 | 2 | 3.70ms | 37.2ms | prepare | DBD::SQLite::db::
6 | 1 | 1 | 1.15ms | 1.15ms | _login (xsub) | DBD::SQLite::db::
6 | 1 | 1 | 301µs | 2.13ms | connect | DBD::SQLite::dr::
1 | 1 | 1 | 248µs | 248µs | bootstrap (xsub) | DBD::SQLite::
1 | 1 | 1 | 69µs | 486µs | driver | DBD::SQLite::
18 | 3 | 1 | 52µs | 52µs | CORE:match (opcode) | DBD::SQLite::dr::
1 | 1 | 1 | 35µs | 35µs | BEGIN@3 | DBD::SQLite::
4 | 1 | 1 | 35µs | 64µs | get_info | DBD::SQLite::db::
4 | 1 | 1 | 21µs | 29µs | _get_version | DBD::SQLite::db::
1 | 1 | 1 | 14µs | 24µs | BEGIN@5 | DBD::SQLite::
1 | 1 | 1 | 12µs | 64µs | BEGIN@30 | DBD::SQLite::
1 | 1 | 1 | 10µs | 10µs | BEGIN@12 | DBD::SQLite::
1 | 1 | 1 | 10µs | 14µs | BEGIN@4 | DBD::SQLite::
1 | 1 | 1 | 10µs | 13µs | BEGIN@34 | DBD::SQLite::
1 | 1 | 1 | 9µs | 9µs | TIEHASH | DBD::SQLite::_WriteOnceHash::
1 | 1 | 1 | 8µs | 51µs | BEGIN@8 | DBD::SQLite::
4 | 1 | 1 | 8µs | 8µs | FETCH (xsub) | DBD::SQLite::db::
1 | 1 | 1 | 8µs | 10µs | BEGIN@178 | DBD::SQLite::dr::
1 | 1 | 1 | 6µs | 55µs | BEGIN@9 | DBD::SQLite::
1 | 1 | 1 | 6µs | 24µs | BEGIN@10 | DBD::SQLite::
2 | 2 | 1 | 5µs | 5µs | STORE | DBD::SQLite::_WriteOnceHash::
1 | 1 | 1 | 4µs | 4µs | BEGIN@6 | DBD::SQLite::
0 | 0 | 0 | 0s | 0s | CLONE | DBD::SQLite::
0 | 0 | 0 | 0s | 0s | DELETE | DBD::SQLite::_WriteOnceHash::
0 | 0 | 0 | 0s | 0s | __ANON__[:33] | DBD::SQLite::
0 | 0 | 0 | 0s | 0s | __ANON__[:34] | DBD::SQLite::
0 | 0 | 0 | 0s | 0s | _attached_database_list | DBD::SQLite::db::
0 | 0 | 0 | 0s | 0s | column_info | DBD::SQLite::db::
0 | 0 | 0 | 0s | 0s | primary_key_info | DBD::SQLite::db::
0 | 0 | 0 | 0s | 0s | table_info | DBD::SQLite::db::
0 | 0 | 0 | 0s | 0s | type_info_all | DBD::SQLite::db::
0 | 0 | 0 | 0s | 0s | install_collation | DBD::SQLite::dr::
0 | 0 | 0 | 0s | 0s | regexp | DBD::SQLite::dr::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package DBD::SQLite; | ||||
2 | |||||
3 | 3 | 46µs | 1 | 35µs | # spent 35µs within DBD::SQLite::BEGIN@3 which was called:
# once (35µs+0s) by DBI::install_driver at line 3 # spent 35µs making 1 call to DBD::SQLite::BEGIN@3 |
4 | 3 | 22µs | 2 | 18µs | # spent 14µs (10+4) within DBD::SQLite::BEGIN@4 which was called:
# once (10µs+4µs) by DBI::install_driver at line 4 # spent 14µs making 1 call to DBD::SQLite::BEGIN@4
# spent 4µs making 1 call to strict::import |
5 | 3 | 36µs | 2 | 33µs | # spent 24µs (14+9) within DBD::SQLite::BEGIN@5 which was called:
# once (14µs+9µs) by DBI::install_driver at line 5 # spent 24µs making 1 call to DBD::SQLite::BEGIN@5
# spent 9µs making 1 call to UNIVERSAL::VERSION |
6 | 3 | 20µs | 1 | 4µs | # spent 4µs within DBD::SQLite::BEGIN@6 which was called:
# once (4µs+0s) by DBI::install_driver at line 6 # spent 4µs making 1 call to DBD::SQLite::BEGIN@6 |
7 | |||||
8 | 3 | 23µs | 2 | 94µs | # spent 51µs (8+43) within DBD::SQLite::BEGIN@8 which was called:
# once (8µs+43µs) by DBI::install_driver at line 8 # spent 51µs making 1 call to DBD::SQLite::BEGIN@8
# spent 43µs making 1 call to vars::import |
9 | 3 | 18µs | 2 | 104µs | # spent 55µs (6+49) within DBD::SQLite::BEGIN@9 which was called:
# once (6µs+49µs) by DBI::install_driver at line 9 # spent 55µs making 1 call to DBD::SQLite::BEGIN@9
# spent 49µs making 1 call to vars::import |
10 | 3 | 47µs | 2 | 42µs | # spent 24µs (6+18) within DBD::SQLite::BEGIN@10 which was called:
# once (6µs+18µs) by DBI::install_driver at line 10 # spent 24µs making 1 call to DBD::SQLite::BEGIN@10
# spent 18µs making 1 call to vars::import |
11 | |||||
12 | # spent 10µs within DBD::SQLite::BEGIN@12 which was called:
# once (10µs+0s) by DBI::install_driver at line 25 | ||||
13 | 6 | 11µs | $VERSION = '1.35'; | ||
14 | @ISA = 'DynaLoader'; | ||||
15 | |||||
16 | # Initialize errors | ||||
17 | $err = undef; | ||||
18 | $errstr = undef; | ||||
19 | |||||
20 | # Driver singleton | ||||
21 | $drh = undef; | ||||
22 | |||||
23 | # sqlite_version cache | ||||
24 | $sqlite_version = undef; | ||||
25 | 1 | 32µs | 1 | 10µs | } # spent 10µs making 1 call to DBD::SQLite::BEGIN@12 |
26 | |||||
27 | 1 | 7µs | 1 | 566µs | __PACKAGE__->bootstrap($VERSION); # spent 566µs making 1 call to DynaLoader::bootstrap |
28 | |||||
29 | # New or old API? | ||||
30 | 3 | 58µs | 2 | 116µs | # spent 64µs (12+52) within DBD::SQLite::BEGIN@30 which was called:
# once (12µs+52µs) by DBI::install_driver at line 30 # spent 64µs making 1 call to DBD::SQLite::BEGIN@30
# spent 52µs making 1 call to constant::import |
31 | |||||
32 | 1 | 5µs | 1 | 9µs | tie %COLLATION, 'DBD::SQLite::_WriteOnceHash'; # spent 9µs making 1 call to DBD::SQLite::_WriteOnceHash::TIEHASH |
33 | 1 | 13µs | 1 | 3µs | $COLLATION{perl} = sub { $_[0] cmp $_[1] }; # spent 3µs making 1 call to DBD::SQLite::_WriteOnceHash::STORE |
34 | 4 | 558µs | 3 | 17µs | # spent 13µs (10+3) within DBD::SQLite::BEGIN@34 which was called:
# once (10µs+3µs) by DBI::install_driver at line 34 # spent 13µs making 1 call to DBD::SQLite::BEGIN@34
# spent 3µs making 1 call to locale::import
# spent 2µs making 1 call to DBD::SQLite::_WriteOnceHash::STORE |
35 | |||||
36 | 1 | 400ns | my $methods_are_installed = 0; | ||
37 | |||||
38 | # spent 486µs (69+417) within DBD::SQLite::driver which was called:
# once (69µs+417µs) by DBI::install_driver at line 808 of DBI.pm | ||||
39 | 21 | 45µs | return $drh if $drh; | ||
40 | |||||
41 | if (!$methods_are_installed && $DBI::VERSION >= 1.608) { | ||||
42 | 1 | 18µs | DBI->setup_driver('DBD::SQLite'); # spent 18µs making 1 call to DBI::setup_driver | ||
43 | |||||
44 | 1 | 52µs | DBD::SQLite::db->install_method('sqlite_last_insert_rowid'); # spent 52µs making 1 call to DBD::_::common::install_method | ||
45 | 1 | 22µs | DBD::SQLite::db->install_method('sqlite_busy_timeout'); # spent 22µs making 1 call to DBD::_::common::install_method | ||
46 | 1 | 20µs | DBD::SQLite::db->install_method('sqlite_create_function'); # spent 20µs making 1 call to DBD::_::common::install_method | ||
47 | 1 | 19µs | DBD::SQLite::db->install_method('sqlite_create_aggregate'); # spent 19µs making 1 call to DBD::_::common::install_method | ||
48 | 1 | 20µs | DBD::SQLite::db->install_method('sqlite_create_collation'); # spent 20µs making 1 call to DBD::_::common::install_method | ||
49 | 1 | 18µs | DBD::SQLite::db->install_method('sqlite_collation_needed'); # spent 18µs making 1 call to DBD::_::common::install_method | ||
50 | 1 | 23µs | DBD::SQLite::db->install_method('sqlite_progress_handler'); # spent 23µs making 1 call to DBD::_::common::install_method | ||
51 | 1 | 19µs | DBD::SQLite::db->install_method('sqlite_commit_hook'); # spent 19µs making 1 call to DBD::_::common::install_method | ||
52 | 1 | 19µs | DBD::SQLite::db->install_method('sqlite_rollback_hook'); # spent 19µs making 1 call to DBD::_::common::install_method | ||
53 | 1 | 22µs | DBD::SQLite::db->install_method('sqlite_update_hook'); # spent 22µs making 1 call to DBD::_::common::install_method | ||
54 | 1 | 19µs | DBD::SQLite::db->install_method('sqlite_set_authorizer'); # spent 19µs making 1 call to DBD::_::common::install_method | ||
55 | 1 | 21µs | DBD::SQLite::db->install_method('sqlite_backup_from_file'); # spent 21µs making 1 call to DBD::_::common::install_method | ||
56 | 1 | 21µs | DBD::SQLite::db->install_method('sqlite_backup_to_file'); # spent 21µs making 1 call to DBD::_::common::install_method | ||
57 | 1 | 18µs | DBD::SQLite::db->install_method('sqlite_enable_load_extension'); # spent 18µs making 1 call to DBD::_::common::install_method | ||
58 | 1 | 22µs | DBD::SQLite::db->install_method('sqlite_register_fts3_perl_tokenizer'); # spent 22µs making 1 call to DBD::_::common::install_method | ||
59 | |||||
60 | $methods_are_installed++; | ||||
61 | } | ||||
62 | |||||
63 | 1 | 63µs | $drh = DBI::_new_drh( "$_[0]::dr", { # spent 63µs making 1 call to DBI::_new_drh | ||
64 | Name => 'SQLite', | ||||
65 | Version => $VERSION, | ||||
66 | Attribution => 'DBD::SQLite by Matt Sergeant et al', | ||||
67 | } ); | ||||
68 | |||||
69 | return $drh; | ||||
70 | } | ||||
71 | |||||
72 | sub CLONE { | ||||
73 | undef $drh; | ||||
74 | } | ||||
75 | |||||
76 | |||||
77 | package DBD::SQLite::dr; | ||||
78 | |||||
79 | # spent 2.13ms (301µs+1.83) within DBD::SQLite::dr::connect which was called 6 times, avg 355µs/call:
# 6 times (301µs+1.83ms) by DBI::dr::connect at line 658 of DBI.pm, avg 355µs/call | ||||
80 | 84 | 1.84ms | my ($drh, $dbname, $user, $auth, $attr) = @_; | ||
81 | |||||
82 | # Default PrintWarn to the value of $^W | ||||
83 | # unless ( defined $attr->{PrintWarn} ) { | ||||
84 | # $attr->{PrintWarn} = $^W ? 1 : 0; | ||||
85 | # } | ||||
86 | |||||
87 | 6 | 292µs | my $dbh = DBI::_new_dbh( $drh, { # spent 292µs making 6 calls to DBI::_new_dbh, avg 49µs/call | ||
88 | Name => $dbname, | ||||
89 | } ); | ||||
90 | |||||
91 | my $real = $dbname; | ||||
92 | 6 | 12µs | if ( $dbname =~ /=/ ) { # spent 12µs making 6 calls to DBD::SQLite::dr::CORE:match, avg 2µs/call | ||
93 | foreach my $attrib ( split(/;/, $dbname) ) { | ||||
94 | my ($key, $value) = split(/=/, $attrib, 2); | ||||
95 | 6 | 30µs | if ( $key =~ /^(?:db(?:name)?|database)$/ ) { # spent 30µs making 6 calls to DBD::SQLite::dr::CORE:match, avg 5µs/call | ||
96 | $real = $value; | ||||
97 | } else { | ||||
98 | $attr->{$key} = $value; | ||||
99 | } | ||||
100 | } | ||||
101 | } | ||||
102 | |||||
103 | # To avoid unicode and long file name problems on Windows, | ||||
104 | # convert to the shortname if the file (or parent directory) exists. | ||||
105 | 6 | 10µs | if ( $^O =~ /MSWin32/ and $real ne ':memory:' and $real ne '') { # spent 10µs making 6 calls to DBD::SQLite::dr::CORE:match, avg 2µs/call | ||
106 | require Win32; | ||||
107 | require File::Basename; | ||||
108 | my ($file, $dir, $suffix) = File::Basename::fileparse($real); | ||||
109 | my $short = Win32::GetShortPathName($real); | ||||
110 | if ( $short && -f $short ) { | ||||
111 | # Existing files will work directly. | ||||
112 | $real = $short; | ||||
113 | } elsif ( -d $dir ) { | ||||
114 | # We are creating a new file. | ||||
115 | # Does the directory it's in at least exist? | ||||
116 | $real = join '', grep { defined } Win32::GetShortPathName($dir), $file, $suffix; | ||||
117 | } else { | ||||
118 | # SQLite can't do mkpath anyway. | ||||
119 | # So let it go through as it and fail. | ||||
120 | } | ||||
121 | } | ||||
122 | |||||
123 | # Hand off to the actual login function | ||||
124 | 6 | 1.15ms | DBD::SQLite::db::_login($dbh, $real, $user, $auth, $attr) or return undef; # spent 1.15ms making 6 calls to DBD::SQLite::db::_login, avg 191µs/call | ||
125 | |||||
126 | # Register the on-demand collation installer, REGEXP function and | ||||
127 | # perl tokenizer | ||||
128 | if ( DBD::SQLite::NEWAPI ) { | ||||
129 | 6 | 29µs | $dbh->sqlite_collation_needed( \&install_collation ); # spent 29µs making 6 calls to DBI::db::sqlite_collation_needed, avg 5µs/call | ||
130 | 6 | 28µs | $dbh->sqlite_create_function( "REGEXP", 2, \®exp ); # spent 28µs making 6 calls to DBI::db::sqlite_create_function, avg 5µs/call | ||
131 | 6 | 280µs | $dbh->sqlite_register_fts3_perl_tokenizer(); # spent 280µs making 6 calls to DBI::db::sqlite_register_fts3_perl_tokenizer, avg 47µs/call | ||
132 | } else { | ||||
133 | $dbh->func( \&install_collation, "collation_needed" ); | ||||
134 | $dbh->func( "REGEXP", 2, \®exp, "create_function" ); | ||||
135 | $dbh->func( "register_fts3_perl_tokenizer" ); | ||||
136 | } | ||||
137 | |||||
138 | # HACK: Since PrintWarn = 0 doesn't seem to actually prevent warnings | ||||
139 | # in DBD::SQLite we set Warn to false if PrintWarn is false. | ||||
140 | |||||
141 | # NOTE: According to the explanation by timbunce, | ||||
142 | # "Warn is meant to report on bad practices or problems with | ||||
143 | # the DBI itself (hence always on by default), while PrintWarn | ||||
144 | # is meant to report warnings coming from the database." | ||||
145 | # That is, if you want to disable an ineffective rollback warning | ||||
146 | # etc (due to bad practices), you should turn off Warn, | ||||
147 | # and to silence other warnings, turn off PrintWarn. | ||||
148 | # Warn and PrintWarn are independent, and turning off PrintWarn | ||||
149 | # does not silence those warnings that should be controlled by | ||||
150 | # Warn. | ||||
151 | |||||
152 | # unless ( $attr->{PrintWarn} ) { | ||||
153 | # $attr->{Warn} = 0; | ||||
154 | # } | ||||
155 | |||||
156 | return $dbh; | ||||
157 | } | ||||
158 | |||||
159 | sub install_collation { | ||||
160 | my $dbh = shift; | ||||
161 | my $name = shift; | ||||
162 | my $collation = $DBD::SQLite::COLLATION{$name}; | ||||
163 | unless ($collation) { | ||||
164 | warn "Can't install unknown collation: $name" if $dbh->{PrintWarn}; | ||||
165 | return; | ||||
166 | } | ||||
167 | if ( DBD::SQLite::NEWAPI ) { | ||||
168 | $dbh->sqlite_create_collation( $name => $collation ); | ||||
169 | } else { | ||||
170 | $dbh->func( $name => $collation, "create_collation" ); | ||||
171 | } | ||||
172 | } | ||||
173 | |||||
174 | # default implementation for sqlite 'REGEXP' infix operator. | ||||
175 | # Note : args are reversed, i.e. "a REGEXP b" calls REGEXP(b, a) | ||||
176 | # (see http://www.sqlite.org/vtab.html#xfindfunction) | ||||
177 | sub regexp { | ||||
178 | 3 | 1.44ms | 2 | 11µs | # spent 10µs (8+2) within DBD::SQLite::dr::BEGIN@178 which was called:
# once (8µs+2µs) by DBI::install_driver at line 178 # spent 10µs making 1 call to DBD::SQLite::dr::BEGIN@178
# spent 2µs making 1 call to locale::import |
179 | return if !defined $_[0] || !defined $_[1]; | ||||
180 | return scalar($_[1] =~ $_[0]); | ||||
181 | } | ||||
182 | |||||
183 | package DBD::SQLite::db; | ||||
184 | |||||
185 | # spent 37.2ms (3.70+33.5) within DBD::SQLite::db::prepare which was called 145 times, avg 257µs/call:
# 74 times (1.54ms+14.5ms) by DBI::db::prepare at line 1706 of DBI.pm, avg 217µs/call
# 71 times (2.16ms+19.0ms) by DBI::db::prepare at line 206, avg 298µs/call | ||||
186 | 868 | 26.6ms | my $dbh = shift; | ||
187 | my $sql = shift; | ||||
188 | $sql = '' unless defined $sql; | ||||
189 | |||||
190 | 145 | 10.8ms | my $sth = DBI::_new_sth( $dbh, { # spent 10.8ms making 145 calls to DBI::_new_sth, avg 74µs/call | ||
191 | Statement => $sql, | ||||
192 | } ); | ||||
193 | |||||
194 | 145 | 22.7ms | DBD::SQLite::st::_prepare($sth, $sql, @_) or return undef; # spent 22.7ms making 145 calls to DBD::SQLite::st::_prepare, avg 157µs/call | ||
195 | |||||
196 | return $sth; | ||||
197 | } | ||||
198 | |||||
199 | # spent 7.93s (11.0ms+7.91) within DBD::SQLite::db::do which was called 71 times, avg 112ms/call:
# 71 times (11.0ms+7.91s) by DBI::db::do at line 2762 of DBIx/Class/Storage/DBI.pm, avg 112ms/call | ||||
200 | 639 | 7.90s | my ($dbh, $statement, $attr, @bind_values) = @_; | ||
201 | |||||
202 | my @copy = @{[@bind_values]}; | ||||
203 | my $rows = 0; | ||||
204 | |||||
205 | 213 | 1.34ms | while ($statement) { # spent 1.02ms making 142 calls to DBI::common::DESTROY, avg 7µs/call
# spent 316µs making 71 calls to DBD::_mem::common::DESTROY, avg 4µs/call | ||
206 | 1 | 642µs | 142 | 43.2ms | my $sth = $dbh->prepare($statement, $attr) or return undef; # spent 22.0ms making 71 calls to DBI::db::prepare, avg 310µs/call
# spent 21.2ms making 71 calls to DBD::SQLite::db::prepare, avg 298µs/call |
207 | 142 | 7.89s | $sth->execute(splice @copy, 0, $sth->{NUM_OF_PARAMS}) or return undef; # spent 7.89s making 71 calls to DBI::st::execute, avg 111ms/call
# spent 441µs making 71 calls to DBI::common::FETCH, avg 6µs/call | ||
208 | 71 | 870µs | $rows += $sth->rows; # spent 870µs making 71 calls to DBI::st::rows, avg 12µs/call | ||
209 | # XXX: not sure why but $dbh->{sqlite...} wouldn't work here | ||||
210 | 71 | 860µs | last unless $dbh->FETCH('sqlite_allow_multiple_statements'); # spent 860µs making 71 calls to DBI::common::FETCH, avg 12µs/call | ||
211 | $statement = $sth->{sqlite_unprepared_statements}; | ||||
212 | } | ||||
213 | |||||
214 | # always return true if no error | ||||
215 | return ($rows == 0) ? "0E0" : $rows; | ||||
216 | } | ||||
217 | |||||
218 | # spent 29µs (21+8) within DBD::SQLite::db::_get_version which was called 4 times, avg 7µs/call:
# 4 times (21µs+8µs) by DBD::SQLite::db::get_info at line 231, avg 7µs/call | ||||
219 | 4 | 32µs | 4 | 8µs | return ( DBD::SQLite::db::FETCH($_[0], 'sqlite_version') ); # spent 8µs making 4 calls to DBD::SQLite::db::FETCH, avg 2µs/call |
220 | } | ||||
221 | |||||
222 | 1 | 5µs | my %info = ( | ||
223 | 17 => 'SQLite', # SQL_DBMS_NAME | ||||
224 | 18 => \&_get_version, # SQL_DBMS_VER | ||||
225 | 29 => '"', # SQL_IDENTIFIER_QUOTE_CHAR | ||||
226 | ); | ||||
227 | |||||
228 | # spent 64µs (35+29) within DBD::SQLite::db::get_info which was called 4 times, avg 16µs/call:
# 4 times (35µs+29µs) by DBI::db::get_info at line 1116 of DBIx/Class/Storage/DBI.pm, avg 16µs/call | ||||
229 | 16 | 38µs | my($dbh, $info_type) = @_; | ||
230 | my $v = $info{int($info_type)}; | ||||
231 | 4 | 29µs | $v = $v->($dbh) if ref $v eq 'CODE'; # spent 29µs making 4 calls to DBD::SQLite::db::_get_version, avg 7µs/call | ||
232 | return $v; | ||||
233 | } | ||||
234 | |||||
235 | sub _attached_database_list { | ||||
236 | my $dbh = shift; | ||||
237 | my @attached; | ||||
238 | |||||
239 | my $sth_databases = $dbh->prepare( 'PRAGMA database_list' ); | ||||
240 | $sth_databases->execute; | ||||
241 | while ( my $db_info = $sth_databases->fetchrow_hashref ) { | ||||
242 | push @attached, $db_info->{name} if $db_info->{seq} >= 2; | ||||
243 | } | ||||
244 | return @attached; | ||||
245 | } | ||||
246 | |||||
247 | # SQL/CLI (ISO/IEC JTC 1/SC 32 N 0595), 6.63 Tables | ||||
248 | # Based on DBD::Oracle's | ||||
249 | # See also http://www.ch-werner.de/sqliteodbc/html/sqlite3odbc_8c.html#a213 | ||||
250 | sub table_info { | ||||
251 | my ($dbh, $cat_val, $sch_val, $tbl_val, $typ_val, $attr) = @_; | ||||
252 | |||||
253 | my @where = (); | ||||
254 | my $sql; | ||||
255 | if ( defined($cat_val) && $cat_val eq '%' | ||||
256 | && defined($sch_val) && $sch_val eq '' | ||||
257 | && defined($tbl_val) && $tbl_val eq '') { # Rule 19a | ||||
258 | $sql = <<'END_SQL'; | ||||
259 | SELECT NULL TABLE_CAT | ||||
260 | , NULL TABLE_SCHEM | ||||
261 | , NULL TABLE_NAME | ||||
262 | , NULL TABLE_TYPE | ||||
263 | , NULL REMARKS | ||||
264 | END_SQL | ||||
265 | } | ||||
266 | elsif ( defined($cat_val) && $cat_val eq '' | ||||
267 | && defined($sch_val) && $sch_val eq '%' | ||||
268 | && defined($tbl_val) && $tbl_val eq '') { # Rule 19b | ||||
269 | $sql = <<'END_SQL'; | ||||
270 | SELECT NULL TABLE_CAT | ||||
271 | , t.tn TABLE_SCHEM | ||||
272 | , NULL TABLE_NAME | ||||
273 | , NULL TABLE_TYPE | ||||
274 | , NULL REMARKS | ||||
275 | FROM ( | ||||
276 | SELECT 'main' tn | ||||
277 | UNION SELECT 'temp' tn | ||||
278 | END_SQL | ||||
279 | for my $db_name (_attached_database_list($dbh)) { | ||||
280 | $sql .= " UNION SELECT '$db_name' tn\n"; | ||||
281 | } | ||||
282 | $sql .= ") t\n"; | ||||
283 | } | ||||
284 | elsif ( defined($cat_val) && $cat_val eq '' | ||||
285 | && defined($sch_val) && $sch_val eq '' | ||||
286 | && defined($tbl_val) && $tbl_val eq '' | ||||
287 | && defined($typ_val) && $typ_val eq '%') { # Rule 19c | ||||
288 | $sql = <<'END_SQL'; | ||||
289 | SELECT NULL TABLE_CAT | ||||
290 | , NULL TABLE_SCHEM | ||||
291 | , NULL TABLE_NAME | ||||
292 | , t.tt TABLE_TYPE | ||||
293 | , NULL REMARKS | ||||
294 | FROM ( | ||||
295 | SELECT 'TABLE' tt UNION | ||||
296 | SELECT 'VIEW' tt UNION | ||||
297 | SELECT 'LOCAL TEMPORARY' tt | ||||
298 | ) t | ||||
299 | ORDER BY TABLE_TYPE | ||||
300 | END_SQL | ||||
301 | } | ||||
302 | else { | ||||
303 | $sql = <<'END_SQL'; | ||||
304 | SELECT * | ||||
305 | FROM | ||||
306 | ( | ||||
307 | SELECT NULL TABLE_CAT | ||||
308 | , TABLE_SCHEM | ||||
309 | , tbl_name TABLE_NAME | ||||
310 | , TABLE_TYPE | ||||
311 | , NULL REMARKS | ||||
312 | , sql sqlite_sql | ||||
313 | FROM ( | ||||
314 | SELECT 'main' TABLE_SCHEM, tbl_name, upper(type) TABLE_TYPE, sql | ||||
315 | FROM sqlite_master | ||||
316 | UNION ALL | ||||
317 | SELECT 'temp' TABLE_SCHEM, tbl_name, 'LOCAL TEMPORARY' TABLE_TYPE, sql | ||||
318 | FROM sqlite_temp_master | ||||
319 | END_SQL | ||||
320 | |||||
321 | for my $db_name (_attached_database_list($dbh)) { | ||||
322 | $sql .= <<"END_SQL"; | ||||
323 | UNION ALL | ||||
324 | SELECT '$db_name' TABLE_SCHEM, tbl_name, upper(type) TABLE_TYPE, sql | ||||
325 | FROM "$db_name".sqlite_master | ||||
326 | END_SQL | ||||
327 | } | ||||
328 | |||||
329 | $sql .= <<'END_SQL'; | ||||
330 | UNION ALL | ||||
331 | SELECT 'main' TABLE_SCHEM, 'sqlite_master' tbl_name, 'SYSTEM TABLE' TABLE_TYPE, NULL sql | ||||
332 | UNION ALL | ||||
333 | SELECT 'temp' TABLE_SCHEM, 'sqlite_temp_master' tbl_name, 'SYSTEM TABLE' TABLE_TYPE, NULL sql | ||||
334 | ) | ||||
335 | ) | ||||
336 | END_SQL | ||||
337 | $attr = {} unless ref $attr eq 'HASH'; | ||||
338 | my $escape = defined $attr->{Escape} ? " ESCAPE '$attr->{Escape}'" : ''; | ||||
339 | if ( defined $sch_val ) { | ||||
340 | push @where, "TABLE_SCHEM LIKE '$sch_val'$escape"; | ||||
341 | } | ||||
342 | if ( defined $tbl_val ) { | ||||
343 | push @where, "TABLE_NAME LIKE '$tbl_val'$escape"; | ||||
344 | } | ||||
345 | if ( defined $typ_val ) { | ||||
346 | my $table_type_list; | ||||
347 | $typ_val =~ s/^\s+//; | ||||
348 | $typ_val =~ s/\s+$//; | ||||
349 | my @ttype_list = split (/\s*,\s*/, $typ_val); | ||||
350 | foreach my $table_type (@ttype_list) { | ||||
351 | if ($table_type !~ /^'.*'$/) { | ||||
352 | $table_type = "'" . $table_type . "'"; | ||||
353 | } | ||||
354 | } | ||||
355 | $table_type_list = join(', ', @ttype_list); | ||||
356 | push @where, "TABLE_TYPE IN (\U$table_type_list)" if $table_type_list; | ||||
357 | } | ||||
358 | $sql .= ' WHERE ' . join("\n AND ", @where ) . "\n" if @where; | ||||
359 | $sql .= " ORDER BY TABLE_TYPE, TABLE_SCHEM, TABLE_NAME\n"; | ||||
360 | } | ||||
361 | my $sth = $dbh->prepare($sql) or return undef; | ||||
362 | $sth->execute or return undef; | ||||
363 | $sth; | ||||
364 | } | ||||
365 | |||||
366 | sub primary_key_info { | ||||
367 | my ($dbh, $catalog, $schema, $table, $attr) = @_; | ||||
368 | |||||
369 | # Escape the schema and table name | ||||
370 | $schema =~ s/([\\_%])/\\$1/g if defined $schema; | ||||
371 | my $escaped = $table; | ||||
372 | $escaped =~ s/([\\_%])/\\$1/g; | ||||
373 | $attr ||= {}; | ||||
374 | $attr->{Escape} = '\\'; | ||||
375 | my $sth_tables = $dbh->table_info($catalog, $schema, $escaped, undef, $attr); | ||||
376 | |||||
377 | # This is a hack but much simpler than using pragma index_list etc | ||||
378 | # also the pragma doesn't list 'INTEGER PRIMARY KEY' autoinc PKs! | ||||
379 | my @pk_info; | ||||
380 | while ( my $row = $sth_tables->fetchrow_hashref ) { | ||||
381 | my $sql = $row->{sqlite_sql} or next; | ||||
382 | next unless $sql =~ /(.*?)\s*PRIMARY\s+KEY\s*(?:\(\s*(.*?)\s*\))?/si; | ||||
383 | my @pk = split /\s*,\s*/, $2 || ''; | ||||
384 | unless ( @pk ) { | ||||
385 | my $prefix = $1; | ||||
386 | $prefix =~ s/.*create\s+table\s+.*?\(\s*//si; | ||||
387 | $prefix = (split /\s*,\s*/, $prefix)[-1]; | ||||
388 | @pk = (split /\s+/, $prefix)[0]; # take first word as name | ||||
389 | } | ||||
390 | my $key_seq = 0; | ||||
391 | foreach my $pk_field (@pk) { | ||||
392 | $pk_field =~ s/(["'`])(.+)\1/$2/; # dequote | ||||
393 | $pk_field =~ s/\[(.+)\]/$1/; # dequote | ||||
394 | push @pk_info, { | ||||
395 | TABLE_SCHEM => $row->{TABLE_SCHEM}, | ||||
396 | TABLE_NAME => $row->{TABLE_NAME}, | ||||
397 | COLUMN_NAME => $pk_field, | ||||
398 | KEY_SEQ => ++$key_seq, | ||||
399 | PK_NAME => 'PRIMARY KEY', | ||||
400 | }; | ||||
401 | } | ||||
402 | } | ||||
403 | |||||
404 | my $sponge = DBI->connect("DBI:Sponge:", '','') | ||||
405 | or return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr"); | ||||
406 | my @names = qw(TABLE_CAT TABLE_SCHEM TABLE_NAME COLUMN_NAME KEY_SEQ PK_NAME); | ||||
407 | my $sth = $sponge->prepare( "primary_key_info $table", { | ||||
408 | rows => [ map { [ @{$_}{@names} ] } @pk_info ], | ||||
409 | NUM_OF_FIELDS => scalar @names, | ||||
410 | NAME => \@names, | ||||
411 | }) or return $dbh->DBI::set_err( | ||||
412 | $sponge->err, | ||||
413 | $sponge->errstr, | ||||
414 | ); | ||||
415 | return $sth; | ||||
416 | } | ||||
417 | |||||
418 | sub type_info_all { | ||||
419 | return; # XXX code just copied from DBD::Oracle, not yet thought about | ||||
420 | # return [ | ||||
421 | # { | ||||
422 | # TYPE_NAME => 0, | ||||
423 | # DATA_TYPE => 1, | ||||
424 | # COLUMN_SIZE => 2, | ||||
425 | # LITERAL_PREFIX => 3, | ||||
426 | # LITERAL_SUFFIX => 4, | ||||
427 | # CREATE_PARAMS => 5, | ||||
428 | # NULLABLE => 6, | ||||
429 | # CASE_SENSITIVE => 7, | ||||
430 | # SEARCHABLE => 8, | ||||
431 | # UNSIGNED_ATTRIBUTE => 9, | ||||
432 | # FIXED_PREC_SCALE => 10, | ||||
433 | # AUTO_UNIQUE_VALUE => 11, | ||||
434 | # LOCAL_TYPE_NAME => 12, | ||||
435 | # MINIMUM_SCALE => 13, | ||||
436 | # MAXIMUM_SCALE => 14, | ||||
437 | # SQL_DATA_TYPE => 15, | ||||
438 | # SQL_DATETIME_SUB => 16, | ||||
439 | # NUM_PREC_RADIX => 17, | ||||
440 | # }, | ||||
441 | # [ 'CHAR', 1, 255, '\'', '\'', 'max length', 1, 1, 3, | ||||
442 | # undef, '0', '0', undef, undef, undef, 1, undef, undef | ||||
443 | # ], | ||||
444 | # [ 'NUMBER', 3, 38, undef, undef, 'precision,scale', 1, '0', 3, | ||||
445 | # '0', '0', '0', undef, '0', 38, 3, undef, 10 | ||||
446 | # ], | ||||
447 | # [ 'DOUBLE', 8, 15, undef, undef, undef, 1, '0', 3, | ||||
448 | # '0', '0', '0', undef, undef, undef, 8, undef, 10 | ||||
449 | # ], | ||||
450 | # [ 'DATE', 9, 19, '\'', '\'', undef, 1, '0', 3, | ||||
451 | # undef, '0', '0', undef, '0', '0', 11, undef, undef | ||||
452 | # ], | ||||
453 | # [ 'VARCHAR', 12, 1024*1024, '\'', '\'', 'max length', 1, 1, 3, | ||||
454 | # undef, '0', '0', undef, undef, undef, 12, undef, undef | ||||
455 | # ] | ||||
456 | # ]; | ||||
457 | } | ||||
458 | |||||
459 | 1 | 3µs | my @COLUMN_INFO = qw( | ||
460 | TABLE_CAT | ||||
461 | TABLE_SCHEM | ||||
462 | TABLE_NAME | ||||
463 | COLUMN_NAME | ||||
464 | DATA_TYPE | ||||
465 | TYPE_NAME | ||||
466 | COLUMN_SIZE | ||||
467 | BUFFER_LENGTH | ||||
468 | DECIMAL_DIGITS | ||||
469 | NUM_PREC_RADIX | ||||
470 | NULLABLE | ||||
471 | REMARKS | ||||
472 | COLUMN_DEF | ||||
473 | SQL_DATA_TYPE | ||||
474 | SQL_DATETIME_SUB | ||||
475 | CHAR_OCTET_LENGTH | ||||
476 | ORDINAL_POSITION | ||||
477 | IS_NULLABLE | ||||
478 | ); | ||||
479 | |||||
480 | sub column_info { | ||||
481 | my ($dbh, $cat_val, $sch_val, $tbl_val, $col_val) = @_; | ||||
482 | |||||
483 | if ( defined $col_val and $col_val eq '%' ) { | ||||
484 | $col_val = undef; | ||||
485 | } | ||||
486 | |||||
487 | # Get a list of all tables ordered by TABLE_SCHEM, TABLE_NAME | ||||
488 | my $sql = <<'END_SQL'; | ||||
489 | SELECT TABLE_SCHEM, tbl_name TABLE_NAME | ||||
490 | FROM ( | ||||
491 | SELECT 'main' TABLE_SCHEM, tbl_name | ||||
492 | FROM sqlite_master | ||||
493 | WHERE type IN ('table','view') | ||||
494 | UNION ALL | ||||
495 | SELECT 'temp' TABLE_SCHEM, tbl_name | ||||
496 | FROM sqlite_temp_master | ||||
497 | WHERE type IN ('table','view') | ||||
498 | END_SQL | ||||
499 | |||||
500 | for my $db_name (_attached_database_list($dbh)) { | ||||
501 | $sql .= <<"END_SQL"; | ||||
502 | UNION ALL | ||||
503 | SELECT '$db_name' TABLE_SCHEM, tbl_name | ||||
504 | FROM "$db_name".sqlite_master | ||||
505 | WHERE type IN ('table','view') | ||||
506 | END_SQL | ||||
507 | } | ||||
508 | |||||
509 | $sql .= <<'END_SQL'; | ||||
510 | UNION ALL | ||||
511 | SELECT 'main' TABLE_SCHEM, 'sqlite_master' tbl_name | ||||
512 | UNION ALL | ||||
513 | SELECT 'temp' TABLE_SCHEM, 'sqlite_temp_master' tbl_name | ||||
514 | ) | ||||
515 | END_SQL | ||||
516 | |||||
517 | my @where; | ||||
518 | if ( defined $sch_val ) { | ||||
519 | push @where, "TABLE_SCHEM LIKE '$sch_val'"; | ||||
520 | } | ||||
521 | if ( defined $tbl_val ) { | ||||
522 | push @where, "TABLE_NAME LIKE '$tbl_val'"; | ||||
523 | } | ||||
524 | $sql .= ' WHERE ' . join("\n AND ", @where ) . "\n" if @where; | ||||
525 | $sql .= " ORDER BY TABLE_SCHEM, TABLE_NAME\n"; | ||||
526 | my $sth_tables = $dbh->prepare($sql) or return undef; | ||||
527 | $sth_tables->execute or return undef; | ||||
528 | |||||
529 | # Taken from Fey::Loader::SQLite | ||||
530 | my @cols; | ||||
531 | while ( my ($schema, $table) = $sth_tables->fetchrow_array ) { | ||||
532 | my $sth_columns = $dbh->prepare(qq{PRAGMA "$schema".table_info("$table")}); | ||||
533 | $sth_columns->execute; | ||||
534 | |||||
535 | for ( my $position = 1; my $col_info = $sth_columns->fetchrow_hashref; $position++ ) { | ||||
536 | if ( defined $col_val ) { | ||||
537 | # This must do a LIKE comparison | ||||
538 | my $sth = $dbh->prepare("SELECT '$col_info->{name}' LIKE '$col_val'") or return undef; | ||||
539 | $sth->execute or return undef; | ||||
540 | # Skip columns that don't match $col_val | ||||
541 | next unless ($sth->fetchrow_array)[0]; | ||||
542 | } | ||||
543 | |||||
544 | my %col = ( | ||||
545 | TABLE_SCHEM => $schema, | ||||
546 | TABLE_NAME => $table, | ||||
547 | COLUMN_NAME => $col_info->{name}, | ||||
548 | ORDINAL_POSITION => $position, | ||||
549 | ); | ||||
550 | |||||
551 | my $type = $col_info->{type}; | ||||
552 | if ( $type =~ s/(\w+) ?\((\d+)(?:,(\d+))?\)/$1/ ) { | ||||
553 | $col{COLUMN_SIZE} = $2; | ||||
554 | $col{DECIMAL_DIGITS} = $3; | ||||
555 | } | ||||
556 | |||||
557 | $col{TYPE_NAME} = $type; | ||||
558 | |||||
559 | if ( defined $col_info->{dflt_value} ) { | ||||
560 | $col{COLUMN_DEF} = $col_info->{dflt_value} | ||||
561 | } | ||||
562 | |||||
563 | if ( $col_info->{notnull} ) { | ||||
564 | $col{NULLABLE} = 0; | ||||
565 | $col{IS_NULLABLE} = 'NO'; | ||||
566 | } else { | ||||
567 | $col{NULLABLE} = 1; | ||||
568 | $col{IS_NULLABLE} = 'YES'; | ||||
569 | } | ||||
570 | |||||
571 | push @cols, \%col; | ||||
572 | } | ||||
573 | $sth_columns->finish; | ||||
574 | } | ||||
575 | $sth_tables->finish; | ||||
576 | |||||
577 | my $sponge = DBI->connect("DBI:Sponge:", '','') | ||||
578 | or return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr"); | ||||
579 | $sponge->prepare( "column_info", { | ||||
580 | rows => [ map { [ @{$_}{@COLUMN_INFO} ] } @cols ], | ||||
581 | NUM_OF_FIELDS => scalar @COLUMN_INFO, | ||||
582 | NAME => [ @COLUMN_INFO ], | ||||
583 | } ) or return $dbh->DBI::set_err( | ||||
584 | $sponge->err, | ||||
585 | $sponge->errstr, | ||||
586 | ); | ||||
587 | } | ||||
588 | |||||
589 | #====================================================================== | ||||
590 | # An internal tied hash package used for %DBD::SQLite::COLLATION, to | ||||
591 | # prevent people from unintentionally overriding globally registered collations. | ||||
592 | |||||
593 | package DBD::SQLite::_WriteOnceHash; | ||||
594 | |||||
595 | 1 | 1µs | require Tie::Hash; | ||
596 | |||||
597 | 1 | 14µs | our @ISA = qw(Tie::StdHash); | ||
598 | |||||
599 | # spent 9µs within DBD::SQLite::_WriteOnceHash::TIEHASH which was called:
# once (9µs+0s) by DBI::install_driver at line 32 | ||||
600 | 1 | 12µs | bless {}, $_[0]; | ||
601 | } | ||||
602 | |||||
603 | sub STORE { | ||||
604 | 4 | 9µs | ! exists $_[0]->{$_[1]} or die "entry $_[1] already registered"; | ||
605 | $_[0]->{$_[1]} = $_[2]; | ||||
606 | } | ||||
607 | |||||
608 | sub DELETE { | ||||
609 | die "deletion of entry $_[1] is forbidden"; | ||||
610 | } | ||||
611 | |||||
612 | 1 | 12µs | 1; | ||
613 | |||||
614 | __END__ | ||||
# spent 248µs within DBD::SQLite::bootstrap which was called:
# once (248µs+0s) by DynaLoader::bootstrap at line 223 of DynaLoader.pm | |||||
# spent 8µs within DBD::SQLite::db::FETCH which was called 4 times, avg 2µs/call:
# 4 times (8µs+0s) by DBD::SQLite::db::_get_version at line 219, avg 2µs/call | |||||
# spent 1.15ms within DBD::SQLite::db::_login which was called 6 times, avg 191µs/call:
# 6 times (1.15ms+0s) by DBD::SQLite::dr::connect at line 124, avg 191µs/call | |||||
# spent 52µs within DBD::SQLite::dr::CORE:match which was called 18 times, avg 3µs/call:
# 6 times (30µs+0s) by DBD::SQLite::dr::connect at line 95, avg 5µs/call
# 6 times (12µs+0s) by DBD::SQLite::dr::connect at line 92, avg 2µs/call
# 6 times (10µs+0s) by DBD::SQLite::dr::connect at line 105, avg 2µs/call |