← 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 17:10:45 2013
Reported on Tue Oct 15 17:11:23 2013

Filename/usr/lib/perl5/DBD/mysql.pm
StatementsExecuted 5980 statements in 57.5ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1472331127.6ms119msDBD::mysql::db::::prepareDBD::mysql::db::prepare
14721113.8ms13.8msDBD::mysql::st::::_prepareDBD::mysql::st::_prepare (xsub)
1119.31ms9.31msDBD::mysql::db::::_loginDBD::mysql::db::_login (xsub)
111544µs5.71msDBD::mysql::dr::::BEGIN@101DBD::mysql::dr::BEGIN@101
111121µs121µsDBD::mysql::::bootstrap DBD::mysql::bootstrap (xsub)
62171µs214µsDBD::mysql::::CORE:match DBD::mysql::CORE:match (opcode)
11170µs9.69msDBD::mysql::dr::::connectDBD::mysql::dr::connect
11152µs266µsDBD::mysql::::_OdbcParse DBD::mysql::_OdbcParse
11141µs55µsDBD::mysql::::BEGIN@4 DBD::mysql::BEGIN@4
11124µs246µsDBD::mysql::::BEGIN@5 DBD::mysql::BEGIN@5
11121µs235µsDBD::mysql::::driver DBD::mysql::driver
11117µs22µsDBD::mysql::st::::BEGIN@738DBD::mysql::st::BEGIN@738
11116µs1.07msDBD::mysql::dr::::BEGIN@100DBD::mysql::dr::BEGIN@100
11115µs20µsDBD::mysql::db::::BEGIN@186DBD::mysql::db::BEGIN@186
11114µs19µsDBD::mysql::dr::::BEGIN@99DBD::mysql::dr::BEGIN@99
11113µs636µsDBD::mysql::db::::BEGIN@187DBD::mysql::db::BEGIN@187
11111µs11µsDBD::mysql::::BEGIN@9 DBD::mysql::BEGIN@9
11110µs10µsDBD::mysql::::BEGIN@7 DBD::mysql::BEGIN@7
1119µs9µsDBD::mysql::::BEGIN@8 DBD::mysql::BEGIN@8
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;
4375µs268µs
# spent 55µs (41+14) within DBD::mysql::BEGIN@4 which was called: # once (41µs+14µs) by DBI::install_driver at line 4
use strict;
# spent 55µs making 1 call to DBD::mysql::BEGIN@4 # spent 14µs making 1 call to strict::import
5365µs2468µs
# spent 246µs (24+222) within DBD::mysql::BEGIN@5 which was called: # once (24µs+222µs) by DBI::install_driver at line 5
use vars qw(@ISA $VERSION $err $errstr $drh);
# spent 246µs making 1 call to DBD::mysql::BEGIN@5 # spent 222µs making 1 call to vars::import
6
7349µs110µs
# spent 10µs within DBD::mysql::BEGIN@7 which was called: # once (10µs+0s) by DBI::install_driver at line 7
use DBI ();
# spent 10µs making 1 call to DBD::mysql::BEGIN@7
8348µs19µs
# spent 9µs within DBD::mysql::BEGIN@8 which was called: # once (9µs+0s) by DBI::install_driver at line 8
use DynaLoader();
# spent 9µs making 1 call to DBD::mysql::BEGIN@8
93848µs111µs
# spent 11µs within DBD::mysql::BEGIN@9 which was called: # once (11µs+0s) by DBI::install_driver at line 9
use Carp ();
# spent 11µs making 1 call to DBD::mysql::BEGIN@9
10112µs@ISA = qw(DynaLoader);
11
121700ns$VERSION = '4.016';
13
1418µs11.73msbootstrap DBD::mysql $VERSION;
# spent 1.73ms making 1 call to DynaLoader::bootstrap
15
16
171600ns$err = 0; # holds error code for DBI::err
181600ns$errstr = ""; # holds error string for DBI::errstr
191800ns$drh = undef; # holds driver handle once initialised
20
21
# spent 235µs (21+214) within DBD::mysql::driver which was called: # once (21µs+214µs) by DBI::install_driver at line 811 of DBI.pm
sub driver{
22522µs return $drh if $drh;
23 my($class, $attr) = @_;
24
25 $class .= "::dr";
26
27 # not a 'my' since we use it above to prevent multiple drivers
281214µs $drh = DBI::_new_drh($class, { 'Name' => 'mysql',
# spent 214µ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
35 $drh;
36}
37
38sub CLONE {
39 undef $drh;
40}
41
42
# spent 266µs (52+214) within DBD::mysql::_OdbcParse which was called: # once (52µs+214µs) by DBD::mysql::dr::connect at line 123
sub _OdbcParse($$$) {
432690µs my($class, $dsn, $hash, $args) = @_;
44 my($var, $val);
45 if (!defined($dsn)) {
46 return;
47 }
48 while (length($dsn)) {
49123µs5266µs if ($dsn =~ /([^:;]*)[:;](.*)/) {
# spent 159µs making 3 calls to DBD::mysql::CORE:match, avg 53µs/call # spent 107µs making 2 calls to utf8::SWASHNEW, avg 54µs/call
50 $val = $1;
51 $dsn = $2;
52 } else {
53 $val = $dsn;
54 $dsn = '';
55 }
5619µs490µs if ($val =~ /([^=]*)=(.*)/) {
# spent 54µs making 3 calls to DBD::mysql::CORE:match, avg 18µs/call # spent 36µs making 1 call to utf8::SWASHNEW
57 $var = $1;
58 $val = $2;
59 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 {
64 $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 ======
99335µs224µs
# spent 19µs (14+5) within DBD::mysql::dr::BEGIN@99 which was called: # once (14µs+5µs) by DBI::install_driver at line 99
use strict;
# spent 19µs making 1 call to DBD::mysql::dr::BEGIN@99 # spent 5µs making 1 call to strict::import
100343µs22.12ms
# spent 1.07ms (16µs+1.05) within DBD::mysql::dr::BEGIN@100 which was called: # once (16µs+1.05ms) by DBI::install_driver at line 100
use DBI qw(:sql_types);
# spent 1.07ms making 1 call to DBD::mysql::dr::BEGIN@100 # spent 1.05ms making 1 call to Exporter::import
1013571µs25.82ms
# spent 5.71ms (544µs+5.16) within DBD::mysql::dr::BEGIN@101 which was called: # once (544µs+5.16ms) by DBI::install_driver at line 101
use DBI::Const::GetInfoType;
# spent 5.71ms making 1 call to DBD::mysql::dr::BEGIN@101 # spent 113µs making 1 call to Exporter::import
102
103
# spent 9.69ms (70µs+9.62) within DBD::mysql::dr::connect which was called: # once (70µs+9.62ms) by DBI::dr::connect at line 662 of DBI.pm
sub connect {
104189.38ms my($drh, $dsn, $username, $password, $attrhash) = @_;
105 my($port);
106 my($cWarn);
107 my $connect_ref= { 'Name' => $dsn };
108 my $dbi_imp_data;
109
110 # Avoid warnings for undefined values
111 $username ||= '';
112 $password ||= '';
113 $attrhash ||= {};
114
115 # create a 'blank' dbh
116 my($this, $privateAttrHash) = (undef, $attrhash);
117 $privateAttrHash = { %$privateAttrHash,
118 'Name' => $dsn,
119 'user' => $username,
120 'password' => $password
121 };
122
1231266µs DBD::mysql->_OdbcParse($dsn, $privateAttrHash,
# spent 266µs making 1 call to DBD::mysql::_OdbcParse
124 ['database', 'host', 'port']);
125
126
127 if ($DBI::VERSION >= 1.49)
128 {
129 $dbi_imp_data = delete $attrhash->{dbi_imp_data};
130 $connect_ref->{'dbi_imp_data'} = $dbi_imp_data;
131 }
132
133153µs if (!defined($this = DBI::_new_dbh($drh,
# spent 53µ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.
14219.31ms DBD::mysql::db::_login($this, $dsn, $username, $password)
# spent 9.31ms making 1 call to DBD::mysql::db::_login
143 or $this = undef;
144
145 if ($this && ($ENV{MOD_PERL} || $ENV{GATEWAY_INTERFACE})) {
146 $this->{mysql_auto_reconnect} = 1;
147 }
148 $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 ======
186333µs224µs
# spent 20µs (15+5) within DBD::mysql::db::BEGIN@186 which was called: # once (15µs+5µs) by DBI::install_driver at line 186
use strict;
# spent 20µs making 1 call to DBD::mysql::db::BEGIN@186 # spent 5µs making 1 call to strict::import
18732.87ms21.26ms
# spent 636µs (13+623) within DBD::mysql::db::BEGIN@187 which was called: # once (13µs+623µs) by DBI::install_driver at line 187
use DBI qw(:sql_types);
# spent 636µs making 1 call to DBD::mysql::db::BEGIN@187 # spent 623µs making 1 call to Exporter::import
188
18914µ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
196116µ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 119ms (27.6+91.1) within DBD::mysql::db::prepare which was called 1472 times, avg 81µs/call: # 174 times (3.15ms+11.1ms) by DBI::db::prepare at line 1594 of /usr/share/koha/lib/C4/Biblio.pm, avg 82µs/call # 161 times (2.98ms+9.84ms) by DBI::db::prepare at line 558 of /usr/share/koha/lib/C4/Context.pm, avg 80µs/call # 148 times (2.59ms+8.35ms) by DBI::db::prepare at line 1000 of /usr/share/koha/lib/C4/Koha.pm, avg 74µs/call # 143 times (2.47ms+7.79ms) by DBI::db::prepare at line 1246 of /usr/share/koha/lib/C4/Koha.pm, avg 72µs/call # 100 times (2.10ms+6.56ms) by DBI::db::prepare at line 2085 of /usr/share/koha/lib/C4/Biblio.pm, avg 87µs/call # 75 times (1.29ms+4.89ms) by DBI::db::prepare at line 678 of /usr/share/koha/lib/C4/Biblio.pm, avg 82µs/call # 64 times (1.42ms+4.55ms) by DBI::db::prepare at line 2785 of /usr/share/koha/lib/C4/Circulation.pm, avg 93µs/call # 64 times (1.39ms+4.02ms) by DBI::db::prepare at line 182 of /usr/share/koha/lib/C4/Branch.pm, avg 85µs/call # 64 times (1.25ms+3.94ms) by DBI::db::prepare at line 754 of /usr/share/koha/lib/C4/Reserves.pm, avg 81µs/call # 57 times (1.11ms+4.12ms) by DBI::db::prepare at line 441 of /usr/share/koha/lib/C4/Koha.pm, avg 92µs/call # 51 times (754µs+2.57ms) by DBI::db::prepare at line 1171 of /usr/share/koha/lib/C4/Koha.pm, avg 65µs/call # 32 times (553µs+2.04ms) by DBI::db::prepare at line 760 of /usr/share/koha/lib/C4/Reserves.pm, avg 81µs/call # 32 times (525µs+1.80ms) by DBI::db::prepare at line 1298 of /usr/share/koha/lib/C4/Items.pm, avg 73µs/call # 32 times (518µs+1.77ms) by DBI::db::prepare at line 1269 of /usr/share/koha/lib/C4/Items.pm, avg 72µs/call # 32 times (472µs+1.57ms) by DBI::db::prepare at line 1309 of /usr/share/koha/lib/C4/Items.pm, avg 64µs/call # 27 times (560µs+1.65ms) by DBI::db::prepare at line 120 of /usr/share/koha/lib/C4/Branch.pm, avg 82µs/call # 27 times (485µs+1.67ms) by DBI::db::prepare at line 117 of /usr/share/koha/lib/C4/Branch.pm, avg 80µs/call # 26 times (531µs+2.07ms) by DBI::db::prepare at line 253 of /usr/share/koha/lib/C4/Koha.pm, avg 100µs/call # 25 times (651µs+2.40ms) by DBI::db::prepare at line 1240 of /usr/share/koha/lib/C4/Items.pm, avg 122µs/call # 25 times (607µs+1.74ms) by DBI::db::prepare at line 1255 of /usr/share/koha/lib/C4/Biblio.pm, avg 94µs/call # 25 times (721µs+1.42ms) by DBI::db::prepare at line 1234 of /usr/share/koha/lib/C4/Items.pm, avg 86µs/call # 25 times (414µs+1.57ms) by DBI::db::prepare at line 2625 of /usr/share/koha/lib/C4/Biblio.pm, avg 79µs/call # 25 times (430µs+1.54ms) by DBI::db::prepare at line 283 of /usr/share/koha/lib/C4/Tags.pm, avg 79µs/call # 25 times (367µs+1.26ms) by DBI::db::prepare at line 1245 of /usr/share/koha/lib/C4/Items.pm, avg 65µs/call # 3 times (82µs+254µs) by DBI::db::prepare at line 122 of /usr/share/koha/lib/C4/XSLT.pm, avg 112µs/call # 2 times (39µs+132µs) by DBI::db::prepare at line 1069 of /usr/share/koha/lib/C4/Koha.pm, avg 85µs/call # 2 times (35µs+131µs) by DBI::db::prepare at line 365 of /usr/share/koha/lib/C4/Branch.pm, avg 83µs/call # once (24µs+90µs) by DBI::db::prepare at line 1646 of /usr/share/koha/lib/C4/Search.pm # once (27µs+54µs) by DBI::db::prepare at line 1662 of /usr/share/koha/lib/C4/Search.pm # once (18µs+60µs) by DBI::db::prepare at line 1634 of DBI.pm # once (11µs+50µs) by DBI::db::prepare at line 604 of /usr/share/koha/lib/C4/Branch.pm # once (11µs+39µs) by DBI::db::prepare at line 1677 of /usr/share/koha/lib/C4/Search.pm # once (9µs+33µs) by DBI::db::prepare at line 1022 of /usr/share/koha/lib/C4/Context.pm
sub prepare {
218588843.2ms my($dbh, $statement, $attribs)= @_;
219
220 # create a 'blank' dbh
221147277.2ms my $sth = DBI::_new_sth($dbh, {'Statement' => $statement});
# spent 77.2ms making 1472 calls to DBI::_new_sth, avg 52µs/call
222
223 # Populate internal handle data.
224147213.8ms if (!DBD::mysql::st::_prepare($sth, $statement, $attribs)) {
# spent 13.8ms making 1472 calls to DBD::mysql::st::_prepare, avg 9µs/call
225 $sth = undef;
226 }
227
228 $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 ======
738347µs228µs
# spent 22µs (17+5) within DBD::mysql::st::BEGIN@738 which was called: # once (17µs+5µs) by DBI::install_driver at line 738
use strict;
# spent 22µs making 1 call to DBD::mysql::st::BEGIN@738 # spent 5µs making 1 call to strict::import
739
740114µs1;
741
742__END__
 
# spent 214µs (71+143) within DBD::mysql::CORE:match which was called 6 times, avg 36µs/call: # 3 times (52µs+107µs) by DBD::mysql::_OdbcParse at line 49, avg 53µs/call # 3 times (19µs+36µs) by DBD::mysql::_OdbcParse at line 56, avg 18µs/call
sub DBD::mysql::CORE:match; # opcode
# spent 121µs within DBD::mysql::bootstrap which was called: # once (121µs+0s) by DynaLoader::bootstrap at line 215 of DynaLoader.pm
sub DBD::mysql::bootstrap; # xsub
# spent 9.31ms within DBD::mysql::db::_login which was called: # once (9.31ms+0s) by DBD::mysql::dr::connect at line 142
sub DBD::mysql::db::_login; # xsub
# spent 13.8ms within DBD::mysql::st::_prepare which was called 1472 times, avg 9µs/call: # 1472 times (13.8ms+0s) by DBD::mysql::db::prepare at line 224, avg 9µs/call
sub DBD::mysql::st::_prepare; # xsub
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.