← Index
NYTProf Performance Profile   « line view »
For ./move_planets.pl
  Run on Tue Jan 23 21:11:41 2024
Reported on Tue Jan 23 21:12:47 2024

Filename/usr/local/lib/perl5/site_perl/mach/5.36/DBD/mysql.pm
StatementsExecuted 5690 statements in 41.4ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11071118.3ms67.0msDBD::mysql::db::::prepareDBD::mysql::db::prepare
2115.26ms5.26msDBD::mysql::db::::_loginDBD::mysql::db::_login (xsub)
1107114.74ms4.74msDBD::mysql::st::::_prepareDBD::mysql::st::_prepare (xsub)
111339µs4.34msDBD::mysql::dr::::BEGIN@117DBD::mysql::dr::BEGIN@117
11187µs87µsDBD::mysql::::bootstrap DBD::mysql::bootstrap (xsub)
21178µs5.50msDBD::mysql::dr::::connectDBD::mysql::dr::connect
21167µs96µsDBD::mysql::::_OdbcParse DBD::mysql::_OdbcParse
11141µs41µsDBD::mysql::st::::BEGIN@842DBD::mysql::st::BEGIN@842
11138µs208µsDBD::mysql::::driver DBD::mysql::driver
82125µs25µsDBD::mysql::::CORE:match DBD::mysql::CORE:match (opcode)
11118µs18µsDBD::mysql::db::::BEGIN@823DBD::mysql::db::BEGIN@823
11116µs23µsDBD::mysql::db::::BEGIN@827DBD::mysql::db::BEGIN@827
11114µs17µsDBI::_firesafe::::BEGIN@1DBI::_firesafe::BEGIN@1
11113µs38µsDBI::_firesafe::::BEGIN@2DBI::_firesafe::BEGIN@2
11111µs14µsDBD::mysql::dr::::BEGIN@115DBD::mysql::dr::BEGIN@115
11111µs14µsDBD::mysql::db::::BEGIN@199DBD::mysql::db::BEGIN@199
1117µs607µsDBD::mysql::dr::::BEGIN@116DBD::mysql::dr::BEGIN@116
1117µs12µsDBD::mysql::st::::BEGIN@860DBD::mysql::st::BEGIN@860
1117µs498µsDBD::mysql::db::::BEGIN@200DBD::mysql::db::BEGIN@200
1117µs12µsDBD::mysql::st::::BEGIN@847DBD::mysql::st::BEGIN@847
1117µs9µsDBD::mysql::st::::BEGIN@840DBD::mysql::st::BEGIN@840
1116µs15µsDBD::mysql::::BEGIN@7 DBD::mysql::BEGIN@7
1116µs24µsDBD::mysql::::BEGIN@9 DBD::mysql::BEGIN@9
2114µs4µsDBD::mysql::::CORE:subst DBD::mysql::CORE:subst (opcode)
1113µs3µ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::::_SelectDBDBD::mysql::db::_SelectDB
0000s0sDBD::mysql::db::::__ANON__[:834]DBD::mysql::db::__ANON__[:834]
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::::statistics_infoDBD::mysql::db::statistics_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
0000s0sDBD::mysql::st::::__ANON__[:856]DBD::mysql::st::__ANON__[:856]
0000s0sDBD::mysql::st::::__ANON__[:867]DBD::mysql::st::__ANON__[:867]
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1238µs220µs
# spent 17µs (14+3) within DBI::_firesafe::BEGIN@1 which was called: # once (14µs+3µs) by DBI::install_driver at line 1
use strict;
# spent 17µs making 1 call to DBI::_firesafe::BEGIN@1 # spent 3µs making 1 call to strict::import
2271µs264µs
# spent 38µs (13+26) within DBI::_firesafe::BEGIN@2 which was called: # once (13µs+26µs) by DBI::install_driver at line 2
use warnings;
# spent 38µs making 1 call to DBI::_firesafe::BEGIN@2 # spent 26µs making 1 call to warnings::import
3112µsrequire 5.008_001; # just as DBI
4
5package DBD::mysql;
6
7230µs223µs
# spent 15µs (6+8) within DBD::mysql::BEGIN@7 which was called: # once (6µs+8µs) by DBI::install_driver at line 7
use DBI;
# spent 15µs making 1 call to DBD::mysql::BEGIN@7 # spent 8µs making 1 call to Exporter::import
8216µs13µs
# spent 3µs within DBD::mysql::BEGIN@8 which was called: # once (3µs+0s) by DBI::install_driver at line 8
use DynaLoader();
# spent 3µs making 1 call to DBD::mysql::BEGIN@8
92623µs242µs
# spent 24µs (6+18) within DBD::mysql::BEGIN@9 which was called: # once (6µs+18µs) by DBI::install_driver at line 9
use Carp;
# spent 24µs making 1 call to DBD::mysql::BEGIN@9 # spent 18µs making 1 call to Exporter::import
1018µsour @ISA = qw(DynaLoader);
11
12# please make sure the sub-version does not increase above '099'
13# SQL_DRIVER_VER is formatted as dd.dd.dddd
14# for version 5.x please switch to 5.00(_00) version numbering
15# keep $VERSION in Bundle/DBD/mysql.pm in sync
161400nsour $VERSION = '5.003';
17
1817µs14.00msbootstrap DBD::mysql $VERSION;
# spent 4.00ms making 1 call to DynaLoader::bootstrap
19
20
211500nsour $err = 0; # holds error code for DBI::err
221500nsour $errstr = ""; # holds error string for DBI::errstr
231500nsour $drh = undef; # holds driver handle once initialised
24
251400nsmy $methods_are_installed = 0;
26
# spent 208µs (38+170) within DBD::mysql::driver which was called: # once (38µs+170µs) by DBI::install_driver at line 829 of DBI.pm
sub driver{
271600ns return $drh if $drh;
2811µs my($class, $attr) = @_;
29
301900ns $class .= "::dr";
31
32 # not a 'my' since we use it above to prevent multiple drivers
3316µs152µs $drh = DBI::_new_drh($class, { 'Name' => 'mysql',
# spent 52µs making 1 call to DBI::_new_drh
34 'Version' => $VERSION,
35 'Err' => \$DBD::mysql::err,
36 'Errstr' => \$DBD::mysql::errstr,
37 'Attribution' => 'DBD::mysql by Patrick Galbraith'
38 });
39
401800ns if (!$methods_are_installed) {
4116µs147µs DBD::mysql::db->install_method('mysql_fd');
# spent 47µs making 1 call to DBD::_::common::install_method
4212µs121µs DBD::mysql::db->install_method('mysql_async_result');
# spent 21µs making 1 call to DBD::_::common::install_method
4312µs117µs DBD::mysql::db->install_method('mysql_async_ready');
# spent 17µs making 1 call to DBD::_::common::install_method
4413µs117µs DBD::mysql::st->install_method('mysql_async_result');
# spent 17µs making 1 call to DBD::_::common::install_method
4512µs116µs DBD::mysql::st->install_method('mysql_async_ready');
# spent 16µs making 1 call to DBD::_::common::install_method
46
471600ns $methods_are_installed++;
48 }
49
5013µs $drh;
51}
52
53sub CLONE {
54 undef $drh;
55}
56
57
# spent 96µs (67+29) within DBD::mysql::_OdbcParse which was called 2 times, avg 48µs/call: # 2 times (67µs+29µs) by DBD::mysql::dr::connect at line 141, avg 48µs/call
sub _OdbcParse($$$) {
5822µs my($class, $dsn, $hash, $args) = @_;
592600ns my($var, $val);
602900ns if (!defined($dsn)) {
61 return;
62 }
6327µs while (length($dsn)) {
64440µs422µs if ($dsn =~ /([^:;]*\[.*]|[^:;]*)[:;](.*)/) {
# spent 22µs making 4 calls to DBD::mysql::CORE:match, avg 5µs/call
6522µs $val = $1;
6622µs $dsn = $2;
6729µs24µs $val =~ s/\[|]//g; # Remove [] if present, the rest of the code prefers plain IPv6 addresses
# spent 4µs making 2 calls to DBD::mysql::CORE:subst, avg 2µs/call
68 } else {
6921µs $val = $dsn;
7021µs $dsn = '';
71 }
72419µs43µs if ($val =~ /([^=]*)=(.*)/) {
# spent 3µs making 4 calls to DBD::mysql::CORE:match, avg 800ns/call
73 $var = $1;
74 $val = $2;
75 if ($var eq 'hostname' || $var eq 'host') {
76 $hash->{'host'} = $val;
77 } elsif ($var eq 'db' || $var eq 'dbname') {
78 $hash->{'database'} = $val;
79 } else {
80 $hash->{$var} = $val;
81 }
82 } else {
8343µs foreach $var (@$args) {
8465µs if (!defined($hash->{$var})) {
8544µs $hash->{$var} = $val;
8642µs last;
87 }
88 }
89 }
90 }
91}
92
93sub _OdbcParseHost ($$) {
94 my($class, $dsn) = @_;
95 my($hash) = {};
96 $class->_OdbcParse($dsn, $hash, ['host', 'port']);
97 ($hash->{'host'}, $hash->{'port'});
98}
99
100sub AUTOLOAD {
101 my ($meth) = $DBD::mysql::AUTOLOAD;
102 my ($smeth) = $meth;
103 $smeth =~ s/(.*)\:\://;
104
105 my $val = constant($smeth, @_ ? $_[0] : 0);
106 if ($! == 0) { eval "sub $meth { $val }"; return $val; }
107
108 Carp::croak "$meth: Not defined";
109}
110
1111;
112
113
114package DBD::mysql::dr; # ====== DRIVER ======
115239µs217µs
# spent 14µs (11+3) within DBD::mysql::dr::BEGIN@115 which was called: # once (11µs+3µs) by DBI::install_driver at line 115
use strict;
# spent 14µs making 1 call to DBD::mysql::dr::BEGIN@115 # spent 3µs making 1 call to strict::import
1162106µs21.21ms
# spent 607µs (7+600) within DBD::mysql::dr::BEGIN@116 which was called: # once (7µs+600µs) by DBI::install_driver at line 116
use DBI qw(:sql_types);
# spent 607µs making 1 call to DBD::mysql::dr::BEGIN@116 # spent 600µs making 1 call to Exporter::import
1172498µs24.41ms
# spent 4.34ms (339µs+4.01) within DBD::mysql::dr::BEGIN@117 which was called: # once (339µs+4.01ms) by DBI::install_driver at line 117
use DBI::Const::GetInfoType;
# spent 4.34ms making 1 call to DBD::mysql::dr::BEGIN@117 # spent 69µs making 1 call to Exporter::import
118
119
# spent 5.50ms (78µs+5.42) within DBD::mysql::dr::connect which was called 2 times, avg 2.75ms/call: # 2 times (78µs+5.42ms) by DBI::dr::connect at line 679 of DBI.pm, avg 2.75ms/call
sub connect {
12022µs my($drh, $dsn, $username, $password, $attrhash) = @_;
1212800ns my($port);
122 my($cWarn);
12323µs my $connect_ref= { 'Name' => $dsn };
1242800ns my $dbi_imp_data;
125
126 # Avoid warnings for undefined values
1272700ns $username ||= '';
1282500ns $password ||= '';
1292600ns $attrhash ||= {};
13022µs $attrhash->{mysql_conn_attrs} ||= {};
13126µs $attrhash->{mysql_conn_attrs}->{'program_name'} ||= $0;
132
133 # create a 'blank' dbh
13421µs my($this, $privateAttrHash) = (undef, $attrhash);
13527µs $privateAttrHash = { %$privateAttrHash,
136 'Name' => $dsn,
137 'user' => $username,
138 'password' => $password
139 };
140
14127µs296µs DBD::mysql->_OdbcParse($dsn, $privateAttrHash,
# spent 96µs making 2 calls to DBD::mysql::_OdbcParse, avg 48µs/call
142 ['database', 'host', 'port']);
143
144
14521µs $dbi_imp_data = delete $attrhash->{dbi_imp_data};
14621µs $connect_ref->{'dbi_imp_data'} = $dbi_imp_data;
147
14825µs266µs if (!defined($this = DBI::_new_dbh($drh,
# spent 66µs making 2 calls to DBI::_new_dbh, avg 33µs/call
149 $connect_ref,
150 $privateAttrHash)))
151 {
152 return undef;
153 }
154
15525.28ms25.26ms DBD::mysql::db::_login($this, $dsn, $username, $password)
# spent 5.26ms making 2 calls to DBD::mysql::db::_login, avg 2.63ms/call
156 or $this = undef;
157
15829µs if ($this && ($ENV{MOD_PERL} || $ENV{GATEWAY_INTERFACE})) {
159 $this->{mysql_auto_reconnect} = 1;
160 }
161212µs $this;
162}
163
164sub data_sources {
165 my($self) = shift;
166 my($attributes) = shift;
167 my($host, $port, $user, $password) = ('', '', '', '');
168 if ($attributes) {
169 $host = $attributes->{host} || '';
170 $port = $attributes->{port} || '';
171 $user = $attributes->{user} || '';
172 $password = $attributes->{password} || '';
173 }
174 my(@dsn) = $self->func($host, $port, $user, $password, '_ListDBs');
175 my($i);
176 for ($i = 0; $i < @dsn; $i++) {
177 $dsn[$i] = "DBI:mysql:$dsn[$i]";
178 }
179 @dsn;
180}
181
182sub admin {
183 my($drh) = shift;
184 my($command) = shift;
185 my($dbname) = ($command eq 'createdb' || $command eq 'dropdb') ?
186 shift : '';
187 my($host, $port) = DBD::mysql->_OdbcParseHost(shift(@_) || '');
188 my($user) = shift || '';
189 my($password) = shift || '';
190
191 $drh->func(undef, $command,
192 $dbname || '',
193 $host || '',
194 $port || '',
195 $user, $password, '_admin_internal');
196}
197
198package DBD::mysql::db; # ====== DATABASE ======
199232µs217µs
# spent 14µs (11+3) within DBD::mysql::db::BEGIN@199 which was called: # once (11µs+3µs) by DBI::install_driver at line 199
use strict;
# spent 14µs making 1 call to DBD::mysql::db::BEGIN@199 # spent 3µs making 1 call to strict::import
20022.47ms2989µs
# spent 498µs (7+491) within DBD::mysql::db::BEGIN@200 which was called: # once (7µs+491µs) by DBI::install_driver at line 200
use DBI qw(:sql_types);
# spent 498µs making 1 call to DBD::mysql::db::BEGIN@200 # spent 491µs making 1 call to Exporter::import
201
20213µs%DBD::mysql::db::db2ANSI = (
203 "INT" => "INTEGER",
204 "CHAR" => "CHAR",
205 "REAL" => "REAL",
206 "IDENT" => "DECIMAL"
207);
208
209### ANSI datatype mapping to MySQL datatypes
21016µs%DBD::mysql::db::ANSI2db = (
211 "CHAR" => "CHAR",
212 "VARCHAR" => "CHAR",
213 "LONGVARCHAR" => "CHAR",
214 "NUMERIC" => "INTEGER",
215 "DECIMAL" => "INTEGER",
216 "BIT" => "INTEGER",
217 "TINYINT" => "INTEGER",
218 "SMALLINT" => "INTEGER",
219 "INTEGER" => "INTEGER",
220 "BIGINT" => "INTEGER",
221 "REAL" => "REAL",
222 "FLOAT" => "REAL",
223 "DOUBLE" => "REAL",
224 "BINARY" => "CHAR",
225 "VARBINARY" => "CHAR",
226 "LONGVARBINARY" => "CHAR",
227 "DATE" => "CHAR",
228 "TIME" => "CHAR",
229 "TIMESTAMP" => "CHAR"
230);
231
232
# spent 67.0ms (18.3+48.7) within DBD::mysql::db::prepare which was called 1107 times, avg 61µs/call: # 1107 times (18.3ms+48.7ms) by DBI::db::prepare at line 21 of /aoa_test/cron/db/mysql.pl, avg 61µs/call
sub prepare {
23311071.06ms my($dbh, $statement, $attribs)= @_;
234
23511076.28ms11072.70ms return unless $dbh->func('_async_check');
# spent 2.70ms making 1107 calls to DBI::common::func, avg 2µs/call
236
237 # create a 'blank' dbh
23811074.42ms110741.3ms my $sth = DBI::_new_sth($dbh, {'Statement' => $statement});
# spent 41.3ms making 1107 calls to DBI::_new_sth, avg 37µs/call
239
240 # Populate internal handle data.
241110712.0ms11074.74ms if (!DBD::mysql::st::_prepare($sth, $statement, $attribs)) {
# spent 4.74ms making 1107 calls to DBD::mysql::st::_prepare, avg 4µs/call
242 $sth = undef;
243 }
244
24511077.71ms $sth;
246}
247
248sub db2ANSI {
249 my $self = shift;
250 my $type = shift;
251 return $DBD::mysql::db::db2ANSI{"$type"};
252}
253
254sub ANSI2db {
255 my $self = shift;
256 my $type = shift;
257 return $DBD::mysql::db::ANSI2db{"$type"};
258}
259
260sub admin {
261 my($dbh) = shift;
262 my($command) = shift;
263 my($dbname) = ($command eq 'createdb' || $command eq 'dropdb') ?
264 shift : '';
265 $dbh->{'Driver'}->func($dbh, $command, $dbname, '', '', '',
266 '_admin_internal');
267}
268
269sub _SelectDB ($$) {
270 die "_SelectDB is removed from this module; use DBI->connect instead.";
271}
272
273sub table_info ($) {
274 my ($dbh, $catalog, $schema, $table, $type, $attr) = @_;
275 $dbh->{mysql_server_prepare}||= 0;
276 my $mysql_server_prepare_save= $dbh->{mysql_server_prepare};
277 $dbh->{mysql_server_prepare}= 0;
278 my @names = qw(TABLE_CAT TABLE_SCHEM TABLE_NAME TABLE_TYPE REMARKS);
279 my @rows;
280
281 my $sponge = DBI->connect("DBI:Sponge:", '','')
282 or return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr");
283
284# Return the list of catalogs
285 if (defined $catalog && $catalog eq "%" &&
286 (!defined($schema) || $schema eq "") &&
287 (!defined($table) || $table eq ""))
288 {
289 @rows = (); # Empty, because MySQL doesn't support catalogs (yet)
290 }
291 # Return the list of schemas
292 elsif (defined $schema && $schema eq "%" &&
293 (!defined($catalog) || $catalog eq "") &&
294 (!defined($table) || $table eq ""))
295 {
296 my $sth = $dbh->prepare("SHOW DATABASES")
297 or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
298 return undef);
299
300 $sth->execute()
301 or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
302 return DBI::set_err($dbh, $sth->err(), $sth->errstr()));
303
304 while (my $ref = $sth->fetchrow_arrayref())
305 {
306 push(@rows, [ undef, $ref->[0], undef, undef, undef ]);
307 }
308 }
309 # Return the list of table types
310 elsif (defined $type && $type eq "%" &&
311 (!defined($catalog) || $catalog eq "") &&
312 (!defined($schema) || $schema eq "") &&
313 (!defined($table) || $table eq ""))
314 {
315 @rows = (
316 [ undef, undef, undef, "TABLE", undef ],
317 [ undef, undef, undef, "VIEW", undef ],
318 );
319 }
320 # Special case: a catalog other than undef, "", or "%"
321 elsif (defined $catalog && $catalog ne "" && $catalog ne "%")
322 {
323 @rows = (); # Nothing, because MySQL doesn't support catalogs yet.
324 }
325 # Uh oh, we actually have a meaty table_info call. Work is required!
326 else
327 {
328 my @schemas;
329 # If no table was specified, we want them all
330 $table ||= "%";
331
332 # If something was given for the schema, we need to expand it to
333 # a list of schemas, since it may be a wildcard.
334 if (defined $schema && $schema ne "")
335 {
336 my $sth = $dbh->prepare("SHOW DATABASES LIKE " .
337 $dbh->quote($schema))
338 or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
339 return undef);
340 $sth->execute()
341 or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
342 return DBI::set_err($dbh, $sth->err(), $sth->errstr()));
343
344 while (my $ref = $sth->fetchrow_arrayref())
345 {
346 push @schemas, $ref->[0];
347 }
348 }
349 # Otherwise we want the current database
350 else
351 {
352 push @schemas, $dbh->selectrow_array("SELECT DATABASE()");
353 }
354
355 # Figure out which table types are desired
356 my ($want_tables, $want_views);
357 if (defined $type && $type ne "")
358 {
359 $want_tables = ($type =~ m/table/i);
360 $want_views = ($type =~ m/view/i);
361 }
362 else
363 {
364 $want_tables = $want_views = 1;
365 }
366
367 for my $database (@schemas)
368 {
369 my $sth = $dbh->prepare("SHOW /*!50002 FULL*/ TABLES FROM " .
370 $dbh->quote_identifier($database) .
371 " LIKE " . $dbh->quote($table))
372 or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
373 return undef);
374
375 $sth->execute() or
376 ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
377 return DBI::set_err($dbh, $sth->err(), $sth->errstr()));
378
379 while (my $ref = $sth->fetchrow_arrayref())
380 {
381 my $type = (defined $ref->[1] &&
382 $ref->[1] =~ /view/i) ? 'VIEW' : 'TABLE';
383 next if $type eq 'TABLE' && not $want_tables;
384 next if $type eq 'VIEW' && not $want_views;
385 push @rows, [ undef, $database, $ref->[0], $type, undef ];
386 }
387 }
388 }
389
390 my $sth = $sponge->prepare("table_info",
391 {
392 rows => \@rows,
393 NUM_OF_FIELDS => scalar @names,
394 NAME => \@names,
395 })
396 or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
397 return $dbh->DBI::set_err($sponge->err(), $sponge->errstr()));
398
399 $dbh->{mysql_server_prepare}= $mysql_server_prepare_save;
400 return $sth;
401}
402
403sub column_info {
404 my ($dbh, $catalog, $schema, $table, $column) = @_;
405
406 return unless $dbh->func('_async_check');
407
408 $dbh->{mysql_server_prepare}||= 0;
409 my $mysql_server_prepare_save= $dbh->{mysql_server_prepare};
410 $dbh->{mysql_server_prepare}= 0;
411
412 # ODBC allows a NULL to mean all columns, so we'll accept undef
413 $column = '%' unless defined $column;
414
415 my $ER_NO_SUCH_TABLE= 1146;
416
417 my $table_id = $dbh->quote_identifier($catalog, $schema, $table);
418
419 my @names = qw(
420 TABLE_CAT TABLE_SCHEM TABLE_NAME COLUMN_NAME
421 DATA_TYPE TYPE_NAME COLUMN_SIZE BUFFER_LENGTH DECIMAL_DIGITS
422 NUM_PREC_RADIX NULLABLE REMARKS COLUMN_DEF
423 SQL_DATA_TYPE SQL_DATETIME_SUB CHAR_OCTET_LENGTH
424 ORDINAL_POSITION IS_NULLABLE CHAR_SET_CAT
425 CHAR_SET_SCHEM CHAR_SET_NAME COLLATION_CAT COLLATION_SCHEM COLLATION_NAME
426 UDT_CAT UDT_SCHEM UDT_NAME DOMAIN_CAT DOMAIN_SCHEM DOMAIN_NAME
427 SCOPE_CAT SCOPE_SCHEM SCOPE_NAME MAX_CARDINALITY
428 DTD_IDENTIFIER IS_SELF_REF
429 mysql_is_pri_key mysql_type_name mysql_values
430 mysql_is_auto_increment
431 );
432 my %col_info;
433
434 local $dbh->{FetchHashKeyName} = 'NAME_lc';
435 # only ignore ER_NO_SUCH_TABLE in internal_execute if issued from here
436 my $desc_sth = $dbh->prepare("DESCRIBE $table_id " . $dbh->quote($column));
437 my $desc = $dbh->selectall_arrayref($desc_sth, { Columns=>{} });
438
439 #return $desc_sth if $desc_sth->err();
440 if (my $err = $desc_sth->err())
441 {
442 # return the error, unless it is due to the table not
443 # existing per DBI spec
444 if ($err != $ER_NO_SUCH_TABLE)
445 {
446 $dbh->{mysql_server_prepare}= $mysql_server_prepare_save;
447 return undef;
448 }
449 $dbh->set_err(undef,undef);
450 $desc = [];
451 }
452
453 my $ordinal_pos = 0;
454 my @fields;
455 for my $row (@$desc)
456 {
457 my $type = $row->{type};
458 $type =~ m/^(\w+)(\((.+)\))?\s?(.*)?$/;
459 my $basetype = lc($1);
460 my $typemod = $3;
461 my $attr = $4;
462
463 push @fields, $row->{field};
464 my $info = $col_info{ $row->{field} }= {
465 TABLE_CAT => $catalog,
466 TABLE_SCHEM => $schema,
467 TABLE_NAME => $table,
468 COLUMN_NAME => $row->{field},
469 NULLABLE => ($row->{null} eq 'YES') ? 1 : 0,
470 IS_NULLABLE => ($row->{null} eq 'YES') ? "YES" : "NO",
471 TYPE_NAME => uc($basetype),
472 COLUMN_DEF => $row->{default},
473 ORDINAL_POSITION => ++$ordinal_pos,
474 mysql_is_pri_key => ($row->{key} eq 'PRI'),
475 mysql_type_name => $row->{type},
476 mysql_is_auto_increment => ($row->{extra} =~ /auto_increment/i ? 1 : 0),
477 };
478 #
479 # This code won't deal with a pathological case where a value
480 # contains a single quote followed by a comma, and doesn't unescape
481 # any escaped values. But who would use those in an enum or set?
482 #
483 my @type_params= ($typemod && index($typemod,"'")>=0) ?
484 ("$typemod," =~ /'(.*?)',/g) # assume all are quoted
485 : split /,/, $typemod||''; # no quotes, plain list
486 s/''/'/g for @type_params; # undo doubling of quotes
487
488 my @type_attr= split / /, $attr||'';
489
490 $info->{DATA_TYPE}= SQL_VARCHAR();
491 if ($basetype =~ /^(char|varchar|\w*text|\w*blob)/)
492 {
493 $info->{DATA_TYPE}= SQL_CHAR() if $basetype eq 'char';
494 if ($type_params[0])
495 {
496 $info->{COLUMN_SIZE} = $type_params[0];
497 }
498 else
499 {
500 $info->{COLUMN_SIZE} = 65535;
501 $info->{COLUMN_SIZE} = 255 if $basetype =~ /^tiny/;
502 $info->{COLUMN_SIZE} = 16777215 if $basetype =~ /^medium/;
503 $info->{COLUMN_SIZE} = 4294967295 if $basetype =~ /^long/;
504 }
505 }
506 elsif ($basetype =~ /^(binary|varbinary)/)
507 {
508 $info->{COLUMN_SIZE} = $type_params[0];
509 # SQL_BINARY & SQL_VARBINARY are tempting here but don't match the
510 # semantics for mysql (not hex). SQL_CHAR & SQL_VARCHAR are correct here.
511 $info->{DATA_TYPE} = ($basetype eq 'binary') ? SQL_CHAR() : SQL_VARCHAR();
512 }
513 elsif ($basetype =~ /^(enum|set)/)
514 {
515 if ($basetype eq 'set')
516 {
517 $info->{COLUMN_SIZE} = length(join ",", @type_params);
518 }
519 else
520 {
521 my $max_len = 0;
522 length($_) > $max_len and $max_len = length($_) for @type_params;
523 $info->{COLUMN_SIZE} = $max_len;
524 }
525 $info->{"mysql_values"} = \@type_params;
526 }
527 elsif ($basetype =~ /int/ || $basetype eq 'bit' )
528 {
529 # big/medium/small/tiny etc + unsigned?
530 $info->{DATA_TYPE} = SQL_INTEGER();
531 $info->{NUM_PREC_RADIX} = 10;
532 $info->{COLUMN_SIZE} = $type_params[0];
533 }
534 elsif ($basetype =~ /^decimal/)
535 {
536 $info->{DATA_TYPE} = SQL_DECIMAL();
537 $info->{NUM_PREC_RADIX} = 10;
538 $info->{COLUMN_SIZE} = $type_params[0];
539 $info->{DECIMAL_DIGITS} = $type_params[1];
540 }
541 elsif ($basetype =~ /^(float|double)/)
542 {
543 $info->{DATA_TYPE} = ($basetype eq 'float') ? SQL_FLOAT() : SQL_DOUBLE();
544 $info->{NUM_PREC_RADIX} = 2;
545 $info->{COLUMN_SIZE} = ($basetype eq 'float') ? 32 : 64;
546 }
547 elsif ($basetype =~ /date|time/)
548 {
549 # date/datetime/time/timestamp
550 if ($basetype eq 'time' or $basetype eq 'date')
551 {
552 #$info->{DATA_TYPE} = ($basetype eq 'time') ? SQL_TYPE_TIME() : SQL_TYPE_DATE();
553 $info->{DATA_TYPE} = ($basetype eq 'time') ? SQL_TIME() : SQL_DATE();
554 $info->{COLUMN_SIZE} = ($basetype eq 'time') ? 8 : 10;
555 }
556 else
557 {
558 # datetime/timestamp
559 #$info->{DATA_TYPE} = SQL_TYPE_TIMESTAMP();
560 $info->{DATA_TYPE} = SQL_TIMESTAMP();
561 $info->{SQL_DATA_TYPE} = SQL_DATETIME();
562 $info->{SQL_DATETIME_SUB} = $info->{DATA_TYPE} - ($info->{SQL_DATA_TYPE} * 10);
563 $info->{COLUMN_SIZE} = ($basetype eq 'datetime') ? 19 : $type_params[0] || 14;
564 }
565 $info->{DECIMAL_DIGITS}= 0; # no fractional seconds
566 }
567 elsif ($basetype eq 'year')
568 {
569 # no close standard so treat as int
570 $info->{DATA_TYPE} = SQL_INTEGER();
571 $info->{NUM_PREC_RADIX} = 10;
572 $info->{COLUMN_SIZE} = 4;
573 }
574 else
575 {
576 Carp::carp("column_info: unrecognized column type '$basetype' of $table_id.$row->{field} treated as varchar");
577 }
578 $info->{SQL_DATA_TYPE} ||= $info->{DATA_TYPE};
579 #warn Dumper($info);
580 }
581
582 my $sponge = DBI->connect("DBI:Sponge:", '','')
583 or ( $dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
584 return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr"));
585
586 my $sth = $sponge->prepare("column_info $table", {
587 rows => [ map { [ @{$_}{@names} ] } map { $col_info{$_} } @fields ],
588 NUM_OF_FIELDS => scalar @names,
589 NAME => \@names,
590 }) or
591 return ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
592 $dbh->DBI::set_err($sponge->err(), $sponge->errstr()));
593
594 $dbh->{mysql_server_prepare}= $mysql_server_prepare_save;
595 return $sth;
596}
597
598
599sub primary_key_info {
600 my ($dbh, $catalog, $schema, $table) = @_;
601
602 return unless $dbh->func('_async_check');
603
604 $dbh->{mysql_server_prepare}||= 0;
605 my $mysql_server_prepare_save= $dbh->{mysql_server_prepare};
606
607 my $table_id = $dbh->quote_identifier($catalog, $schema, $table);
608
609 my @names = qw(
610 TABLE_CAT TABLE_SCHEM TABLE_NAME COLUMN_NAME KEY_SEQ PK_NAME
611 );
612 my %col_info;
613
614 local $dbh->{FetchHashKeyName} = 'NAME_lc';
615 my $desc_sth = $dbh->prepare("SHOW KEYS FROM $table_id");
616 my $desc= $dbh->selectall_arrayref($desc_sth, { Columns=>{} });
617 my $ordinal_pos = 0;
618 for my $row (grep { $_->{key_name} eq 'PRIMARY'} @$desc)
619 {
620 $col_info{ $row->{column_name} }= {
621 TABLE_CAT => $catalog,
622 TABLE_SCHEM => $schema,
623 TABLE_NAME => $table,
624 COLUMN_NAME => $row->{column_name},
625 KEY_SEQ => $row->{seq_in_index},
626 PK_NAME => $row->{key_name},
627 };
628 }
629
630 my $sponge = DBI->connect("DBI:Sponge:", '','')
631 or
632 ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
633 return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr"));
634
635 my $sth= $sponge->prepare("primary_key_info $table", {
636 rows => [
637 map { [ @{$_}{@names} ] }
638 sort { $a->{KEY_SEQ} <=> $b->{KEY_SEQ} }
639 values %col_info
640 ],
641 NUM_OF_FIELDS => scalar @names,
642 NAME => \@names,
643 }) or
644 ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
645 return $dbh->DBI::set_err($sponge->err(), $sponge->errstr()));
646
647 $dbh->{mysql_server_prepare}= $mysql_server_prepare_save;
648
649 return $sth;
650}
651
652
653sub foreign_key_info {
654 my ($dbh,
655 $pk_catalog, $pk_schema, $pk_table,
656 $fk_catalog, $fk_schema, $fk_table,
657 ) = @_;
658
659 return unless $dbh->func('_async_check');
660
661 # INFORMATION_SCHEMA.KEY_COLUMN_USAGE was added in 5.0.6
662 # no one is going to be running 5.0.6, taking out the check for $point > .6
663 my ($maj, $min, $point) = _version($dbh);
664 return if $maj < 5 ;
665
666 my $sql = <<'EOF';
667SELECT NULL AS PKTABLE_CAT,
668 A.REFERENCED_TABLE_SCHEMA AS PKTABLE_SCHEM,
669 A.REFERENCED_TABLE_NAME AS PKTABLE_NAME,
670 A.REFERENCED_COLUMN_NAME AS PKCOLUMN_NAME,
671 A.TABLE_CATALOG AS FKTABLE_CAT,
672 A.TABLE_SCHEMA AS FKTABLE_SCHEM,
673 A.TABLE_NAME AS FKTABLE_NAME,
674 A.COLUMN_NAME AS FKCOLUMN_NAME,
675 A.ORDINAL_POSITION AS KEY_SEQ,
676 NULL AS UPDATE_RULE,
677 NULL AS DELETE_RULE,
678 A.CONSTRAINT_NAME AS FK_NAME,
679 NULL AS PK_NAME,
680 NULL AS DEFERABILITY,
681 NULL AS UNIQUE_OR_PRIMARY
682 FROM INFORMATION_SCHEMA.KEY_COLUMN_USAGE A,
683 INFORMATION_SCHEMA.TABLE_CONSTRAINTS B
684 WHERE A.TABLE_SCHEMA = B.TABLE_SCHEMA AND A.TABLE_NAME = B.TABLE_NAME
685 AND A.CONSTRAINT_NAME = B.CONSTRAINT_NAME AND B.CONSTRAINT_TYPE IS NOT NULL
686EOF
687
688 my @where;
689 my @bind;
690
691 # catalogs are not yet supported by MySQL
692
693# if (defined $pk_catalog) {
694# push @where, 'A.REFERENCED_TABLE_CATALOG = ?';
695# push @bind, $pk_catalog;
696# }
697
698 if (defined $pk_schema) {
699 push @where, 'A.REFERENCED_TABLE_SCHEMA = ?';
700 push @bind, $pk_schema;
701 }
702
703 if (defined $pk_table) {
704 push @where, 'A.REFERENCED_TABLE_NAME = ?';
705 push @bind, $pk_table;
706 }
707
708# if (defined $fk_catalog) {
709# push @where, 'A.TABLE_CATALOG = ?';
710# push @bind, $fk_schema;
711# }
712
713 if (defined $fk_schema) {
714 push @where, 'A.TABLE_SCHEMA = ?';
715 push @bind, $fk_schema;
716 }
717
718 if (defined $fk_table) {
719 push @where, 'A.TABLE_NAME = ?';
720 push @bind, $fk_table;
721 }
722
723 if (@where) {
724 $sql .= ' AND ';
725 $sql .= join ' AND ', @where;
726 }
727 $sql .= " ORDER BY A.TABLE_SCHEMA, A.TABLE_NAME, A.ORDINAL_POSITION";
728
729 local $dbh->{FetchHashKeyName} = 'NAME_uc';
730 my $sth = $dbh->prepare($sql);
731 $sth->execute(@bind);
732
733 return $sth;
734}
735# #86030: PATCH: adding statistics_info support
736# Thank you to David Dick http://search.cpan.org/~ddick/
737sub statistics_info {
738 my ($dbh,
739 $catalog, $schema, $table,
740 $unique_only, $quick,
741 ) = @_;
742
743 return unless $dbh->func('_async_check');
744
745 # INFORMATION_SCHEMA.KEY_COLUMN_USAGE was added in 5.0.6
746 # no one is going to be running 5.0.6, taking out the check for $point > .6
747 my ($maj, $min, $point) = _version($dbh);
748 return if $maj < 5 ;
749
750 my $sql = <<'EOF';
751SELECT TABLE_CATALOG AS TABLE_CAT,
752 TABLE_SCHEMA AS TABLE_SCHEM,
753 TABLE_NAME AS TABLE_NAME,
754 NON_UNIQUE AS NON_UNIQUE,
755 NULL AS INDEX_QUALIFIER,
756 INDEX_NAME AS INDEX_NAME,
757 LCASE(INDEX_TYPE) AS TYPE,
758 SEQ_IN_INDEX AS ORDINAL_POSITION,
759 COLUMN_NAME AS COLUMN_NAME,
760 COLLATION AS ASC_OR_DESC,
761 CARDINALITY AS CARDINALITY,
762 NULL AS PAGES,
763 NULL AS FILTER_CONDITION
764 FROM INFORMATION_SCHEMA.STATISTICS
765EOF
766
767 my @where;
768 my @bind;
769
770 # catalogs are not yet supported by MySQL
771
772# if (defined $catalog) {
773# push @where, 'TABLE_CATALOG = ?';
774# push @bind, $catalog;
775# }
776
777 if (defined $schema) {
778 push @where, 'TABLE_SCHEMA = ?';
779 push @bind, $schema;
780 }
781
782 if (defined $table) {
783 push @where, 'TABLE_NAME = ?';
784 push @bind, $table;
785 }
786
787 if (@where) {
788 $sql .= ' WHERE ';
789 $sql .= join ' AND ', @where;
790 }
791 $sql .= " ORDER BY TABLE_SCHEMA, TABLE_NAME, ORDINAL_POSITION";
792
793 local $dbh->{FetchHashKeyName} = 'NAME_uc';
794 my $sth = $dbh->prepare($sql);
795 $sth->execute(@bind);
796
797 return $sth;
798}
799
800sub _version {
801 my $dbh = shift;
802
803 return
804 $dbh->get_info($DBI::Const::GetInfoType::GetInfoType{SQL_DBMS_VER})
805 =~ /(\d+)\.(\d+)\.(\d+)/;
806}
807
808
809####################
810# get_info()
811# Generated by DBI::DBD::Metadata
812
813sub get_info {
814 my($dbh, $info_type) = @_;
815
816 return unless $dbh->func('_async_check');
817 require DBD::mysql::GetInfo;
818 my $v = $DBD::mysql::GetInfo::info{int($info_type)};
819 $v = $v->($dbh) if ref $v eq 'CODE';
820 return $v;
821}
822
823
# spent 18µs within DBD::mysql::db::BEGIN@823 which was called: # once (18µs+0s) by DBI::install_driver at line 836
BEGIN {
82412µs my @needs_async_check = qw/data_sources quote_identifier begin_work/;
825
826111µs foreach my $method (@needs_async_check) {
8272121µs231µs
# spent 23µs (16+8) within DBD::mysql::db::BEGIN@827 which was called: # once (16µs+8µs) by DBI::install_driver at line 827
no strict 'refs';
# spent 23µs making 1 call to DBD::mysql::db::BEGIN@827 # spent 8µs making 1 call to strict::unimport
828
82932µs my $super = "SUPER::$method";
830 *$method = sub {
831 my $h = shift;
832 return unless $h->func('_async_check');
833 return $h->$super(@_);
834310µs };
835 }
836124µs118µs}
# spent 18µs making 1 call to DBD::mysql::db::BEGIN@823
837
838
839package DBD::mysql::st; # ====== STATEMENT ======
840251µs212µs
# spent 9µs (7+2) within DBD::mysql::st::BEGIN@840 which was called: # once (7µs+2µs) by DBI::install_driver at line 840
use strict;
# spent 9µs making 1 call to DBD::mysql::st::BEGIN@840 # spent 2µs making 1 call to strict::import
841
842
# spent 41µs within DBD::mysql::st::BEGIN@842 which was called: # once (41µs+0s) by DBI::install_driver at line 869
BEGIN {
84311µs my @needs_async_result = qw/fetchrow_hashref fetchall_hashref/;
84411µs my @needs_async_check = qw/bind_param_array bind_col bind_columns execute_for_fetch/;
845
8461700ns foreach my $method (@needs_async_result) {
8472118µs217µs
# spent 12µs (7+5) within DBD::mysql::st::BEGIN@847 which was called: # once (7µs+5µs) by DBI::install_driver at line 847
no strict 'refs';
# spent 12µs making 1 call to DBD::mysql::st::BEGIN@847 # spent 5µs making 1 call to strict::unimport
848
84922µs my $super = "SUPER::$method";
850 *$method = sub {
851 my $sth = shift;
852 if(defined $sth->mysql_async_ready) {
853 return unless $sth->mysql_async_result;
854 }
855 return $sth->$super(@_);
856217µs };
857 }
858
85915µs foreach my $method (@needs_async_check) {
8602116µs217µs
# spent 12µs (7+5) within DBD::mysql::st::BEGIN@860 which was called: # once (7µs+5µs) by DBI::install_driver at line 860
no strict 'refs';
# spent 12µs making 1 call to DBD::mysql::st::BEGIN@860 # spent 5µs making 1 call to strict::unimport
861
86242µs my $super = "SUPER::$method";
863 *$method = sub {
864 my $h = shift;
865 return unless $h->func('_async_check');
866 return $h->$super(@_);
867412µs };
868 }
869139µs141µs}
# spent 41µs making 1 call to DBD::mysql::st::BEGIN@842
870
87119µs1;
872
873__END__
 
