← Index
NYTProf Performance Profile   « line view »
For starman worker -M FindBin --max-requests 50 --workers 2 --user=kohadev-koha --group kohadev-koha --pid /var/run/koha/kohadev/plack.pid --daemonize --access-log /var/log/koha/kohadev/plack.log --error-log /var/log/koha/kohadev/plack-error.log -E deployment --socket /var/run/koha/kohadev/plack.sock /etc/koha/sites/kohadev/plack.psgi
  Run on Fri Jan 8 14:31:06 2016
Reported on Fri Jan 8 14:33:30 2016

Filename/usr/lib/x86_64-linux-gnu/perl5/5.20/DBD/mysql.pm
StatementsExecuted 1912 statements in 11.2ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1161649.04ms28.4msDBD::mysql::st::::__ANON__[:799]DBD::mysql::st::__ANON__[:799]
345326.84ms15.7msDBD::mysql::st::::__ANON__[:810]DBD::mysql::st::__ANON__[:810]
6441396.25ms18.8msDBD::mysql::db::::prepareDBD::mysql::db::prepare
1111.48ms1.48msDBD::mysql::db::::_loginDBD::mysql::db::_login (xsub)
644111.37ms1.37msDBD::mysql::st::::_prepareDBD::mysql::st::_prepare (xsub)
1111.02ms1.11msDBD::mysql::db::::get_infoDBD::mysql::db::get_info
111545µs5.25msDBD::mysql::dr::::BEGIN@113DBD::mysql::dr::BEGIN@113
11162µs1.62msDBD::mysql::dr::::connectDBD::mysql::dr::connect
11137µs55µsDBD::mysql::::_OdbcParse DBD::mysql::_OdbcParse
11129µs29µsDBD::mysql::st::::BEGIN@785DBD::mysql::st::BEGIN@785
11126µs26µsDBD::mysql::db::::BEGIN@766DBD::mysql::db::BEGIN@766
11119µs30µsDBI::_firesafe::::BEGIN@3DBI::_firesafe::BEGIN@3
62118µs18µsDBD::mysql::::CORE:match DBD::mysql::CORE:match (opcode)
11114µs26µsDBD::mysql::db::::BEGIN@770DBD::mysql::db::BEGIN@770
11113µs40µsDBD::mysql::::BEGIN@9 DBD::mysql::BEGIN@9
11113µs26µsDBD::mysql::db::::BEGIN@196DBD::mysql::db::BEGIN@196
11111µs251µsDBD::mysql::db::::BEGIN@197DBD::mysql::db::BEGIN@197
11111µs295µsDBD::mysql::dr::::BEGIN@112DBD::mysql::dr::BEGIN@112
11110µs18µsDBD::mysql::dr::::BEGIN@111DBD::mysql::dr::BEGIN@111
11110µs14µsDBD::mysql::st::::BEGIN@803DBD::mysql::st::BEGIN@803
11110µs19µsDBI::_firesafe::::BEGIN@4DBI::_firesafe::BEGIN@4
11110µs17µsDBD::mysql::st::::BEGIN@783DBD::mysql::st::BEGIN@783
1119µs39µsDBD::mysql::::BEGIN@11 DBD::mysql::BEGIN@11
1117µs12µsDBD::mysql::st::::BEGIN@790DBD::mysql::st::BEGIN@790
1114µs4µsDBD::mysql::::BEGIN@10 DBD::mysql::BEGIN@10
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::::__ANON__[:777]DBD::mysql::db::__ANON__[:777]
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::::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
0000s0sDBD::mysql::::driver DBD::mysql::driver
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1#!/usr/bin/perl
2
3241µs
# spent 30µs (19+11) within DBI::_firesafe::BEGIN@3 which was called: # once (19µs+11µs) by DBI::connect at line 3
use strict;
# spent 30µs making 1 call to DBI::_firesafe::BEGIN@3 # spent 11µs making 1 call to strict::import
4228µs
# spent 19µs (10+9) within DBI::_firesafe::BEGIN@4 which was called: # once (10µs+9µs) by DBI::connect at line 4
use warnings;
# spent 19µs making 1 call to DBI::_firesafe::BEGIN@4 # spent 9µs making 1 call to warnings::import
5require 5.008_001; # just as DBI
6
7package DBD::mysql;
8
9267µs
# spent 40µs (13+27) within DBD::mysql::BEGIN@9 which was called: # once (13µs+27µs) by DBI::connect at line 9
use DBI;
# spent 40µs making 1 call to DBD::mysql::BEGIN@9 # spent 27µs making 1 call to Exporter::import
1014µs
# spent 4µs within DBD::mysql::BEGIN@10 which was called: # once (4µs+0s) by DBI::connect at line 10
use DynaLoader();
# spent 4µs making 1 call to DBD::mysql::BEGIN@10
11268µs
# spent 39µs (9+30) within DBD::mysql::BEGIN@11 which was called: # once (9µs+30µs) by DBI::connect at line 11
use Carp;
# spent 39µs making 1 call to DBD::mysql::BEGIN@11 # spent 30µs making 1 call to Exporter::import
12our @ISA = qw(DynaLoader);
13our $VERSION = '4.028';
14
1511.44msbootstrap DBD::mysql $VERSION;
# spent 1.44ms making 1 call to DynaLoader::bootstrap
16
17
18our $err = 0; # holds error code for DBI::err
19our $errstr = ""; # holds error string for DBI::errstr
20our $drh = undef; # holds driver handle once initialised
21
22my $methods_are_installed = 0;
23sub driver{
24 return $drh if $drh;
25 my($class, $attr) = @_;
26
27 $class .= "::dr";
28
29 # not a 'my' since we use it above to prevent multiple drivers
30141µs $drh = DBI::_new_drh($class, { 'Name' => 'mysql',
# spent 41µs making 1 call to DBI::_new_drh
31 'Version' => $VERSION,
32 'Err' => \$DBD::mysql::err,
33 'Errstr' => \$DBD::mysql::errstr,
34 'Attribution' => 'DBD::mysql by Patrick Galbraith'
35 });
36
37 if (!$methods_are_installed) {
38144µs DBD::mysql::db->install_method('mysql_fd');
# spent 44µs making 1 call to DBD::_::common::install_method
39115µs DBD::mysql::db->install_method('mysql_async_result');
# spent 15µs making 1 call to DBD::_::common::install_method
40112µs DBD::mysql::db->install_method('mysql_async_ready');
# spent 12µs making 1 call to DBD::_::common::install_method
41117µs DBD::mysql::st->install_method('mysql_async_result');
# spent 17µs making 1 call to DBD::_::common::install_method
42112µs DBD::mysql::st->install_method('mysql_async_ready');
# spent 12µs making 1 call to DBD::_::common::install_method
43
44 $methods_are_installed++;
45 }
46
47 $drh;
48}
49
50sub CLONE {
51 undef $drh;
52}
53
54
# spent 55µs (37+18) within DBD::mysql::_OdbcParse which was called: # once (37µs+18µs) by DBD::mysql::dr::connect at line 135
sub _OdbcParse($$$) {
55 my($class, $dsn, $hash, $args) = @_;
56 my($var, $val);
57 if (!defined($dsn)) {
58 return;
59 }
60 while (length($dsn)) {
61313µs if ($dsn =~ /([^:;]*\[.*]|[^:;]*)[:;](.*)/) {
# spent 13µs making 3 calls to DBD::mysql::CORE:match, avg 4µs/call
62 $val = $1;
63 $dsn = $2;
64 } else {
65 $val = $dsn;
66 $dsn = '';
67 }
6836µs if ($val =~ /([^=]*)=(.*)/) {
# spent 6µs making 3 calls to DBD::mysql::CORE:match, avg 2µs/call
69 $var = $1;
70 $val = $2;
71 if ($var eq 'hostname' || $var eq 'host') {
72 $hash->{'host'} = $val;
73 } elsif ($var eq 'db' || $var eq 'dbname') {
74 $hash->{'database'} = $val;
75 } else {
76 $hash->{$var} = $val;
77 }
78 } else {
79 foreach $var (@$args) {
80 if (!defined($hash->{$var})) {
81 $hash->{$var} = $val;
82 last;
83 }
84 }
85 }
86 }
87}
88
89sub _OdbcParseHost ($$) {
90 my($class, $dsn) = @_;
91 my($hash) = {};
92 $class->_OdbcParse($dsn, $hash, ['host', 'port']);
93 ($hash->{'host'}, $hash->{'port'});
94}
95
96sub AUTOLOAD {
97 my ($meth) = $DBD::mysql::AUTOLOAD;
98 my ($smeth) = $meth;
99 $smeth =~ s/(.*)\:\://;
100
101 my $val = constant($smeth, @_ ? $_[0] : 0);
102 if ($! == 0) { eval "sub $meth { $val }"; return $val; }
103
104 Carp::croak "$meth: Not defined";
105}
106
1071;
108
109
110package DBD::mysql::dr; # ====== DRIVER ======
111225µs
# spent 18µs (10+8) within DBD::mysql::dr::BEGIN@111 which was called: # once (10µs+8µs) by DBI::connect at line 111
use strict;
# spent 18µs making 1 call to DBD::mysql::dr::BEGIN@111 # spent 8µs making 1 call to strict::import
1122580µs
# spent 295µs (11+285) within DBD::mysql::dr::BEGIN@112 which was called: # once (11µs+285µs) by DBI::connect at line 112
use DBI qw(:sql_types);
# spent 295µs making 1 call to DBD::mysql::dr::BEGIN@112 # spent 284µs making 1 call to Exporter::import
11325.36ms
# spent 5.25ms (545µs+4.70) within DBD::mysql::dr::BEGIN@113 which was called: # once (545µs+4.70ms) by DBI::connect at line 113
use DBI::Const::GetInfoType;
# spent 5.25ms making 1 call to DBD::mysql::dr::BEGIN@113 # spent 108µs making 1 call to Exporter::import
114
115
# spent 1.62ms (62µs+1.56) within DBD::mysql::dr::connect which was called: # once (62µs+1.56ms) by DBI::connect at line 671 of DBI.pm
sub connect {
116 my($drh, $dsn, $username, $password, $attrhash) = @_;
117 my($port);
118 my($cWarn);
119 my $connect_ref= { 'Name' => $dsn };
120 my $dbi_imp_data;
121
122 # Avoid warnings for undefined values
123 $username ||= '';
124 $password ||= '';
125 $attrhash ||= {};
126
127 # create a 'blank' dbh
128 my($this, $privateAttrHash) = (undef, $attrhash);
129 $privateAttrHash = { %$privateAttrHash,
130 'Name' => $dsn,
131 'user' => $username,
132 'password' => $password
133 };
134
135155µs DBD::mysql->_OdbcParse($dsn, $privateAttrHash,
# spent 55µs making 1 call to DBD::mysql::_OdbcParse
136 ['database', 'host', 'port']);
137
138
139 if ($DBI::VERSION >= 1.49)
140 {
141 $dbi_imp_data = delete $attrhash->{dbi_imp_data};
142 $connect_ref->{'dbi_imp_data'} = $dbi_imp_data;
143 }
144
145127µs if (!defined($this = DBI::_new_dbh($drh,
# spent 27µs making 1 call to DBI::_new_dbh
146 $connect_ref,
147 $privateAttrHash)))
148 {
149 return undef;
150 }
151
15211.48ms DBD::mysql::db::_login($this, $dsn, $username, $password)
# spent 1.48ms making 1 call to DBD::mysql::db::_login
153 or $this = undef;
154
155 if ($this && ($ENV{MOD_PERL} || $ENV{GATEWAY_INTERFACE})) {
156 $this->{mysql_auto_reconnect} = 1;
157 }
158 $this;
159}
160
161sub data_sources {
162 my($self) = shift;
163 my($attributes) = shift;
164 my($host, $port, $user, $password) = ('', '', '', '');
165 if ($attributes) {
166 $host = $attributes->{host} || '';
167 $port = $attributes->{port} || '';
168 $user = $attributes->{user} || '';
169 $password = $attributes->{password} || '';
170 }
171 my(@dsn) = $self->func($host, $port, $user, $password, '_ListDBs');
172 my($i);
173 for ($i = 0; $i < @dsn; $i++) {
174 $dsn[$i] = "DBI:mysql:$dsn[$i]";
175 }
176 @dsn;
177}
178
179sub admin {
180 my($drh) = shift;
181 my($command) = shift;
182 my($dbname) = ($command eq 'createdb' || $command eq 'dropdb') ?
183 shift : '';
184 my($host, $port) = DBD::mysql->_OdbcParseHost(shift(@_) || '');
185 my($user) = shift || '';
186 my($password) = shift || '';
187
188 $drh->func(undef, $command,
189 $dbname || '',
190 $host || '',
191 $port || '',
192 $user, $password, '_admin_internal');
193}
194
195package DBD::mysql::db; # ====== DATABASE ======
196239µs
# spent 26µs (13+13) within DBD::mysql::db::BEGIN@196 which was called: # once (13µs+13µs) by DBI::connect at line 196
use strict;
# spent 26µs making 1 call to DBD::mysql::db::BEGIN@196 # spent 13µs making 1 call to strict::import
1972491µs
# spent 251µs (11+240) within DBD::mysql::db::BEGIN@197 which was called: # once (11µs+240µs) by DBI::connect at line 197
use DBI qw(:sql_types);
# spent 251µs making 1 call to DBD::mysql::db::BEGIN@197 # spent 240µs making 1 call to Exporter::import
198
199%DBD::mysql::db::db2ANSI = (
200 "INT" => "INTEGER",
201 "CHAR" => "CHAR",
202 "REAL" => "REAL",
203 "IDENT" => "DECIMAL"
204);
205
206### ANSI datatype mapping to MySQL datatypes
207%DBD::mysql::db::ANSI2db = (
208 "CHAR" => "CHAR",
209 "VARCHAR" => "CHAR",
210 "LONGVARCHAR" => "CHAR",
211 "NUMERIC" => "INTEGER",
212 "DECIMAL" => "INTEGER",
213 "BIT" => "INTEGER",
214 "TINYINT" => "INTEGER",
215 "SMALLINT" => "INTEGER",
216 "INTEGER" => "INTEGER",
217 "BIGINT" => "INTEGER",
218 "REAL" => "REAL",
219 "FLOAT" => "REAL",
220 "DOUBLE" => "REAL",
221 "BINARY" => "CHAR",
222 "VARBINARY" => "CHAR",
223 "LONGVARBINARY" => "CHAR",
224 "DATE" => "CHAR",
225 "TIME" => "CHAR",
226 "TIMESTAMP" => "CHAR"
227);
228
229
# spent 18.8ms (6.25+12.5) within DBD::mysql::db::prepare which was called 644 times, avg 29µs/call: # 412 times (4.03ms+8.05ms) by C4::Languages::getTranslatedLanguages at line 382 of C4/Languages.pm, avg 29µs/call # 200 times (1.78ms+3.47ms) by C4::Languages::getTranslatedLanguages at line 389 of C4/Languages.pm, avg 26µs/call # 5 times (69µs+194µs) by DBI::db::prepare at line 1973 of C4/Auth.pm, avg 52µs/call # 5 times (48µs+96µs) by DBI::db::prepare at line 1868 of C4/Auth.pm, avg 29µs/call # 5 times (41µs+99µs) by DBI::db::prepare at line 1919 of C4/Auth.pm, avg 28µs/call # 4 times (83µs+160µs) by C4::Members::GetMember at line 449 of C4/Members.pm, avg 61µs/call # 4 times (62µs+165µs) by DBD::_::db::prepare_cached at line 1717 of DBI.pm, avg 57µs/call # 4 times (54µs+142µs) by DBI::db::prepare at line 1948 of C4/Auth.pm, avg 49µs/call # once (41µs+39µs) by C4::NewsChannels::GetNewsToDisplay at line 215 of C4/NewsChannels.pm # once (13µs+36µs) by DBI::db::prepare at line 123 of C4/Review.pm # once (12µs+32µs) by DBI::db::prepare at line 417 of C4/Suggestions.pm # once (8µs+19µs) by DBI::db::prepare at line 120 of C4/Tags.pm # once (9µs+19µs) by DBI::db::prepare at line 122 of Koha/Borrower/Modifications.pm
sub prepare {
23016486µs my($dbh, $statement, $attribs)= @_;
231
232164573µs644904µs return unless $dbh->func('_async_check');
# spent 904µs making 644 calls to DBI::common::func, avg 1µs/call
233
234 # create a 'blank' dbh
2351643.03ms64410.2ms my $sth = DBI::_new_sth($dbh, {'Statement' => $statement});
# spent 10.2ms making 644 calls to DBI::_new_sth, avg 16µs/call
236
237 # Populate internal handle data.
238164648µs6441.37ms if (!DBD::mysql::st::_prepare($sth, $statement, $attribs)) {
# spent 1.37ms making 644 calls to DBD::mysql::st::_prepare, avg 2µs/call
239 $sth = undef;
240 }
241
242164320µs $sth;
243}
244
245sub db2ANSI {
246 my $self = shift;
247 my $type = shift;
248 return $DBD::mysql::db::db2ANSI{"$type"};
249}
250
251sub ANSI2db {
252 my $self = shift;
253 my $type = shift;
254 return $DBD::mysql::db::ANSI2db{"$type"};
255}
256
257sub admin {
258 my($dbh) = shift;
259 my($command) = shift;
260 my($dbname) = ($command eq 'createdb' || $command eq 'dropdb') ?
261 shift : '';
262 $dbh->{'Driver'}->func($dbh, $command, $dbname, '', '', '',
263 '_admin_internal');
264}
265
266sub _SelectDB ($$) {
267 die "_SelectDB is removed from this module; use DBI->connect instead.";
268}
269
270sub table_info ($) {
271 my ($dbh, $catalog, $schema, $table, $type, $attr) = @_;
272 $dbh->{mysql_server_prepare}||= 0;
273 my $mysql_server_prepare_save= $dbh->{mysql_server_prepare};
274 $dbh->{mysql_server_prepare}= 0;
275 my @names = qw(TABLE_CAT TABLE_SCHEM TABLE_NAME TABLE_TYPE REMARKS);
276 my @rows;
277
278 my $sponge = DBI->connect("DBI:Sponge:", '','')
279 or return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr");
280
281# Return the list of catalogs
282 if (defined $catalog && $catalog eq "%" &&
283 (!defined($schema) || $schema eq "") &&
284 (!defined($table) || $table eq ""))
285 {
286 @rows = (); # Empty, because MySQL doesn't support catalogs (yet)
287 }
288 # Return the list of schemas
289 elsif (defined $schema && $schema eq "%" &&
290 (!defined($catalog) || $catalog eq "") &&
291 (!defined($table) || $table eq ""))
292 {
293 my $sth = $dbh->prepare("SHOW DATABASES")
294 or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
295 return undef);
296
297 $sth->execute()
298 or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
299 return DBI::set_err($dbh, $sth->err(), $sth->errstr()));
300
301 while (my $ref = $sth->fetchrow_arrayref())
302 {
303 push(@rows, [ undef, $ref->[0], undef, undef, undef ]);
304 }
305 }
306 # Return the list of table types
307 elsif (defined $type && $type eq "%" &&
308 (!defined($catalog) || $catalog eq "") &&
309 (!defined($schema) || $schema eq "") &&
310 (!defined($table) || $table eq ""))
311 {
312 @rows = (
313 [ undef, undef, undef, "TABLE", undef ],
314 [ undef, undef, undef, "VIEW", undef ],
315 );
316 }
317 # Special case: a catalog other than undef, "", or "%"
318 elsif (defined $catalog && $catalog ne "" && $catalog ne "%")
319 {
320 @rows = (); # Nothing, because MySQL doesn't support catalogs yet.
321 }
322 # Uh oh, we actually have a meaty table_info call. Work is required!
323 else
324 {
325 my @schemas;
326 # If no table was specified, we want them all
327 $table ||= "%";
328
329 # If something was given for the schema, we need to expand it to
330 # a list of schemas, since it may be a wildcard.
331 if (defined $schema && $schema ne "")
332 {
333 my $sth = $dbh->prepare("SHOW DATABASES LIKE " .
334 $dbh->quote($schema))
335 or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
336 return undef);
337 $sth->execute()
338 or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
339 return DBI::set_err($dbh, $sth->err(), $sth->errstr()));
340
341 while (my $ref = $sth->fetchrow_arrayref())
342 {
343 push @schemas, $ref->[0];
344 }
345 }
346 # Otherwise we want the current database
347 else
348 {
349 push @schemas, $dbh->selectrow_array("SELECT DATABASE()");
350 }
351
352 # Figure out which table types are desired
353 my ($want_tables, $want_views);
354 if (defined $type && $type ne "")
355 {
356 $want_tables = ($type =~ m/table/i);
357 $want_views = ($type =~ m/view/i);
358 }
359 else
360 {
361 $want_tables = $want_views = 1;
362 }
363
364 for my $database (@schemas)
365 {
366 my $sth = $dbh->prepare("SHOW /*!50002 FULL*/ TABLES FROM " .
367 $dbh->quote_identifier($database) .
368 " LIKE " . $dbh->quote($table))
369 or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
370 return undef);
371
372 $sth->execute() or
373 ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
374 return DBI::set_err($dbh, $sth->err(), $sth->errstr()));
375
376 while (my $ref = $sth->fetchrow_arrayref())
377 {
378 my $type = (defined $ref->[1] &&
379 $ref->[1] =~ /view/i) ? 'VIEW' : 'TABLE';
380 next if $type eq 'TABLE' && not $want_tables;
381 next if $type eq 'VIEW' && not $want_views;
382 push @rows, [ undef, $database, $ref->[0], $type, undef ];
383 }
384 }
385 }
386
387 my $sth = $sponge->prepare("table_info",
388 {
389 rows => \@rows,
390 NUM_OF_FIELDS => scalar @names,
391 NAME => \@names,
392 })
393 or ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
394 return $dbh->DBI::set_err($sponge->err(), $sponge->errstr()));
395
396 $dbh->{mysql_server_prepare}= $mysql_server_prepare_save;
397 return $sth;
398}
399
400sub _ListTables {
401 my $dbh = shift;
402 if (!$DBD::mysql::QUIET) {
403 warn "_ListTables is deprecated, use \$dbh->tables()";
404 }
405 return map { $_ =~ s/.*\.//; $_ } $dbh->tables();
406}
407
408
409sub column_info {
410 my ($dbh, $catalog, $schema, $table, $column) = @_;
411
412 return unless $dbh->func('_async_check');
413
414 $dbh->{mysql_server_prepare}||= 0;
415 my $mysql_server_prepare_save= $dbh->{mysql_server_prepare};
416 $dbh->{mysql_server_prepare}= 0;
417
418 # ODBC allows a NULL to mean all columns, so we'll accept undef
419 $column = '%' unless defined $column;
420
421 my $ER_NO_SUCH_TABLE= 1146;
422
423 my $table_id = $dbh->quote_identifier($catalog, $schema, $table);
424
425 my @names = qw(
426 TABLE_CAT TABLE_SCHEM TABLE_NAME COLUMN_NAME
427 DATA_TYPE TYPE_NAME COLUMN_SIZE BUFFER_LENGTH DECIMAL_DIGITS
428 NUM_PREC_RADIX NULLABLE REMARKS COLUMN_DEF
429 SQL_DATA_TYPE SQL_DATETIME_SUB CHAR_OCTET_LENGTH
430 ORDINAL_POSITION IS_NULLABLE CHAR_SET_CAT
431 CHAR_SET_SCHEM CHAR_SET_NAME COLLATION_CAT COLLATION_SCHEM COLLATION_NAME
432 UDT_CAT UDT_SCHEM UDT_NAME DOMAIN_CAT DOMAIN_SCHEM DOMAIN_NAME
433 SCOPE_CAT SCOPE_SCHEM SCOPE_NAME MAX_CARDINALITY
434 DTD_IDENTIFIER IS_SELF_REF
435 mysql_is_pri_key mysql_type_name mysql_values
436 mysql_is_auto_increment
437 );
438 my %col_info;
439
440 local $dbh->{FetchHashKeyName} = 'NAME_lc';
441 # only ignore ER_NO_SUCH_TABLE in internal_execute if issued from here
442 my $desc_sth = $dbh->prepare("DESCRIBE $table_id " . $dbh->quote($column));
443 my $desc = $dbh->selectall_arrayref($desc_sth, { Columns=>{} });
444
445 #return $desc_sth if $desc_sth->err();
446 if (my $err = $desc_sth->err())
447 {
448 # return the error, unless it is due to the table not
449 # existing per DBI spec
450 if ($err != $ER_NO_SUCH_TABLE)
451 {
452 $dbh->{mysql_server_prepare}= $mysql_server_prepare_save;
453 return undef;
454 }
455 $dbh->set_err(undef,undef);
456 $desc = [];
457 }
458
459 my $ordinal_pos = 0;
460 my @fields;
461 for my $row (@$desc)
462 {
463 my $type = $row->{type};
464 $type =~ m/^(\w+)(\((.+)\))?\s?(.*)?$/;
465 my $basetype = lc($1);
466 my $typemod = $3;
467 my $attr = $4;
468
469 push @fields, $row->{field};
470 my $info = $col_info{ $row->{field} }= {
471 TABLE_CAT => $catalog,
472 TABLE_SCHEM => $schema,
473 TABLE_NAME => $table,
474 COLUMN_NAME => $row->{field},
475 NULLABLE => ($row->{null} eq 'YES') ? 1 : 0,
476 IS_NULLABLE => ($row->{null} eq 'YES') ? "YES" : "NO",
477 TYPE_NAME => uc($basetype),
478 COLUMN_DEF => $row->{default},
479 ORDINAL_POSITION => ++$ordinal_pos,
480 mysql_is_pri_key => ($row->{key} eq 'PRI'),
481 mysql_type_name => $row->{type},
482 mysql_is_auto_increment => ($row->{extra} =~ /auto_increment/i ? 1 : 0),
483 };
484 #
485 # This code won't deal with a pathological case where a value
486 # contains a single quote followed by a comma, and doesn't unescape
487 # any escaped values. But who would use those in an enum or set?
488 #
489 my @type_params= ($typemod && index($typemod,"'")>=0) ?
490 ("$typemod," =~ /'(.*?)',/g) # assume all are quoted
491 : split /,/, $typemod||''; # no quotes, plain list
492 s/''/'/g for @type_params; # undo doubling of quotes
493
494 my @type_attr= split / /, $attr||'';
495
496 $info->{DATA_TYPE}= SQL_VARCHAR();
497 if ($basetype =~ /^(char|varchar|\w*text|\w*blob)/)
498 {
499 $info->{DATA_TYPE}= SQL_CHAR() if $basetype eq 'char';
500 if ($type_params[0])
501 {
502 $info->{COLUMN_SIZE} = $type_params[0];
503 }
504 else
505 {
506 $info->{COLUMN_SIZE} = 65535;
507 $info->{COLUMN_SIZE} = 255 if $basetype =~ /^tiny/;
508 $info->{COLUMN_SIZE} = 16777215 if $basetype =~ /^medium/;
509 $info->{COLUMN_SIZE} = 4294967295 if $basetype =~ /^long/;
510 }
511 }
512 elsif ($basetype =~ /^(binary|varbinary)/)
513 {
514 $info->{COLUMN_SIZE} = $type_params[0];
515 # SQL_BINARY & SQL_VARBINARY are tempting here but don't match the
516 # semantics for mysql (not hex). SQL_CHAR & SQL_VARCHAR are correct here.
517 $info->{DATA_TYPE} = ($basetype eq 'binary') ? SQL_CHAR() : SQL_VARCHAR();
518 }
519 elsif ($basetype =~ /^(enum|set)/)
520 {
521 if ($basetype eq 'set')
522 {
523 $info->{COLUMN_SIZE} = length(join ",", @type_params);
524 }
525 else
526 {
527 my $max_len = 0;
528 length($_) > $max_len and $max_len = length($_) for @type_params;
529 $info->{COLUMN_SIZE} = $max_len;
530 }
531 $info->{"mysql_values"} = \@type_params;
532 }
533 elsif ($basetype =~ /int/)
534 {
535 # big/medium/small/tiny etc + unsigned?
536 $info->{DATA_TYPE} = SQL_INTEGER();
537 $info->{NUM_PREC_RADIX} = 10;
538 $info->{COLUMN_SIZE} = $type_params[0];
539 }
540 elsif ($basetype =~ /^decimal/)
541 {
542 $info->{DATA_TYPE} = SQL_DECIMAL();
543 $info->{NUM_PREC_RADIX} = 10;
544 $info->{COLUMN_SIZE} = $type_params[0];
545 $info->{DECIMAL_DIGITS} = $type_params[1];
546 }
547 elsif ($basetype =~ /^(float|double)/)
548 {
549 $info->{DATA_TYPE} = ($basetype eq 'float') ? SQL_FLOAT() : SQL_DOUBLE();
550 $info->{NUM_PREC_RADIX} = 2;
551 $info->{COLUMN_SIZE} = ($basetype eq 'float') ? 32 : 64;
552 }
553 elsif ($basetype =~ /date|time/)
554 {
555 # date/datetime/time/timestamp
556 if ($basetype eq 'time' or $basetype eq 'date')
557 {
558 #$info->{DATA_TYPE} = ($basetype eq 'time') ? SQL_TYPE_TIME() : SQL_TYPE_DATE();
559 $info->{DATA_TYPE} = ($basetype eq 'time') ? SQL_TIME() : SQL_DATE();
560 $info->{COLUMN_SIZE} = ($basetype eq 'time') ? 8 : 10;
561 }
562 else
563 {
564 # datetime/timestamp
565 #$info->{DATA_TYPE} = SQL_TYPE_TIMESTAMP();
566 $info->{DATA_TYPE} = SQL_TIMESTAMP();
567 $info->{SQL_DATA_TYPE} = SQL_DATETIME();
568 $info->{SQL_DATETIME_SUB} = $info->{DATA_TYPE} - ($info->{SQL_DATA_TYPE} * 10);
569 $info->{COLUMN_SIZE} = ($basetype eq 'datetime') ? 19 : $type_params[0] || 14;
570 }
571 $info->{DECIMAL_DIGITS}= 0; # no fractional seconds
572 }
573 elsif ($basetype eq 'year')
574 {
575 # no close standard so treat as int
576 $info->{DATA_TYPE} = SQL_INTEGER();
577 $info->{NUM_PREC_RADIX} = 10;
578 $info->{COLUMN_SIZE} = 4;
579 }
580 else
581 {
582 Carp::carp("column_info: unrecognized column type '$basetype' of $table_id.$row->{field} treated as varchar");
583 }
584 $info->{SQL_DATA_TYPE} ||= $info->{DATA_TYPE};
585 #warn Dumper($info);
586 }
587
588 my $sponge = DBI->connect("DBI:Sponge:", '','')
589 or ( $dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
590 return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr"));
591
592 my $sth = $sponge->prepare("column_info $table", {
593 rows => [ map { [ @{$_}{@names} ] } map { $col_info{$_} } @fields ],
594 NUM_OF_FIELDS => scalar @names,
595 NAME => \@names,
596 }) or
597 return ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
598 $dbh->DBI::set_err($sponge->err(), $sponge->errstr()));
599
600 $dbh->{mysql_server_prepare}= $mysql_server_prepare_save;
601 return $sth;
602}
603
604
605sub primary_key_info {
606 my ($dbh, $catalog, $schema, $table) = @_;
607
608 return unless $dbh->func('_async_check');
609
610 $dbh->{mysql_server_prepare}||= 0;
611 my $mysql_server_prepare_save= $dbh->{mysql_server_prepare};
612
613 my $table_id = $dbh->quote_identifier($catalog, $schema, $table);
614
615 my @names = qw(
616 TABLE_CAT TABLE_SCHEM TABLE_NAME COLUMN_NAME KEY_SEQ PK_NAME
617 );
618 my %col_info;
619
620 local $dbh->{FetchHashKeyName} = 'NAME_lc';
621 my $desc_sth = $dbh->prepare("SHOW KEYS FROM $table_id");
622 my $desc= $dbh->selectall_arrayref($desc_sth, { Columns=>{} });
623 my $ordinal_pos = 0;
624 for my $row (grep { $_->{key_name} eq 'PRIMARY'} @$desc)
625 {
626 $col_info{ $row->{column_name} }= {
627 TABLE_CAT => $catalog,
628 TABLE_SCHEM => $schema,
629 TABLE_NAME => $table,
630 COLUMN_NAME => $row->{column_name},
631 KEY_SEQ => $row->{seq_in_index},
632 PK_NAME => $row->{key_name},
633 };
634 }
635
636 my $sponge = DBI->connect("DBI:Sponge:", '','')
637 or
638 ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
639 return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr"));
640
641 my $sth= $sponge->prepare("primary_key_info $table", {
642 rows => [
643 map { [ @{$_}{@names} ] }
644 sort { $a->{KEY_SEQ} <=> $b->{KEY_SEQ} }
645 values %col_info
646 ],
647 NUM_OF_FIELDS => scalar @names,
648 NAME => \@names,
649 }) or
650 ($dbh->{mysql_server_prepare}= $mysql_server_prepare_save &&
651 return $dbh->DBI::set_err($sponge->err(), $sponge->errstr()));
652
653 $dbh->{mysql_server_prepare}= $mysql_server_prepare_save;
654
655 return $sth;
656}
657
658
659sub foreign_key_info {
660 my ($dbh,
661 $pk_catalog, $pk_schema, $pk_table,
662 $fk_catalog, $fk_schema, $fk_table,
663 ) = @_;
664
665 return unless $dbh->func('_async_check');
666
667 # INFORMATION_SCHEMA.KEY_COLUMN_USAGE was added in 5.0.6
668 # no one is going to be running 5.0.6, taking out the check for $point > .6
669 my ($maj, $min, $point) = _version($dbh);
670 return if $maj < 5 ;
671
672 my $sql = <<'EOF';
673SELECT NULL AS PKTABLE_CAT,
674 A.REFERENCED_TABLE_SCHEMA AS PKTABLE_SCHEM,
675 A.REFERENCED_TABLE_NAME AS PKTABLE_NAME,
676 A.REFERENCED_COLUMN_NAME AS PKCOLUMN_NAME,
677 A.TABLE_CATALOG AS FKTABLE_CAT,
678 A.TABLE_SCHEMA AS FKTABLE_SCHEM,
679 A.TABLE_NAME AS FKTABLE_NAME,
680 A.COLUMN_NAME AS FKCOLUMN_NAME,
681 A.ORDINAL_POSITION AS KEY_SEQ,
682 NULL AS UPDATE_RULE,
683 NULL AS DELETE_RULE,
684 A.CONSTRAINT_NAME AS FK_NAME,
685 NULL AS PK_NAME,
686 NULL AS DEFERABILITY,
687 NULL AS UNIQUE_OR_PRIMARY
688 FROM INFORMATION_SCHEMA.KEY_COLUMN_USAGE A,
689 INFORMATION_SCHEMA.TABLE_CONSTRAINTS B
690 WHERE A.TABLE_SCHEMA = B.TABLE_SCHEMA AND A.TABLE_NAME = B.TABLE_NAME
691 AND A.CONSTRAINT_NAME = B.CONSTRAINT_NAME AND B.CONSTRAINT_TYPE IS NOT NULL
692EOF
693
694 my @where;
695 my @bind;
696
697 # catalogs are not yet supported by MySQL
698
699# if (defined $pk_catalog) {
700# push @where, 'A.REFERENCED_TABLE_CATALOG = ?';
701# push @bind, $pk_catalog;
702# }
703
704 if (defined $pk_schema) {
705 push @where, 'A.REFERENCED_TABLE_SCHEMA = ?';
706 push @bind, $pk_schema;
707 }
708
709 if (defined $pk_table) {
710 push @where, 'A.REFERENCED_TABLE_NAME = ?';
711 push @bind, $pk_table;
712 }
713
714# if (defined $fk_catalog) {
715# push @where, 'A.TABLE_CATALOG = ?';
716# push @bind, $fk_schema;
717# }
718
719 if (defined $fk_schema) {
720 push @where, 'A.TABLE_SCHEMA = ?';
721 push @bind, $fk_schema;
722 }
723
724 if (defined $fk_table) {
725 push @where, 'A.TABLE_NAME = ?';
726 push @bind, $fk_table;
727 }
728
729 if (@where) {
730 $sql .= ' AND ';
731 $sql .= join ' AND ', @where;
732 }
733 $sql .= " ORDER BY A.TABLE_SCHEMA, A.TABLE_NAME, A.ORDINAL_POSITION";
734
735 local $dbh->{FetchHashKeyName} = 'NAME_uc';
736 my $sth = $dbh->prepare($sql);
737 $sth->execute(@bind);
738
739 return $sth;
740}
741
742
743sub _version {
744 my $dbh = shift;
745
746 return
747 $dbh->get_info($DBI::Const::GetInfoType::GetInfoType{SQL_DBMS_VER})
748 =~ /(\d+)\.(\d+)\.(\d+)/;
749}
750
751
752####################
753# get_info()
754# Generated by DBI::DBD::Metadata
755
756
# spent 1.11ms (1.02+95µs) within DBD::mysql::db::get_info which was called: # once (1.02ms+95µs) by DBI::db::get_info at line 1170 of DBIx/Class/Storage/DBI.pm
sub get_info {
757 my($dbh, $info_type) = @_;
758
75914µs return unless $dbh->func('_async_check');
# spent 4µs making 1 call to DBI::common::func
760 require DBD::mysql::GetInfo;
761 my $v = $DBD::mysql::GetInfo::info{int($info_type)};
762116µs $v = $v->($dbh) if ref $v eq 'CODE';
# spent 16µs making 1 call to DBD::mysql::GetInfo::__ANON__[DBD/mysql/GetInfo.pm:75]
763 return $v;
764}
765
766
# spent 26µs within DBD::mysql::db::BEGIN@766 which was called: # once (26µs+0s) by DBI::connect at line 779
BEGIN {
767 my @needs_async_check = qw/data_sources statistics_info quote_identifier begin_work/;
768
769 foreach my $method (@needs_async_check) {
770238µs
# spent 26µs (14+11) within DBD::mysql::db::BEGIN@770 which was called: # once (14µs+11µs) by DBI::connect at line 770
no strict 'refs';
# spent 26µs making 1 call to DBD::mysql::db::BEGIN@770 # spent 12µs making 1 call to strict::unimport
771
772 my $super = "SUPER::$method";
773 *$method = sub {
774 my $h = shift;
775 return unless $h->func('_async_check');
776 return $h->$super(@_);
777 };
778 }
779126µs}
# spent 26µs making 1 call to DBD::mysql::db::BEGIN@766
780
781
782package DBD::mysql::st; # ====== STATEMENT ======
783224µs
# spent 17µs (10+7) within DBD::mysql::st::BEGIN@783 which was called: # once (10µs+7µs) by DBI::connect at line 783
use strict;
# spent 17µs making 1 call to DBD::mysql::st::BEGIN@783 # spent 7µs making 1 call to strict::import
784
785
# spent 29µs within DBD::mysql::st::BEGIN@785 which was called: # once (29µs+0s) by DBI::connect at line 812
BEGIN {
786 my @needs_async_result = qw/fetchrow_hashref fetchall_hashref/;
787 my @needs_async_check = qw/bind_param_array bind_col bind_columns execute_for_fetch/;
788
789 foreach my $method (@needs_async_result) {
790216µs
# spent 12µs (7+5) within DBD::mysql::st::BEGIN@790 which was called: # once (7µs+5µs) by DBI::connect at line 790
no strict 'refs';
# spent 12µs making 1 call to DBD::mysql::st::BEGIN@790 # spent 5µs making 1 call to strict::unimport
791
792 my $super = "SUPER::$method";
793
# spent 28.4ms (9.04+19.4) within DBD::mysql::st::__ANON__[/usr/lib/x86_64-linux-gnu/perl5/5.20/DBD/mysql.pm:799] which was called 1161 times, avg 24µs/call: # 624 times (5.24ms+13.3ms) by C4::Languages::getTranslatedLanguages at line 385 of C4/Languages.pm, avg 30µs/call # 308 times (1.40ms+2.87ms) by DBI::st::fetchrow_hashref at line 1954 of C4/Auth.pm, avg 14µs/call # 220 times (2.28ms+3.03ms) by C4::Languages::getTranslatedLanguages at line 391 of C4/Languages.pm, avg 24µs/call # 5 times (56µs+100µs) by DBI::st::fetchrow_hashref at line 1928 of C4/Auth.pm, avg 31µs/call # 3 times (54µs+102µs) by C4::NewsChannels::GetNewsToDisplay at line 219 of C4/NewsChannels.pm, avg 52µs/call # once (10µs+20µs) by DBI::st::fetchrow_hashref at line 124 of Koha/Borrower/Modifications.pm
*$method = sub {
794293174µs my $sth = shift;
7952931.32ms11611.56ms if(defined $sth->mysql_async_ready) {
# spent 1.56ms making 1161 calls to DBI::st::mysql_async_ready, avg 1µs/call
796 return unless $sth->mysql_async_result;
797 }
7982934.60ms348322.7ms return $sth->$super(@_);
# spent 17.8ms making 1161 calls to DBD::_::st::fetchrow_hashref, avg 15µs/call # spent 2.62ms making 1161 calls to DBI::common::FETCH, avg 2µs/call # spent 2.28ms making 1161 calls to DBI::st::fetch, avg 2µs/call
799 };
800 }
801
802 foreach my $method (@needs_async_check) {
803219µs
# spent 14µs (10+5) within DBD::mysql::st::BEGIN@803 which was called: # once (10µs+5µs) by DBI::connect at line 803
no strict 'refs';
# spent 14µs making 1 call to DBD::mysql::st::BEGIN@803 # spent 5µs making 1 call to strict::unimport
804
805 my $super = "SUPER::$method";
806
# spent 15.7ms (6.84+8.81) within DBD::mysql::st::__ANON__[/usr/lib/x86_64-linux-gnu/perl5/5.20/DBD/mysql.pm:810] which was called 345 times, avg 45µs/call: # 339 times (6.76ms+574µs) by DBD::_::st::bind_columns at line 1899 of DBI.pm, avg 22µs/call # 4 times (62µs+7.35ms) by DBD::_::st::fetchall_arrayref at line 2064 of DBI.pm, avg 1.85ms/call # 2 times (23µs+884µs) by DBI::st::bind_columns at line 128 of DBIx/Class/Storage/DBI/Cursor.pm, avg 454µs/call
*$method = sub {
8077110µs my $h = shift;
80871168µs345338µs return unless $h->func('_async_check');
# spent 338µs making 345 calls to DBI::common::func, avg 981ns/call
80971287µs3458.47ms return $h->$super(@_);
# spent 8.22ms making 6 calls to DBD::_::st::bind_columns, avg 1.37ms/call # spent 249µs making 339 calls to DBD::_::st::bind_col, avg 735ns/call
810 };
811 }
812129µs}
# spent 29µs making 1 call to DBD::mysql::st::BEGIN@785
813
8141;
815
816__END__
 
# spent 18µs within DBD::mysql::CORE:match which was called 6 times, avg 3µs/call: # 3 times (13µs+0s) by DBD::mysql::_OdbcParse at line 61, avg 4µs/call # 3 times (6µs+0s) by DBD::mysql::_OdbcParse at line 68, avg 2µs/call
sub DBD::mysql::CORE:match; # opcode
# spent 1.48ms within DBD::mysql::db::_login which was called: # once (1.48ms+0s) by DBD::mysql::dr::connect at line 152
sub DBD::mysql::db::_login; # xsub
# spent 1.37ms within DBD::mysql::st::_prepare which was called 644 times, avg 2µs/call: # 644 times (1.37ms+0s) by DBD::mysql::db::prepare at line 238, avg 2µs/call
sub DBD::mysql::st::_prepare; # xsub
Report produced by the NYTProf 6.02 Perl profiler, developed by Tim Bunce and Adam Kaplan.