# -*- cperl -*- package DBD::mysql; use strict; use vars qw(@ISA $VERSION $err $errstr $drh); use DBI (); use DynaLoader(); use Carp (); @ISA = qw(DynaLoader); $VERSION = '2.1018'; bootstrap DBD::mysql $VERSION; $err = 0; # holds error code for DBI::err $errstr = ""; # holds error string for DBI::errstr $drh = undef; # holds driver handle once initialised sub driver{ return $drh if $drh; my($class, $attr) = @_; $class .= "::dr"; # not a 'my' since we use it above to prevent multiple drivers $drh = DBI::_new_drh($class, { 'Name' => 'mysql', 'Version' => $VERSION, 'Err' => \$DBD::mysql::err, 'Errstr' => \$DBD::mysql::errstr, 'Attribution' => 'DBD::mysql by Jochen Wiedmann' }); $drh; } sub _OdbcParse($$$) { my($class, $dsn, $hash, $args) = @_; my($var, $val); if (!defined($dsn)) { return; } while (length($dsn)) { if ($dsn =~ /([^:;]*)[:;](.*)/) { $val = $1; $dsn = $2; } else { $val = $dsn; $dsn = ''; } if ($val =~ /([^=]*)=(.*)/) { $var = $1; $val = $2; if ($var eq 'hostname' || $var eq 'host') { $hash->{'host'} = $val; } elsif ($var eq 'db' || $var eq 'dbname') { $hash->{'database'} = $val; } else { $hash->{$var} = $val; } } else { foreach $var (@$args) { if (!defined($hash->{$var})) { $hash->{$var} = $val; last; } } } } } sub _OdbcParseHost ($$) { my($class, $dsn) = @_; my($hash) = {}; $class->_OdbcParse($dsn, $hash, ['host', 'port']); ($hash->{'host'}, $hash->{'port'}); } sub AUTOLOAD { my ($meth) = $DBD::mysql::AUTOLOAD; my ($smeth) = $meth; $smeth =~ s/(.*)\:\://; my $val = constant($smeth, @_ ? $_[0] : 0); if ($! == 0) { eval "sub $meth { $val }"; return $val; } Carp::croak "$meth: Not defined"; } 1; package DBD::mysql::dr; # ====== DRIVER ====== use strict; sub connect { my($drh, $dsn, $username, $password, $attrhash) = @_; my($port); my($cWarn); # Avoid warnings for undefined values $username ||= ''; $password ||= ''; # create a 'blank' dbh my($this, $privateAttrHash); $privateAttrHash = { 'Name' => $dsn, 'user' => $username, 'password' => $password }; DBD::mysql->_OdbcParse($dsn, $privateAttrHash, ['database', 'host', 'port']); if (!defined($this = DBI::_new_dbh($drh, {'Name' => $dsn}, $privateAttrHash))) { return undef; } # Call msqlConnect func in mSQL.xs file # and populate internal handle data. DBD::mysql::db::_login($this, $dsn, $username, $password) or $this = undef; $this; } sub data_sources { my($self) = shift; my(@dsn) = $self->func('', '_ListDBs'); my($i); for ($i = 0; $i < @dsn; $i++) { $dsn[$i] = "DBI:mysql:$dsn[$i]"; } @dsn; } sub admin { my($drh) = shift; my($command) = shift; my($dbname) = ($command eq 'createdb' || $command eq 'dropdb') ? shift : ''; my($host, $port) = DBD::mysql->_OdbcParseHost(shift(@_) || ''); my($user) = shift || ''; my($password) = shift || ''; $drh->func(undef, $command, $dbname || '', $host || '', $port || '', $user, $password, '_admin_internal'); } package DBD::mysql::db; # ====== DATABASE ====== use strict; %DBD::mysql::db::db2ANSI = ("INT" => "INTEGER", "CHAR" => "CHAR", "REAL" => "REAL", "IDENT" => "DECIMAL" ); ### ANSI datatype mapping to mSQL datatypes %DBD::mysql::db::ANSI2db = ("CHAR" => "CHAR", "VARCHAR" => "CHAR", "LONGVARCHAR" => "CHAR", "NUMERIC" => "INTEGER", "DECIMAL" => "INTEGER", "BIT" => "INTEGER", "TINYINT" => "INTEGER", "SMALLINT" => "INTEGER", "INTEGER" => "INTEGER", "BIGINT" => "INTEGER", "REAL" => "REAL", "FLOAT" => "REAL", "DOUBLE" => "REAL", "BINARY" => "CHAR", "VARBINARY" => "CHAR", "LONGVARBINARY" => "CHAR", "DATE" => "CHAR", "TIME" => "CHAR", "TIMESTAMP" => "CHAR" ); sub prepare { my($dbh, $statement, $attribs)= @_; # create a 'blank' dbh my $sth = DBI::_new_sth($dbh, {'Statement' => $statement}); # Populate internal handle data. if (!DBD::mysql::st::_prepare($sth, $statement, $attribs)) { $sth = undef; } $sth; } sub db2ANSI { my $self = shift; my $type = shift; return $DBD::mysql::db::db2ANSI{"$type"}; } sub ANSI2db { my $self = shift; my $type = shift; return $DBD::mysql::db::ANSI2db{"$type"}; } sub admin { my($dbh) = shift; my($command) = shift; my($dbname) = ($command eq 'createdb' || $command eq 'dropdb') ? shift : ''; $dbh->{'Driver'}->func($dbh, $command, $dbname, '', '', '', '_admin_internal'); } sub _SelectDB ($$) { die "_SelectDB is removed from this module; use DBI->connect instead."; } { my $names = ['TABLE_CAT', 'TABLE_SCHEM', 'TABLE_NAME', 'TABLE_TYPE', 'REMARKS']; sub table_info ($) { my $dbh = shift; my $sth = $dbh->prepare("SHOW TABLES"); return undef unless $sth; if (!$sth->execute()) { return DBI::set_err($dbh, $sth->err(), $sth->errstr()); } my @tables; while (my $ref = $sth->fetchrow_arrayref()) { push(@tables, [ undef, undef, $ref->[0], 'TABLE', undef ]); } my $dbh2; if (!($dbh2 = $dbh->{'~dbd_driver~_sponge_dbh'})) { $dbh2 = $dbh->{'~dbd_driver~_sponge_dbh'} = DBI->connect("DBI:Sponge:"); if (!$dbh2) { DBI::set_err($dbh, 1, $DBI::errstr); return undef; } } my $sth2 = $dbh2->prepare("SHOW TABLES", { 'rows' => \@tables, 'NAME' => $names, 'NUM_OF_FIELDS' => 5 }); if (!$sth2) { DBI::set_err($sth2, $dbh2->err(), $dbh2->errstr()); } $sth2; } } sub _ListTables { my $dbh = shift; if (!$DBD::mysql::QUIET) { warn "_ListTables is deprecated, use \$dbh->tables()"; } return map { $_ =~ s/.*\.//; $_ } $dbh->tables(); } package DBD::mysql::st; # ====== STATEMENT ====== use strict; 1;