# spent 25µs within DBD::mysql::CORE:match which was called 8 times, avg 3µs/call: # 4 times (22µs+0s) by DBD::mysql::_OdbcParse at line 64, avg 5µs/call # 4 times (3µs+0s) by DBD::mysql::_OdbcParse at line 72, avg 800ns/call
sub DBD::mysql::CORE:match; # opcode
# spent 4µs within DBD::mysql::CORE:subst which was called 2 times, avg 2µs/call: # 2 times (4µs+0s) by DBD::mysql::_OdbcParse at line 67, avg 2µs/call
sub DBD::mysql::CORE:subst; # opcode
# spent 87µs within DBD::mysql::bootstrap which was called: # once (87µs+0s) by DynaLoader::bootstrap at line 223 of DynaLoader.pm
sub DBD::mysql::bootstrap; # xsub
# spent 5.26ms within DBD::mysql::db::_login which was called 2 times, avg 2.63ms/call: # 2 times (5.26ms+0s) by DBD::mysql::dr::connect at line 155, avg 2.63ms/call
sub DBD::mysql::db::_login; # xsub
# spent 4.74ms within DBD::mysql::st::_prepare which was called 1107 times, avg 4µs/call: # 1107 times (4.74ms+0s) by DBD::mysql::db::prepare at line 241, avg 4µs/call
sub DBD::mysql::st::_prepare; # xsub
Report produced by the NYTProf 6.14 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.