← Index
Performance Profile   « block view • line view • sub view »
For opac/opac-main.pl
  Run on Fri Jul 18 13:58:34 2008
Reported on Fri Jul 18 13:58:41 2008

File/usr/lib/perl5/DBD/mysql.pm
Statements Executed784
Total Time0.00306400000000001 seconds

Subroutines — ordered by inclusive time then name
CallsInclusive
Time
Subroutine
00DBD::mysql::AUTOLOAD
00DBD::mysql::BEGIN
00DBD::mysql::CLONE
00DBD::mysql::_OdbcParse
00DBD::mysql::_OdbcParseHost
00DBD::mysql::db::ANSI2db
00DBD::mysql::db::BEGIN
00DBD::mysql::db::_ListTables
00DBD::mysql::db::_SelectDB
00DBD::mysql::db::_version
00DBD::mysql::db::admin
00DBD::mysql::db::column_info
00DBD::mysql::db::db2ANSI
00DBD::mysql::db::foreign_key_info
00DBD::mysql::db::get_info
00DBD::mysql::db::prepare
00DBD::mysql::db::primary_key_info
00DBD::mysql::db::table_info
00DBD::mysql::dr::BEGIN
00DBD::mysql::dr::admin
00DBD::mysql::dr::connect
00DBD::mysql::dr::data_sources
00DBD::mysql::driver
00DBD::mysql::st::BEGIN

