← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 11:58:52 2013
Reported on Tue Oct 15 12:02:05 2013

Filename/usr/lib/perl5/DBD/mysql.pm
StatementsExecuted 6704 statements in 61.6ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1653411231.8ms137msDBD::mysql::db::::prepareDBD::mysql::db::prepare
16531115.9ms15.9msDBD::mysql::st::::_prepareDBD::mysql::st::_prepare (xsub)
1118.09ms8.09msDBD::mysql::db::::_loginDBD::mysql::db::_login (xsub)
111619µs5.46msDBD::mysql::dr::::BEGIN@101DBD::mysql::dr::BEGIN@101
111133µs133µsDBD::mysql::::bootstrap DBD::mysql::bootstrap (xsub)
11190µs8.53msDBD::mysql::dr::::connectDBD::mysql::dr::connect
62176µs232µsDBD::mysql::::CORE:match DBD::mysql::CORE:match (opcode)
11151µs284µsDBD::mysql::::_OdbcParse DBD::mysql::_OdbcParse
11124µs30µsDBD::mysql::::BEGIN@4 DBD::mysql::BEGIN@4
11121µs26µsDBD::mysql::st::::BEGIN@738DBD::mysql::st::BEGIN@738
11118µs91µsDBD::mysql::::driver DBD::mysql::driver
11116µs23µsDBD::mysql::db::::BEGIN@186DBD::mysql::db::BEGIN@186
11115µs854µsDBD::mysql::dr::::BEGIN@100DBD::mysql::dr::BEGIN@100
11114µs18µsDBD::mysql::dr::::BEGIN@99DBD::mysql::dr::BEGIN@99
11113µs103µsDBD::mysql::::BEGIN@5 DBD::mysql::BEGIN@5
11112µs585µsDBD::mysql::db::::BEGIN@187DBD::mysql::db::BEGIN@187
1117µs7µsDBD::mysql::::BEGIN@7 DBD::mysql::BEGIN@7
1116µs6µsDBD::mysql::::BEGIN@8 DBD::mysql::BEGIN@8
1115µs5µsDBD::mysql::::BEGIN@9 DBD::mysql::BEGIN@9
0000s0sDBD::mysql::::AUTOLOAD DBD::mysql::AUTOLOAD
0000s0sDBD::mysql::::CLONE DBD::mysql::CLONE
0000s0sDBD::mysql::::_OdbcParseHost DBD::mysql::_OdbcParseHost
0000s0sDBD::mysql::db::::ANSI2dbDBD::mysql::db::ANSI2db
0000s0sDBD::mysql::db::::_ListTablesDBD::mysql::db::_ListTables
0000s0sDBD::mysql::db::::_SelectDBDBD::mysql::db::_SelectDB
0000s0sDBD::mysql::db::::_versionDBD::mysql::db::_version
0000s0sDBD::mysql::db::::adminDBD::mysql::db::admin
0000s0sDBD::mysql::db::::column_infoDBD::mysql::db::column_info
0000s0sDBD::mysql::db::::db2ANSIDBD::mysql::db::db2ANSI
0000s0sDBD::mysql::db::::foreign_key_infoDBD::mysql::db::foreign_key_info
0000s0sDBD::mysql::db::::get_infoDBD::mysql::db::get_info
0000s0sDBD::mysql::db::::primary_key_infoDBD::mysql::db::primary_key_info
0000s0sDBD::mysql::db::::table_infoDBD::mysql::db::table_info
0000s0sDBD::mysql::dr::::adminDBD::mysql::dr::admin
0000s0sDBD::mysql::dr::::data_sourcesDBD::mysql::dr::data_sources
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# -*- cperl -*-
2
3package DBD::mysql;
4339µs237µs
# spent 30µs (24+7) within DBD::mysql::BEGIN@4 which was called: # once (24µs+7µs) by DBI::install_driver at line 4
use strict;
# spent 30µs making 1 call to DBD::mysql::BEGIN@4 # spent 7µs making 1 call to strict::import
5333µs2192µs
# spent 103µs (13+90) within DBD::mysql::BEGIN@5 which was called: # once (13µs+90µs) by DBI::install_driver at line 5
use vars qw(@ISA $VERSION $err $errstr $drh);
# spent 103µs making 1 call to DBD::mysql::BEGIN@5 # spent 90µs making 1 call to vars::import
6
7322µs17µs
# spent 7µs within DBD::mysql::BEGIN@7 which was called: # once (7µs+0s) by DBI::install_driver at line 7
use DBI ();
# spent 7µs making 1 call to DBD::mysql::BEGIN@7
8321µs16µs
# spent 6µs within DBD::mysql::BEGIN@8 which was called: # once (6µs+0s) by DBI::install_driver at line 8
use DynaLoader();
# spent 6µs making 1 call to DBD::mysql::BEGIN@8
93459µs15µs
# spent 5µs within DBD::mysql::BEGIN@9 which was called: # once (5µs+0s) by DBI::install_driver at line 9
use Carp ();
# spent 5µs making 1 call to DBD::mysql::BEGIN@9
10116µs@ISA = qw(DynaLoader);
11
1211µs$VERSION = '4.016';
13
1419µs11.71msbootstrap DBD::mysql $VERSION;
# spent 1.71ms making 1 call to DynaLoader::bootstrap
15
16
171700ns$err = 0; # holds error code for DBI::err
1811µs$errstr = ""; # holds error string for DBI::errstr
191800ns$drh = undef; # holds driver handle once initialised
20
21
# spent 91µs (18+72) within DBD::mysql::driver which was called: # once (18µs+72µs) by DBI::install_driver at line 811 of DBI.pm
sub driver{
221600ns return $drh if $drh;
2312µs my($class, $attr) = @_;
24
2511µs $class .= "::dr";
26
27 # not a 'my' since we use it above to prevent multiple drivers
28112µs172µs $drh = DBI::_new_drh($class, { 'Name' => 'mysql',
# spent 72µs making 1 call to DBI::_new_drh
29 'Version' => $VERSION,
30 'Err' => \$DBD::mysql::err,
31 'Errstr' => \$DBD::mysql::errstr,
32 'Attribution' => 'DBD::mysql by Patrick Galbraith'
33 });
34
3514µs $drh;
36}
37
38sub CLONE {
39 undef $drh;
40}
41
42
# spent 284µs (51+232) within DBD::mysql::_OdbcParse which was called: # once (51µs+232µs) by DBD::mysql::dr::connect at line 123
sub _OdbcParse($$$) {
4312µs my($class, $dsn, $hash, $args) = @_;
441800ns my($var, $val);
451700ns if (!defined($dsn)) {
46 return;
47 }
4818µs while (length($dsn)) {
49365µs5291µs if ($dsn =~ /([^:;]*)[:;](.*)/) {
# spent 173µs making 3 calls to DBD::mysql::CORE:match, avg 58µs/call # spent 118µs making 2 calls to utf8::SWASHNEW, avg 59µs/call
5022µs $val = $1;
5122µs $dsn = $2;
52 } else {
531700ns $val = $dsn;
541800ns $dsn = '';
55 }
56329µs498µs if ($val =~ /([^=]*)=(.*)/) {
# spent 59µs making 3 calls to DBD::mysql::CORE:match, avg 20µs/call # spent 39µs making 1 call to utf8::SWASHNEW
5733µs $var = $1;
5832µs $val = $2;
5939µs if ($var eq 'hostname' || $var eq 'host') {
60 $hash->{'host'} = $val;
61 } elsif ($var eq 'db' || $var eq 'dbname') {
62 $hash->{'database'} = $val;
63 } else {
6412µs $hash->{$var} = $val;
65 }
66 } else {
67 foreach $var (@$args) {
68 if (!defined($hash->{$var})) {
69 $hash->{$var} = $val;
70 last;
71 }
72 }
73 }
74 }
75}
76
77sub _OdbcParseHost ($$) {
78 my($class, $dsn) = @_;
79 my($hash) = {};
80 $class->_OdbcParse($dsn, $hash, ['host', 'port']);
81 ($hash->{'host'}, $hash->{'port'});
82}
83
84sub AUTOLOAD {
85 my ($meth) = $DBD::mysql::AUTOLOAD;
86 my ($smeth) = $meth;
87 $smeth =~ s/(.*)\:\://;
88
89 my $val = constant($smeth, @_ ? $_[0] : 0);
90 if ($! == 0) { eval "sub $meth { $val }"; return $val; }
91
92 Carp::croak "$meth: Not defined";
93}
94
951200ns1;
96
97
98package DBD::mysql::dr; # ====== DRIVER ======
99331µs222µs
# spent 18µs (14+4) within DBD::mysql::dr::BEGIN@99 which was called: # once (14µs+4µs) by DBI::install_driver at line 99
use strict;
# spent 18µs making 1 call to DBD::mysql::dr::BEGIN@99 # spent 4µs making 1 call to strict::import
100343µs21.69ms
# spent 854µs (15+838) within DBD::mysql::dr::BEGIN@100 which was called: # once (15µs+838µs) by DBI::install_driver at line 100
use DBI qw(:sql_types);
# spent 854µs making 1 call to DBD::mysql::dr::BEGIN@100 # spent 838µs making 1 call to Exporter::import
1013605µs25.61ms
# spent 5.46ms (619µs+4.84) within DBD::mysql::dr::BEGIN@101 which was called: # once (619µs+4.84ms) by DBI::install_driver at line 101
use DBI::Const::GetInfoType;
# spent 5.46ms making 1 call to DBD::mysql::dr::BEGIN@101 # spent 149µs making 1 call to Exporter::import
102
103
# spent 8.53ms (90µs+8.44) within DBD::mysql::dr::connect which was called: # once (90µs+8.44ms) by DBI::dr::connect at line 662 of DBI.pm
sub connect {
10412µs my($drh, $dsn, $username, $password, $attrhash) = @_;
1051500ns my($port);
1061400ns my($cWarn);
10712µs my $connect_ref= { 'Name' => $dsn };
1081400ns my $dbi_imp_data;
109
110 # Avoid warnings for undefined values
1111700ns $username ||= '';
1121400ns $password ||= '';
1131600ns $attrhash ||= {};
114
115 # create a 'blank' dbh
11611µs my($this, $privateAttrHash) = (undef, $attrhash);
11719µs $privateAttrHash = { %$privateAttrHash,
118 'Name' => $dsn,
119 'user' => $username,
120 'password' => $password
121 };
122
12316µs1284µs DBD::mysql->_OdbcParse($dsn, $privateAttrHash,
# spent 284µs making 1 call to DBD::mysql::_OdbcParse
124 ['database', 'host', 'port']);
125
126
12716µs if ($DBI::VERSION >= 1.49)
128 {
12912µs $dbi_imp_data = delete $attrhash->{dbi_imp_data};
13012µs $connect_ref->{'dbi_imp_data'} = $dbi_imp_data;
131 }
132
13316µs161µs if (!defined($this = DBI::_new_dbh($drh,
# spent 61µs making 1 call to DBI::_new_dbh
134 $connect_ref,
135 $privateAttrHash)))
136 {
137 return undef;
138 }
139
140 # Call msqlConnect func in mSQL.xs file
141 # and populate internal handle data.
14218.13ms18.09ms DBD::mysql::db::_login($this, $dsn, $username, $password)
# spent 8.09ms making 1 call to DBD::mysql::db::_login
143 or $this = undef;
144
14516µs if ($this && ($ENV{MOD_PERL} || $ENV{GATEWAY_INTERFACE})) {
146 $this->{mysql_auto_reconnect} = 1;
147 }
148110µs $this;
149}
150
151sub data_sources {
152 my($self) = shift;
153 my($attributes) = shift;
154 my($host, $port, $user, $password) = ('', '', '', '');
155 if ($attributes) {
156 $host = $attributes->{host} || '';
157 $port = $attributes->{port} || '';
158 $user = $attributes->{user} || '';
159 $password = $attributes->{password} || '';
160 }
161 my(@dsn) = $self->func($host, $port, $user, $password, '_ListDBs');
162 my($i);
163 for ($i = 0; $i < @dsn; $i++) {
164 $dsn[$i] = "DBI:mysql:$dsn[$i]";
165 }
166 @dsn;
167}
168
169sub admin {
170 my($drh) = shift;
171 my($command) = shift;
172 my($dbname) = ($command eq 'createdb' || $command eq 'dropdb') ?
173 shift : '';
174 my($host, $port) = DBD::mysql->_OdbcParseHost(shift(@_) || '');
175 my($user) = shift || '';
176 my($password) = shift || '';
177
178 $drh->func(undef, $command,
179 $dbname || '',
180 $host || '',
181 $port || '',
182 $user, $password, '_admin_internal');
183}
184
185package DBD::mysql::db; # ====== DATABASE ======
186336µs229µs
# spent 23µs (16+7) within DBD::mysql::db::BEGIN@186 which was called: # once (16µs+7µs) by DBI::install_driver at line 186
use strict;
# spent 23µs making 1 call to DBD::mysql::db::BEGIN@186 # spent 7µs making 1 call to strict::import
18732.56ms21.16ms
# spent 585µs (12+573) within DBD::mysql::db::BEGIN@187 which was called: # once (12µs+573µs) by DBI::install_driver at line 187
use DBI qw(:sql_types);
# spent 585µs making 1 call to DBD::mysql::db::BEGIN@187 # spent 573µs making 1 call to Exporter::import
188
18916µs%DBD::mysql::db::db2ANSI = ("INT" => "INTEGER",
190 "CHAR" => "CHAR",
191 "REAL" => "REAL",
192 "IDENT" => "DECIMAL"
193 );
194
195### ANSI datatype mapping to mSQL datatypes
196119µs%DBD::mysql::db::ANSI2db = ("CHAR" => "CHAR",
197 "VARCHAR" => "CHAR",
198 "LONGVARCHAR" => "CHAR",
199 "NUMERIC" => "INTEGER",
200 "DECIMAL" => "INTEGER",
201 "BIT" => "INTEGER",
202 "TINYINT" => "INTEGER",
203 "SMALLINT" => "INTEGER",
204 "INTEGER" => "INTEGER",
205 "BIGINT" => "INTEGER",
206 "REAL" => "REAL",
207 "FLOAT" => "REAL",
208 "DOUBLE" => "REAL",
209 "BINARY" => "CHAR",
210 "VARBINARY" => "CHAR",
211 "LONGVARBINARY" => "CHAR",
212 "DATE" => "CHAR",
213 "TIME" => "CHAR",
214 "TIMESTAMP" => "CHAR"
215 );
216
217
# spent 137ms (31.8+105) within DBD::mysql::db::prepare which was called 1653 times, avg 83µs/call: # 174 times (3.43ms+11.4ms) by DBI::db::prepare at line 1594 of /usr/share/koha/lib/C4/Biblio.pm, avg 85µs/call # 161 times (2.88ms+10.3ms) by DBI::db::prepare at line 558 of /usr/share/koha/lib/C4/Context.pm, avg 82µs/call # 148 times (2.78ms+9.26ms) by DBI::db::prepare at line 1000 of /usr/share/koha/lib/C4/Koha.pm, avg 81µs/call # 143 times (2.83ms+9.23ms) by DBI::db::prepare at line 1246 of /usr/share/koha/lib/C4/Koha.pm, avg 84µs/call # 100 times (2.12ms+7.44ms) by DBI::db::prepare at line 2085 of /usr/share/koha/lib/C4/Biblio.pm, avg 96µs/call # 75 times (1.87ms+5.01ms) by DBI::db::prepare at line 678 of /usr/share/koha/lib/C4/Biblio.pm, avg 92µs/call # 64 times (1.33ms+4.74ms) by DBI::db::prepare at line 2785 of /usr/share/koha/lib/C4/Circulation.pm, avg 95µs/call # 64 times (1.27ms+4.73ms) by DBI::db::prepare at line 182 of /usr/share/koha/lib/C4/Branch.pm, avg 94µs/call # 64 times (1.28ms+3.96ms) by DBI::db::prepare at line 754 of /usr/share/koha/lib/C4/Reserves.pm, avg 82µs/call # 57 times (1.13ms+4.39ms) by DBI::db::prepare at line 441 of /usr/share/koha/lib/C4/Koha.pm, avg 97µs/call # 51 times (920µs+2.58ms) by DBI::db::prepare at line 1171 of /usr/share/koha/lib/C4/Koha.pm, avg 69µs/call # 38 times (621µs+2.15ms) by DBI::db::prepare at line 209 of /usr/share/koha/lib/C4/Languages.pm, avg 73µs/call # 38 times (527µs+1.86ms) by DBI::db::prepare at line 202 of /usr/share/koha/lib/C4/Languages.pm, avg 63µs/call # 38 times (507µs+1.61ms) by DBI::db::prepare at line 197 of /usr/share/koha/lib/C4/Languages.pm, avg 56µs/call # 33 times (534µs+1.82ms) by DBI::db::prepare at line 352 of /usr/share/koha/lib/C4/Languages.pm, avg 71µs/call # 32 times (774µs+2.01ms) by DBI::db::prepare at line 760 of /usr/share/koha/lib/C4/Reserves.pm, avg 87µs/call # 32 times (609µs+1.84ms) by DBI::db::prepare at line 1269 of /usr/share/koha/lib/C4/Items.pm, avg 76µs/call # 32 times (512µs+1.60ms) by DBI::db::prepare at line 1298 of /usr/share/koha/lib/C4/Items.pm, avg 66µs/call # 32 times (443µs+1.59ms) by DBI::db::prepare at line 1309 of /usr/share/koha/lib/C4/Items.pm, avg 63µs/call # 27 times (473µs+1.71ms) by DBI::db::prepare at line 117 of /usr/share/koha/lib/C4/Branch.pm, avg 81µs/call # 27 times (508µs+1.63ms) by DBI::db::prepare at line 120 of /usr/share/koha/lib/C4/Branch.pm, avg 79µs/call # 27 times (410µs+1.18ms) by DBI::db::prepare at line 359 of /usr/share/koha/lib/C4/Languages.pm, avg 59µs/call # 26 times (605µs+1.96ms) by DBI::db::prepare at line 253 of /usr/share/koha/lib/C4/Koha.pm, avg 99µs/call # 25 times (748µs+2.10ms) by DBI::db::prepare at line 1234 of /usr/share/koha/lib/C4/Items.pm, avg 114µs/call # 25 times (563µs+2.05ms) by DBI::db::prepare at line 1240 of /usr/share/koha/lib/C4/Items.pm, avg 105µs/call # 25 times (531µs+1.79ms) by DBI::db::prepare at line 1255 of /usr/share/koha/lib/C4/Biblio.pm, avg 93µs/call # 25 times (507µs+1.54ms) by DBI::db::prepare at line 283 of /usr/share/koha/lib/C4/Tags.pm, avg 82µs/call # 25 times (385µs+1.30ms) by DBI::db::prepare at line 2625 of /usr/share/koha/lib/C4/Biblio.pm, avg 67µs/call # 25 times (344µs+1.03ms) by DBI::db::prepare at line 1245 of /usr/share/koha/lib/C4/Items.pm, avg 55µs/call # 3 times (68µs+324µs) by DBI::db::prepare at line 1110 of /usr/share/koha/lib/C4/Biblio.pm, avg 131µs/call # 3 times (64µs+239µs) by DBI::db::prepare at line 122 of /usr/share/koha/lib/C4/XSLT.pm, avg 101µs/call # 3 times (38µs+130µs) by DBI::db::prepare at line 1094 of /usr/share/koha/lib/C4/Biblio.pm, avg 56µs/call # 2 times (36µs+120µs) by DBI::db::prepare at line 365 of /usr/share/koha/lib/C4/Branch.pm, avg 78µs/call # 2 times (24µs+87µs) by DBI::db::prepare at line 1069 of /usr/share/koha/lib/C4/Koha.pm, avg 55µs/call # once (22µs+87µs) by DBI::db::prepare at line 1634 of DBI.pm # once (24µs+84µs) by DBI::db::prepare at line 1677 of /usr/share/koha/lib/C4/Search.pm # once (20µs+70µs) by DBI::db::prepare at line 1646 of /usr/share/koha/lib/C4/Search.pm # once (17µs+54µs) by DBI::db::prepare at line 604 of /usr/share/koha/lib/C4/Branch.pm # once (15µs+51µs) by DBI::db::prepare at line 1022 of /usr/share/koha/lib/C4/Context.pm # once (15µs+50µs) by DBI::db::prepare at line 1662 of /usr/share/koha/lib/C4/Search.pm # once (10µs+45µs) by DBI::db::prepare at line 192 of /usr/share/koha/lib/C4/Languages.pm
sub prepare {
21816534.35ms my($dbh, $statement, $attribs)= @_;
219
220 # create a 'blank' dbh
221165314.2ms165389.3ms my $sth = DBI::_new_sth($dbh, {'Statement' => $statement});
# spent 89.3ms making 1653 calls to DBI::_new_sth, avg 54µs/call
222
223 # Populate internal handle data.
224165323.3ms165315.9ms if (!DBD::mysql::st::_prepare($sth, $statement, $attribs)) {
# spent 15.9ms making 1653 calls to DBD::mysql::st::_prepare, avg 10µs/call
225 $sth = undef;
226 }
227
22816537.38ms $sth;
229}
230
231sub db2ANSI {
232 my $self = shift;
233 my $type = shift;
234 return $DBD::mysql::db::db2ANSI{"$type"};
235}
236
237sub ANSI2db {
238 my $self = shift;
239 my $type = shift;
240 return $DBD::mysql::db::ANSI2db{"$type"};
241}
242
243sub admin {
244 my($dbh) = shift;
245 my($command) = shift;
246 my($dbname) = ($command eq 'createdb' || $command eq 'dropdb') ?
247 shift : '';
248 $dbh->{'Driver'}->func($dbh, $command, $dbname, '', '', '',
249 '_admin_internal');
250}
251
252sub _SelectDB ($$) {
253 die "_SelectDB is removed from this module; use DBI->connect instead.";
254}
255
256sub table_info ($) {
257 my ($dbh, $catalog, $schema, $table, $type, $attr) = @_;
258 $dbh->{mysql_server_prepare}||= 0;
259 my $mysql_server_prepare_save= $dbh->{mysql_server_prepare};
260 $dbh->{mysql_server_prepare}= 0;
261 my @names = qw(TABLE_CAT TABLE_SCHEM TABLE_NAME TABLE_TYPE REMARKS);
262 my @rows;
263
264 my $sponge = DBI->connect("DBI:Sponge:", '','')
265 or return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr");
266
267# Return the list of catalogs
268 if (defined $catalog && $catalog eq "%" &&
269 (!defined($schema) || $schema eq "") &&
270 (!defined($table) || $table eq ""))
271 {
272 @rows = (); # Empty, because MySQL doesn't support catalogs (yet)
273 }
274 # Return the list of schemas
275 elsif (defined $schema && $schema eq "%" &&
276 (!defined($catalog) || $catalog eq "") &&
277 (!defined($table) || $table eq ""))
278 {
279 my $sth = $dbh->prepare("SHOW DATABASES")
280 or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
281 return undef);
282
283 $sth->execute()
284 or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
285 return DBI::set_err($dbh, $sth->err(), $sth->errstr()));
286
287 while (my $ref = $sth->fetchrow_arrayref())
288 {
289 push(@rows, [ undef, $ref->[0], undef, undef, undef ]);
290 }
291 }
292 # Return the list of table types
293 elsif (defined $type && $type eq "%" &&
294 (!defined($catalog) || $catalog eq "") &&
295 (!defined($schema) || $schema eq "") &&
296 (!defined($table) || $table eq ""))
297 {
298 @rows = (
299 [ undef, undef, undef, "TABLE", undef ],
300 [ undef, undef, undef, "VIEW", undef ],
301 );
302 }
303 # Special case: a catalog other than undef, "", or "%"
304 elsif (defined $catalog && $catalog ne "" && $catalog ne "%")
305 {
306 @rows = (); # Nothing, because MySQL doesn't support catalogs yet.
307 }
308 # Uh oh, we actually have a meaty table_info call. Work is required!
309 else
310 {
311 my @schemas;
312 # If no table was specified, we want them all
313 $table ||= "%";
314
315 # If something was given for the schema, we need to expand it to
316 # a list of schemas, since it may be a wildcard.
317 if (defined $schema && $schema ne "")
318 {
319 my $sth = $dbh->prepare("SHOW DATABASES LIKE " .
320 $dbh->quote($schema))
321 or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
322 return undef);
323 $sth->execute()
324 or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
325 return DBI::set_err($dbh, $sth->err(), $sth->errstr()));
326
327 while (my $ref = $sth->fetchrow_arrayref())
328 {
329 push @schemas, $ref->[0];
330 }
331 }
332 # Otherwise we want the current database
333 else
334 {
335 push @schemas, $dbh->selectrow_array("SELECT DATABASE()");
336 }
337
338 # Figure out which table types are desired
339 my ($want_tables, $want_views);
340 if (defined $type && $type ne "")
341 {
342 $want_tables = ($type =~ m/table/i);
343 $want_views = ($type =~ m/view/i);
344 }
345 else
346 {
347 $want_tables = $want_views = 1;
348 }
349
350 for my $database (@schemas)
351 {
352 my $sth = $dbh->prepare("SHOW /*!50002 FULL*/ TABLES FROM " .
353 $dbh->quote_identifier($database) .
354 " LIKE " . $dbh->quote($table))
355 or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
356 return undef);
357
358 $sth->execute() or
359 ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
360 return DBI::set_err($dbh, $sth->err(), $sth->errstr()));
361
362 while (my $ref = $sth->fetchrow_arrayref())
363 {
364 my $type = (defined $ref->[1] &&
365 $ref->[1] =~ /view/i) ? 'VIEW' : 'TABLE';
366 next if $type eq 'TABLE' && not $want_tables;
367 next if $type eq 'VIEW' && not $want_views;
368 push @rows, [ undef, $database, $ref->[0], $type, undef ];
369 }
370 }
371 }
372
373 my $sth = $sponge->prepare("table_info",
374 {
375 rows => \@rows,
376 NUM_OF_FIELDS => scalar @names,
377 NAME => \@names,
378 })
379 or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
380 return $dbh->DBI::set_err($sponge->err(), $sponge->errstr()));
381
382 $dbh->{mysql_server_prepare}= $mysql_server_prepare_save;
383 return $sth;
384}
385
386sub _ListTables {
387 my $dbh = shift;
388 if (!$DBD::mysql::QUIET) {
389 warn "_ListTables is deprecated, use \$dbh->tables()";
390 }
391 return map { $_ =~ s/.*\.//; $_ } $dbh->tables();
392}
393
394
395sub column_info {
396 my ($dbh, $catalog, $schema, $table, $column) = @_;
397 $dbh->{mysql_server_prepare}||= 0;
398 my $mysql_server_prepare_save= $dbh->{mysql_server_prepare};
399 $dbh->{mysql_server_prepare}= 0;
400
401 # ODBC allows a NULL to mean all columns, so we'll accept undef
402 $column = '%' unless defined $column;
403
404 my $ER_NO_SUCH_TABLE= 1146;
405
406 my $table_id = $dbh->quote_identifier($catalog, $schema, $table);
407
408 my @names = qw(
409 TABLE_CAT TABLE_SCHEM TABLE_NAME COLUMN_NAME
410 DATA_TYPE TYPE_NAME COLUMN_SIZE BUFFER_LENGTH DECIMAL_DIGITS
411 NUM_PREC_RADIX NULLABLE REMARKS COLUMN_DEF
412 SQL_DATA_TYPE SQL_DATETIME_SUB CHAR_OCTET_LENGTH
413 ORDINAL_POSITION IS_NULLABLE CHAR_SET_CAT
414 CHAR_SET_SCHEM CHAR_SET_NAME COLLATION_CAT COLLATION_SCHEM COLLATION_NAME
415 UDT_CAT UDT_SCHEM UDT_NAME DOMAIN_CAT DOMAIN_SCHEM DOMAIN_NAME
416 SCOPE_CAT SCOPE_SCHEM SCOPE_NAME MAX_CARDINALITY
417 DTD_IDENTIFIER IS_SELF_REF
418 mysql_is_pri_key mysql_type_name mysql_values
419 mysql_is_auto_increment
420 );
421 my %col_info;
422
423 local $dbh->{FetchHashKeyName} = 'NAME_lc';
424 # only ignore ER_NO_SUCH_TABLE in internal_execute if issued from here
425 my $desc_sth = $dbh->prepare("DESCRIBE $table_id " . $dbh->quote($column));
426 my $desc = $dbh->selectall_arrayref($desc_sth, { Columns=>{} });
427
428 #return $desc_sth if $desc_sth->err();
429 if (my $err = $desc_sth->err())
430 {
431 # return the error, unless it is due to the table not
432 # existing per DBI spec
433 if ($err != $ER_NO_SUCH_TABLE)
434 {
435 $dbh->{mysql_server_prepare}= $mysql_server_prepare_save;
436 return undef;
437 }
438 $dbh->set_err(undef,undef);
439 $desc = [];
440 }
441
442 my $ordinal_pos = 0;
443 for my $row (@$desc)
444 {
445 my $type = $row->{type};
446 $type =~ m/^(\w+)(?:\((.*?)\))?\s*(.*)/;
447 my $basetype = lc($1);
448 my $typemod = $2;
449 my $attr = $3;
450
451 my $info = $col_info{ $row->{field} }= {
452 TABLE_CAT => $catalog,
453 TABLE_SCHEM => $schema,
454 TABLE_NAME => $table,
455 COLUMN_NAME => $row->{field},
456 NULLABLE => ($row->{null} eq 'YES') ? 1 : 0,
457 IS_NULLABLE => ($row->{null} eq 'YES') ? "YES" : "NO",
458 TYPE_NAME => uc($basetype),
459 COLUMN_DEF => $row->{default},
460 ORDINAL_POSITION => ++$ordinal_pos,
461 mysql_is_pri_key => ($row->{key} eq 'PRI'),
462 mysql_type_name => $row->{type},
463 mysql_is_auto_increment => ($row->{extra} =~ /auto_increment/i ? 1 : 0),
464 };
465 #
466 # This code won't deal with a pathalogical case where a value
467 # contains a single quote followed by a comma, and doesn't unescape
468 # any escaped values. But who would use those in an enum or set?
469 #
470 my @type_params= ($typemod && index($typemod,"'")>=0) ?
471 ("$typemod," =~ /'(.*?)',/g) # assume all are quoted
472 : split /,/, $typemod||''; # no quotes, plain list
473 s/''/'/g for @type_params; # undo doubling of quotes
474
475 my @type_attr= split / /, $attr||'';
476
477 $info->{DATA_TYPE}= SQL_VARCHAR();
478 if ($basetype =~ /^(char|varchar|\w*text|\w*blob)/)
479 {
480 $info->{DATA_TYPE}= SQL_CHAR() if $basetype eq 'char';
481 if ($type_params[0])
482 {
483 $info->{COLUMN_SIZE} = $type_params[0];
484 }
485 else
486 {
487 $info->{COLUMN_SIZE} = 65535;
488 $info->{COLUMN_SIZE} = 255 if $basetype =~ /^tiny/;
489 $info->{COLUMN_SIZE} = 16777215 if $basetype =~ /^medium/;
490 $info->{COLUMN_SIZE} = 4294967295 if $basetype =~ /^long/;
491 }
492 }
493 elsif ($basetype =~ /^(binary|varbinary)/)
494 {
495 $info->{COLUMN_SIZE} = $type_params[0];
496 # SQL_BINARY & SQL_VARBINARY are tempting here but don't match the
497 # semantics for mysql (not hex). SQL_CHAR & SQL_VARCHAR are correct here.
498 $info->{DATA_TYPE} = ($basetype eq 'binary') ? SQL_CHAR() : SQL_VARCHAR();
499 }
500 elsif ($basetype =~ /^(enum|set)/)
501 {
502 if ($basetype eq 'set')
503 {
504 $info->{COLUMN_SIZE} = length(join ",", @type_params);
505 }
506 else
507 {
508 my $max_len = 0;
509 length($_) > $max_len and $max_len = length($_) for @type_params;
510 $info->{COLUMN_SIZE} = $max_len;
511 }
512 $info->{"mysql_values"} = \@type_params;
513 }
514 elsif ($basetype =~ /int/)
515 {
516 # big/medium/small/tiny etc + unsigned?
517 $info->{DATA_TYPE} = SQL_INTEGER();
518 $info->{NUM_PREC_RADIX} = 10;
519 $info->{COLUMN_SIZE} = $type_params[0];
520 }
521 elsif ($basetype =~ /^decimal/)
522 {
523 $info->{DATA_TYPE} = SQL_DECIMAL();
524 $info->{NUM_PREC_RADIX} = 10;
525 $info->{COLUMN_SIZE} = $type_params[0];
526 $info->{DECIMAL_DIGITS} = $type_params[1];
527 }
528 elsif ($basetype =~ /^(float|double)/)
529 {
530 $info->{DATA_TYPE} = ($basetype eq 'float') ? SQL_FLOAT() : SQL_DOUBLE();
531 $info->{NUM_PREC_RADIX} = 2;
532 $info->{COLUMN_SIZE} = ($basetype eq 'float') ? 32 : 64;
533 }
534 elsif ($basetype =~ /date|time/)
535 {
536 # date/datetime/time/timestamp
537 if ($basetype eq 'time' or $basetype eq 'date')
538 {
539 #$info->{DATA_TYPE} = ($basetype eq 'time') ? SQL_TYPE_TIME() : SQL_TYPE_DATE();
540 $info->{DATA_TYPE} = ($basetype eq 'time') ? SQL_TIME() : SQL_DATE();
541 $info->{COLUMN_SIZE} = ($basetype eq 'time') ? 8 : 10;
542 }
543 else
544 {
545 # datetime/timestamp
546 #$info->{DATA_TYPE} = SQL_TYPE_TIMESTAMP();
547 $info->{DATA_TYPE} = SQL_TIMESTAMP();
548 $info->{SQL_DATA_TYPE} = SQL_DATETIME();
549 $info->{SQL_DATETIME_SUB} = $info->{DATA_TYPE} - ($info->{SQL_DATA_TYPE} * 10);
550 $info->{COLUMN_SIZE} = ($basetype eq 'datetime') ? 19 : $type_params[0] || 14;
551 }
552 $info->{DECIMAL_DIGITS}= 0; # no fractional seconds
553 }
554 elsif ($basetype eq 'year')
555 {
556 # no close standard so treat as int
557 $info->{DATA_TYPE} = SQL_INTEGER();
558 $info->{NUM_PREC_RADIX} = 10;
559 $info->{COLUMN_SIZE} = 4;
560 }
561 else
562 {
563 Carp::carp("column_info: unrecognized column type '$basetype' of $table_id.$row->{field} treated as varchar");
564 }
565 $info->{SQL_DATA_TYPE} ||= $info->{DATA_TYPE};
566 #warn Dumper($info);
567 }
568
569 my $sponge = DBI->connect("DBI:Sponge:", '','')
570 or ( $dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
571 return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr"));
572
573 my $sth = $sponge->prepare("column_info $table", {
574 rows => [ map { [ @{$_}{@names} ] } values %col_info ],
575 NUM_OF_FIELDS => scalar @names,
576 NAME => \@names,
577 }) or
578 return ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
579 $dbh->DBI::set_err($sponge->err(), $sponge->errstr()));
580
581 $dbh->{mysql_server_prepare}= $mysql_server_prepare_save;
582 return $sth;
583}
584
585
586sub primary_key_info {
587 my ($dbh, $catalog, $schema, $table) = @_;
588 $dbh->{mysql_server_prepare}||= 0;
589 my $mysql_server_prepare_save= $dbh->{mysql_server_prepare};
590
591 my $table_id = $dbh->quote_identifier($catalog, $schema, $table);
592
593 my @names = qw(
594 TABLE_CAT TABLE_SCHEM TABLE_NAME COLUMN_NAME KEY_SEQ PK_NAME
595 );
596 my %col_info;
597
598 local $dbh->{FetchHashKeyName} = 'NAME_lc';
599 my $desc_sth = $dbh->prepare("SHOW KEYS FROM $table_id");
600 my $desc= $dbh->selectall_arrayref($desc_sth, { Columns=>{} });
601 my $ordinal_pos = 0;
602 for my $row (grep { $_->{key_name} eq 'PRIMARY'} @$desc)
603 {
604 $col_info{ $row->{column_name} }= {
605 TABLE_CAT => $catalog,
606 TABLE_SCHEM => $schema,
607 TABLE_NAME => $table,
608 COLUMN_NAME => $row->{column_name},
609 KEY_SEQ => $row->{seq_in_index},
610 PK_NAME => $row->{key_name},
611 };
612 }
613
614 my $sponge = DBI->connect("DBI:Sponge:", '','')
615 or
616 ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
617 return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr"));
618
619 my $sth= $sponge->prepare("primary_key_info $table", {
620 rows => [ map { [ @{$_}{@names} ] } values %col_info ],
621 NUM_OF_FIELDS => scalar @names,
622 NAME => \@names,
623 }) or
624 ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
625 return $dbh->DBI::set_err($sponge->err(), $sponge->errstr()));
626
627 $dbh->{mysql_server_prepare}= $mysql_server_prepare_save;
628
629 return $sth;
630}
631
632
633sub foreign_key_info {
634 my ($dbh,
635 $pk_catalog, $pk_schema, $pk_table,
636 $fk_catalog, $fk_schema, $fk_table,
637 ) = @_;
638
639 # INFORMATION_SCHEMA.KEY_COLUMN_USAGE was added in 5.0.6
640 my ($maj, $min, $point) = _version($dbh);
641 return if $maj < 5 || ($maj == 5 && $point < 6);
642
643 my $sql = <<'EOF';
644SELECT NULL AS PKTABLE_CAT,
645 A.REFERENCED_TABLE_SCHEMA AS PKTABLE_SCHEM,
646 A.REFERENCED_TABLE_NAME AS PKTABLE_NAME,
647 A.REFERENCED_COLUMN_NAME AS PKCOLUMN_NAME,
648 A.TABLE_CATALOG AS FKTABLE_CAT,
649 A.TABLE_SCHEMA AS FKTABLE_SCHEM,
650 A.TABLE_NAME AS FKTABLE_NAME,
651 A.COLUMN_NAME AS FKCOLUMN_NAME,
652 A.ORDINAL_POSITION AS KEY_SEQ,
653 NULL AS UPDATE_RULE,
654 NULL AS DELETE_RULE,
655 A.CONSTRAINT_NAME AS FK_NAME,
656 NULL AS PK_NAME,
657 NULL AS DEFERABILITY,
658 NULL AS UNIQUE_OR_PRIMARY
659 FROM INFORMATION_SCHEMA.KEY_COLUMN_USAGE A,
660 INFORMATION_SCHEMA.TABLE_CONSTRAINTS B
661 WHERE A.TABLE_SCHEMA = B.TABLE_SCHEMA AND A.TABLE_NAME = B.TABLE_NAME
662 AND A.CONSTRAINT_NAME = B.CONSTRAINT_NAME AND B.CONSTRAINT_TYPE IS NOT NULL
663EOF
664
665 my @where;
666 my @bind;
667
668 # catalogs are not yet supported by MySQL
669
670# if (defined $pk_catalog) {
671# push @where, 'A.REFERENCED_TABLE_CATALOG = ?';
672# push @bind, $pk_catalog;
673# }
674
675 if (defined $pk_schema) {
676 push @where, 'A.REFERENCED_TABLE_SCHEMA = ?';
677 push @bind, $pk_schema;
678 }
679
680 if (defined $pk_table) {
681 push @where, 'A.REFERENCED_TABLE_NAME = ?';
682 push @bind, $pk_table;
683 }
684
685# if (defined $fk_catalog) {
686# push @where, 'A.TABLE_CATALOG = ?';
687# push @bind, $fk_schema;
688# }
689
690 if (defined $fk_schema) {
691 push @where, 'A.TABLE_SCHEMA = ?';
692 push @bind, $fk_schema;
693 }
694
695 if (defined $fk_table) {
696 push @where, 'A.TABLE_NAME = ?';
697 push @bind, $fk_table;
698 }
699
700 if (@where) {
701 $sql .= ' AND ';
702 $sql .= join ' AND ', @where;
703 }
704 $sql .= " ORDER BY A.TABLE_SCHEMA, A.TABLE_NAME, A.ORDINAL_POSITION";
705
706 local $dbh->{FetchHashKeyName} = 'NAME_uc';
707 my $sth = $dbh->prepare($sql);
708 $sth->execute(@bind);
709
710 return $sth;
711}
712
713
714sub _version {
715 my $dbh = shift;
716
717 return
718 $dbh->get_info($DBI::Const::GetInfoType::GetInfoType{SQL_DBMS_VER})
719 =~ /(\d+)\.(\d+)\.(\d+)/;
720}
721
722
723####################
724# get_info()
725# Generated by DBI::DBD::Metadata
726
727sub get_info {
728 my($dbh, $info_type) = @_;
729 require DBD::mysql::GetInfo;
730 my $v = $DBD::mysql::GetInfo::info{int($info_type)};
731 $v = $v->($dbh) if ref $v eq 'CODE';
732 return $v;
733}
734
- -
737package DBD::mysql::st; # ====== STATEMENT ======
738356µs232µs
# spent 26µs (21+6) within DBD::mysql::st::BEGIN@738 which was called: # once (21µs+6µs) by DBI::install_driver at line 738
use strict;
# spent 26µs making 1 call to DBD::mysql::st::BEGIN@738 # spent 6µs making 1 call to strict::import
739
740119µs1;
741
742__END__
 
# spent 232µs (76+157) within DBD::mysql::CORE:match which was called 6 times, avg 39µs/call: # 3 times (55µs+118µs) by DBD::mysql::_OdbcParse at line 49, avg 58µs/call # 3 times (21µs+39µs) by DBD::mysql::_OdbcParse at line 56, avg 20µs/call
sub DBD::mysql::CORE:match; # opcode
# spent 133µs within DBD::mysql::bootstrap which was called: # once (133µs+0s) by DynaLoader::bootstrap at line 215 of DynaLoader.pm
sub DBD::mysql::bootstrap; # xsub
# spent 8.09ms within DBD::mysql::db::_login which was called: # once (8.09ms+0s) by DBD::mysql::dr::connect at line 142
sub DBD::mysql::db::_login; # xsub
# spent 15.9ms within DBD::mysql::st::_prepare which was called 1653 times, avg 10µs/call: # 1653 times (15.9ms+0s) by DBD::mysql::db::prepare at line 224, avg 10µs/call
sub DBD::mysql::st::_prepare; # xsub
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.