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