LineStmts.Exclusive
Time
Avg.Code
1# -*- cperl -*-
2
3package DBD::mysql;
4use strict;
5use vars qw(@ISA $VERSION $err $errstr $drh);
6
7use DBI ();
8use DynaLoader();
9use Carp ();
10@ISA = qw(DynaLoader);
11
12$VERSION = '4.005';
13
14bootstrap DBD::mysql $VERSION;
15
16
17$err = 0; # holds error code for DBI::err
18$errstr = ""; # holds error string for DBI::errstr
19$drh = undef; # holds driver handle once initialised
20
21sub driver{
22 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
28 $drh = DBI::_new_drh($class, { 'Name' => 'mysql',
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
42sub _OdbcParse($$$) {
43 my($class, $dsn, $hash, $args) = @_;
44 my($var, $val);
45 if (!defined($dsn)) {
46 return;
47 }
48 while (length($dsn)) {
49 if ($dsn =~ /([^:;]*)[:;](.*)/) {
50 $val = $1;
51 $dsn = $2;
52 } else {
53 $val = $dsn;
54 $dsn = '';
55 }
56 if ($val =~ /([^=]*)=(.*)/) {
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
951;
96
97
98package DBD::mysql::dr; # ====== DRIVER ======
99use strict;
100use DBI qw(:sql_types);
101use DBI::Const::GetInfoType;
102
103sub connect {
104 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
123 DBD::mysql->_OdbcParse($dsn, $privateAttrHash,
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
133 if (!defined($this = DBI::_new_dbh($drh,
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.
142 DBD::mysql::db::_login($this, $dsn, $username, $password)
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 ======
186use strict;
187use DBI qw(:sql_types);
188
189%DBD::mysql::db::db2ANSI = ("INT" => "INTEGER",
190 "CHAR" => "CHAR",
191 "REAL" => "REAL",
192 "IDENT" => "DECIMAL"
193 );
194
195### ANSI datatype mapping to mSQL datatypes
196%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
217sub prepare {
2187840.003064e-06 my($dbh, $statement, $attribs)= @_;
219
220 # create a 'blank' dbh
221 my $sth = DBI::_new_sth($dbh, {'Statement' => $statement});
# spent 0.00670s making 196 calls to DBI::_new_sth, avg 0.00003s/call
222
223 # Populate internal handle data.
224 if (!DBD::mysql::st::_prepare($sth, $statement, $attribs)) {
# spent 0.00131s making 196 calls to DBD::mysql::st::_prepare, avg 7e-06s/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
735
736
737package DBD::mysql::st; # ====== STATEMENT ======
738use strict;
739
7401;
741
742__END__
743
744=pod
745
746=head1 NAME
747
748DBD::mysql - MySQL driver for the Perl5 Database Interface (DBI)
749
750=head1 SYNOPSIS
751
752 use DBI;
753
754 $dsn = "DBI:mysql:database=$database;host=$hostname;port=$port";
755
756 $dbh = DBI->connect($dsn, $user, $password);
757
758
759 $drh = DBI->install_driver("mysql");
760 @databases = DBI->data_sources("mysql");
761 or
762 @databases = DBI->data_sources("mysql",
763 {"host" => $host, "port" => $port, "user" => $user, password => $pass});
764
765 $sth = $dbh->prepare("SELECT * FROM foo WHERE bla");
766 or
767 $sth = $dbh->prepare("LISTFIELDS $table");
768 or
769 $sth = $dbh->prepare("LISTINDEX $table $index");
770 $sth->execute;
771 $numRows = $sth->rows;
772 $numFields = $sth->{'NUM_OF_FIELDS'};
773 $sth->finish;
774
775 $rc = $drh->func('createdb', $database, $host, $user, $password, 'admin');
776 $rc = $drh->func('dropdb', $database, $host, $user, $password, 'admin');
777 $rc = $drh->func('shutdown', $host, $user, $password, 'admin');
778 $rc = $drh->func('reload', $host, $user, $password, 'admin');
779
780 $rc = $dbh->func('createdb', $database, 'admin');
781 $rc = $dbh->func('dropdb', $database, 'admin');
782 $rc = $dbh->func('shutdown', 'admin');
783 $rc = $dbh->func('reload', 'admin');
784
785
786=head1 EXAMPLE
787
788 #!/usr/bin/perl
789
790 use strict;
791 use DBI();
792
793 # Connect to the database.
794 my $dbh = DBI->connect("DBI:mysql:database=test;host=localhost",
795 "joe", "joe's password",
796 {'RaiseError' => 1});
797
798 # Drop table 'foo'. This may fail, if 'foo' doesn't exist.
799 # Thus we put an eval around it.
800 eval { $dbh->do("DROP TABLE foo") };
801 print "Dropping foo failed: $@\n" if $@;
802
803 # Create a new table 'foo'. This must not fail, thus we don't
804 # catch errors.
805 $dbh->do("CREATE TABLE foo (id INTEGER, name VARCHAR(20))");
806
807 # INSERT some data into 'foo'. We are using $dbh->quote() for
808 # quoting the name.
809 $dbh->do("INSERT INTO foo VALUES (1, " . $dbh->quote("Tim") . ")");
810
811 # Same thing, but using placeholders
812 $dbh->do("INSERT INTO foo VALUES (?, ?)", undef, 2, "Jochen");
813
814 # Now retrieve data from the table.
815 my $sth = $dbh->prepare("SELECT * FROM foo");
816 $sth->execute();
817 while (my $ref = $sth->fetchrow_hashref()) {
818 print "Found a row: id = $ref->{'id'}, name = $ref->{'name'}\n";
819 }
820 $sth->finish();
821
822 # Disconnect from the database.
823 $dbh->disconnect();
824
825
826=head1 DESCRIPTION
827
828B<DBD::mysql> is the Perl5 Database Interface driver for the MySQL
829database. In other words: DBD::mysql is an interface between the Perl
830programming language and the MySQL programming API that comes with
831the MySQL relational database management system. Most functions
832provided by this programming API are supported. Some rarely used
833functions are missing, mainly because noone ever requested
834them. :-)
835
836In what follows we first discuss the use of DBD::mysql,
837because this is what you will need the most. For installation, see the
838sections on L<INSTALLATION>, and L<WIN32 INSTALLATION>
839below. See L<EXAMPLE> for a simple example above.
840
841From perl you activate the interface with the statement
842
843 use DBI;
844
845After that you can connect to multiple MySQL database servers
846and send multiple queries to any of them via a simple object oriented
847interface. Two types of objects are available: database handles and
848statement handles. Perl returns a database handle to the connect
849method like so:
850
851 $dbh = DBI->connect("DBI:mysql:database=$db;host=$host",
852 $user, $password, {RaiseError => 1});
853
854Once you have connected to a database, you can can execute SQL
855statements with:
856
857 my $query = sprintf("INSERT INTO foo VALUES (%d, %s)",
858 $number, $dbh->quote("name"));
859 $dbh->do($query);
860
861See L<DBI(3)> for details on the quote and do methods. An alternative
862approach is
863
864 $dbh->do("INSERT INTO foo VALUES (?, ?)", undef,
865 $number, $name);
866
867in which case the quote method is executed automatically. See also
868the bind_param method in L<DBI(3)>. See L<DATABASE HANDLES> below
869for more details on database handles.
870
871If you want to retrieve results, you need to create a so-called
872statement handle with:
873
874 $sth = $dbh->prepare("SELECT * FROM $table");
875 $sth->execute();
876
877This statement handle can be used for multiple things. First of all
878you can retreive a row of data:
879
880 my $row = $sth->fetchrow_hashref();
881
882If your table has columns ID and NAME, then $row will be hash ref with
883keys ID and NAME. See L<STATEMENT HANDLES> below for more details on
884statement handles.
885
886But now for a more formal approach:
887
888
889=head2 Class Methods
890
891=over
892
893=item B<connect>
894
895 use DBI;
896
897 $dsn = "DBI:mysql:$database";
898 $dsn = "DBI:mysql:database=$database;host=$hostname";
899 $dsn = "DBI:mysql:database=$database;host=$hostname;port=$port";
900
901 $dbh = DBI->connect($dsn, $user, $password);
902
903A C<database> must always be specified.
904
905=over
906
907=item host
908
909=item port
910
911The hostname, if not specified or specified as '' or 'localhost', will
912default to a MySQL server running on the local machine using the default for
913the UNIX socket. To connect to a MySQL server on the local machine via TCP,
914you must specify the loopback IP address (127.0.0.1) as the host.
915
916Should the MySQL server be running on a non-standard port number,
917you may explicitly state the port number to connect to in the C<hostname>
918argument, by concatenating the I<hostname> and I<port number> together
919separated by a colon ( C<:> ) character or by using the C<port> argument.
920
921To connect to a MySQL server on localhost using TCP/IP, you must specify the
922hostname as 127.0.0.1 (with the optional port).
923
924=item mysql_client_found_rows
925
926Enables (TRUE value) or disables (FALSE value) the flag CLIENT_FOUND_ROWS
927while connecting to the MySQL serve