Profile of DBD/SQLite.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For xt/tapper-mcp-scheduler-with-db-longrun.t
Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:22:37 2012

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

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
71 | 1 | 1 | 11.0ms | 7.93s | DBD::SQLite::db::::do DBD::SQLite::db::do
145 | 2 | 2 | 3.70ms | 37.2ms | DBD::SQLite::db::::prepare DBD::SQLite::db::prepare
6 | 1 | 1 | 1.15ms | 1.15ms | DBD::SQLite::db::::_login DBD::SQLite::db::_login (xsub)
6 | 1 | 1 | 301µs | 2.13ms | DBD::SQLite::dr::::connect DBD::SQLite::dr::connect
1 | 1 | 1 | 248µs | 248µs | DBD::SQLite::::bootstrap DBD::SQLite::bootstrap (xsub)
1 | 1 | 1 | 69µs | 486µs | DBD::SQLite::::driver DBD::SQLite::driver
18 | 3 | 1 | 52µs | 52µs | DBD::SQLite::dr::::CORE:match DBD::SQLite::dr::CORE:match (opcode)
1 | 1 | 1 | 35µs | 35µs | DBD::SQLite::::BEGIN@3 DBD::SQLite::BEGIN@3
4 | 1 | 1 | 35µs | 64µs | DBD::SQLite::db::::get_info DBD::SQLite::db::get_info
4 | 1 | 1 | 21µs | 29µs | DBD::SQLite::db::::_get_version DBD::SQLite::db::_get_version
1 | 1 | 1 | 14µs | 24µs | DBD::SQLite::::BEGIN@5 DBD::SQLite::BEGIN@5
1 | 1 | 1 | 12µs | 64µs | DBD::SQLite::::BEGIN@30 DBD::SQLite::BEGIN@30
1 | 1 | 1 | 10µs | 10µs | DBD::SQLite::::BEGIN@12 DBD::SQLite::BEGIN@12
1 | 1 | 1 | 10µs | 14µs | DBD::SQLite::::BEGIN@4 DBD::SQLite::BEGIN@4
1 | 1 | 1 | 10µs | 13µs | DBD::SQLite::::BEGIN@34 DBD::SQLite::BEGIN@34
1 | 1 | 1 | 9µs | 9µs | DBD::SQLite::_WriteOnceHash::::TIEHASHDBD::SQLite::_WriteOnceHash::TIEHASH
1 | 1 | 1 | 8µs | 51µs | DBD::SQLite::::BEGIN@8 DBD::SQLite::BEGIN@8
4 | 1 | 1 | 8µs | 8µs | DBD::SQLite::db::::FETCH DBD::SQLite::db::FETCH (xsub)
1 | 1 | 1 | 8µs | 10µs | DBD::SQLite::dr::::BEGIN@178 DBD::SQLite::dr::BEGIN@178
1 | 1 | 1 | 6µs | 55µs | DBD::SQLite::::BEGIN@9 DBD::SQLite::BEGIN@9
1 | 1 | 1 | 6µs | 24µs | DBD::SQLite::::BEGIN@10 DBD::SQLite::BEGIN@10
2 | 2 | 1 | 5µs | 5µs | DBD::SQLite::_WriteOnceHash::::STOREDBD::SQLite::_WriteOnceHash::STORE
1 | 1 | 1 | 4µs | 4µs | DBD::SQLite::::BEGIN@6 DBD::SQLite::BEGIN@6
0 | 0 | 0 | 0s | 0s | DBD::SQLite::::CLONE DBD::SQLite::CLONE
0 | 0 | 0 | 0s | 0s | DBD::SQLite::_WriteOnceHash::::DELETEDBD::SQLite::_WriteOnceHash::DELETE
0 | 0 | 0 | 0s | 0s | DBD::SQLite::::__ANON__[:33] DBD::SQLite::__ANON__[:33]
0 | 0 | 0 | 0s | 0s | DBD::SQLite::::__ANON__[:34] DBD::SQLite::__ANON__[:34]
0 | 0 | 0 | 0s | 0s | DBD::SQLite::db::::_attached_database_list DBD::SQLite::db::_attached_database_list
0 | 0 | 0 | 0s | 0s | DBD::SQLite::db::::column_info DBD::SQLite::db::column_info
0 | 0 | 0 | 0s | 0s | DBD::SQLite::db::::primary_key_info DBD::SQLite::db::primary_key_info
0 | 0 | 0 | 0s | 0s | DBD::SQLite::db::::table_info DBD::SQLite::db::table_info
0 | 0 | 0 | 0s | 0s | DBD::SQLite::db::::type_info_all DBD::SQLite::db::type_info_all
0 | 0 | 0 | 0s | 0s | DBD::SQLite::dr::::install_collation DBD::SQLite::dr::install_collation
0 | 0 | 0 | 0s | 0s | DBD::SQLite::dr::::regexp DBD::SQLite::dr::regexp

Call graph for these subroutines as a Graphviz dot language file.

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 use 5.006; # 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 use strict; # 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 use DBI 1.57 (); # 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 use DynaLoader (); # 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 use vars qw($VERSION @ISA); # 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 use vars qw{$err $errstr $drh $sqlite_version $sqlite_version_number}; # 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 use vars qw{%COLLATION}; # 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 BEGIN {
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 use constant NEWAPI => ($DBI::VERSION >= 1.608); # 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 $COLLATION{perllocale} = sub { use locale; $_[0] cmp $_[1] }; # 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 sub driver {
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 sub connect {
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, \&regexp ); # 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, \&regexp, "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 use locale; # 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 sub prepare {
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 sub do {
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 sub _get_version {
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 sub get_info {
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 sub TIEHASH {
600 | 1 | 12µs |  |  | bless {}, $_[0];
601 |  |  |  |  | }
602 |  |  |  |  |
603 |  |  |  |  | # spent 5µs within DBD::SQLite::_WriteOnceHash::STORE which was called 2 times, avg 2µs/call: # once (3µs+0s) by DBI::install_driver at line 33 # once (2µs+0s) by DBI::install_driver at line 34 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 sub DBD::SQLite::bootstrap; # xsub
|  |  |  |  | # 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 sub DBD::SQLite::db::FETCH; # xsub
|  |  |  |  | # 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 sub DBD::SQLite::db::_login; # xsub
|  |  |  |  | # 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 sub DBD::SQLite::dr::CORE:match; # opcode