Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

passing the first 20 mysql tests for create, drop, insert, delete (NO…

…T select)
  • Loading branch information...
commit 720e7892c9e307bb3540eeac1504a985802ba6d3 1 parent e9ee1a6
Martin Berends authored
View
3  Makefile
@@ -10,6 +10,9 @@ TEST_F = $(PERL_EXE) -MExtUtils::Command -e test_f
LIBSYSTEM = $(shell $(PERL6_EXE) -e 'print @*INC[2]')
LIBUSER = $(shell $(PERL6_EXE) -e 'print @*INC[1]')
+# first (therefore default) target is FakeDBI.pir
+all: lib/FakeDBI.pir
+
lib/FakeDBD.pir: lib/FakeDBD.pm6
$(PERL6_EXE) --target=pir --output=lib/FakeDBD.pir lib/FakeDBD.pm6
View
28 README
@@ -4,21 +4,31 @@
FakeDBI - an interim database interface for Rakudo Perl 6
=head1 DESCRIPTION
-According to reports in perl6-language and #perl6, the DBI for Rakudo
-Perl 6 will use a Parrot based database driver interface (DBDI). See
+The roadmap for DBI v2 L<http://search.cpan.org/~timb/DBI/Roadmap.pod>
+published in November 2004 laid out the plans for Perl 5 and 6.
+Specifically there is a Parrot DBDI project that will give the same DBD
+facilities to any Parrot based language. See also
http://www.nntp.perl.org/group/perl.perl6.language/2005/07/msg22054.html
-Experience with Perl 5 DBI and DBD's motivated changes in the
-architecture, so the new DBDI will be like Java's JDBC. Because no code
-is available yet, this project wants to temporarily fill the gap, just
-copying the Perl 5 interface.
+Because no code is available yet, this project plans to temporarily fill
+the gap, by imitating the classic DBI interface. Although this is not
+on the roadmap, let's say if it looks like a DBI, and it talks like a
+DBI, then it is a DBI.
+
+=head1 DBD CLASSES
+Whilst it is convenient, the FakeDBD drivers stay together with the
+FakeDBI files in a single project. In future each FakeDBD may become a
+separate project, although this conflicts a bit with the idea of being
+"temporary".
=head1 SEE ALSO
-The more extensive L<doc:FakeDBI> docs.
+The Perl 6 Pod in the L<doc:FakeDBI> module.
The Perl 5 L<doc:DBI> and L<doc:DBI::DBD>.
-This README is in Pod6 format, view it with an appropriate formatter if
-your system has one.
+The documention of the FakeDBI and the FakeDBD modules, and also this
+README, is in the proposed Pod6 format, with the intention of increasing
+experience with its use. View it with an appropriate formatter if your
+system has one.
=head1 LICENSE and COPYRIGHT
Use these files at your risk and without warranty. Give due credit if
View
25 lib/FakeDBD.pm6
@@ -1,10 +1,25 @@
-role FakeDBD {
- has $.name;
- has $.handle is rw;
+# FakeDBD.pm6
+# Provide default methods for all database drivers
+
+role FakeDBD::StatementHandle {
+ has $!errstr;
+ method errstr() {
+ return $!errstr;
+ }
+}
+
+role FakeDBD::Connection {
+ has $!errstr;
+ method disconnect() {
+ # warn "in FakeDBI::DatabaseHandle.disconnect()";
+ return Bool::True;
+ }
+ method errstr() {
+ return $!errstr;
+ }
method do( Str $statement, *@params ) {
+ # warn "in FakeDBD::Connection.do('$statement')";
my $sth = self.prepare($statement) or return fail();
$sth.execute(@params) or return fail();
- my $rows = $sth.rows;
- ($rows == 0) ?? "0E0" !! $rows;
}
}
View
123 lib/FakeDBD/mysql.pm6
@@ -1,43 +1,7 @@
-# FakeDBD::mysql.pm
+# FakeDBD::mysql.pm6
use NativeCall; # from project 'zavolaj'
-use FakeDBD;
-
-class FakeDBD::mysql:auth<mberends>:ver<0.0.1> does FakeDBD {
-
- has $.Version = 0.01;
- has $!mysql_client;
- has $!mysql_error;
- has $!statement;
-
-#------------------------- methods used by DBI -------------------------
- method connect( Str $user, Str $password, Str $params ) {
- # warn "entering FakeDBD::mysql.connect()";
- unless defined $!mysql_client {
- $!mysql_client = mysql_init( pir::null__P() );
- $!mysql_error = mysql_error( $!mysql_client );
- }
- my @params = $params.split(';');
- my %params;
- for @params -> $p {
- my ( $key, $value ) = $p.split('=');
- %params{$key} = $value;
- }
- my $host = %params<host> // 'localhost';
- my $port = %params<port> // 0;
- my $database = %params<database> // 'mysql';
- my $socket = Mu;
- my $flag = Mu;
- mysql_real_connect( $!mysql_client, $host, $user, $password,
- $database, $port, pir::null__P(), 0 );
- }
- method prepare( Str $statement ) {
- $!statement = $statement;
- }
-
- method execute(Str $statement) {
- mysql_query( $!statement );
- }
+use FakeDBD; # roles for drivers
#------------ mysql library functions in alphabetical order ------------
@@ -138,10 +102,87 @@ sub mysql_use_result( OpaquePointer $mysql_client )
is native('libmysqlclient')
{ ... }
+#---------------------------
+
+class FakeDBD::mysql::StatementHandle does FakeDBD::StatementHandle {
+ has $!mysql_client;
+ has $!statement;
+ has $!result_set;
+ has $!row_count;
+ method execute(*@params) {
+ # warn "in FakeDBD::mysql::StatementHandle.execute()";
+ mysql_query( $!mysql_client, $!statement );
+ return Bool::True;
+ }
+ method fetchrow_arrayref() {
+ my $row_data;
+ unless defined $!result_set {
+ $!result_set = mysql_use_result( $!mysql_client);
+ $!row_count = mysql_num_rows($!result_set);
+ }
+ if $!row_count != 0 {
+ $row_data = [ mysql_fetch_row($!result_set) ];
+ }
+ return $row_data;
+ }
+ method finish() {
+ $!result_set = Mu;
+ }
+}
+
+class FakeDBD::mysql::Connection does FakeDBD::Connection {
+ has $!mysql_client;
+ method prepare( Str $statement ) {
+ # warn "in FakeDBD::mysql::Connection.prepare()";
+ my $statement_handle = FakeDBD::mysql::StatementHandle.bless(
+ FakeDBD::mysql::StatementHandle.CREATE(),
+ mysql_client => $!mysql_client,
+ statement => $statement
+ );
+ return $statement_handle;
+ }
+}
+
+class FakeDBD::mysql:auth<mberends>:ver<0.0.1> {
+
+ has $.Version = 0.01;
+
+#------------------ methods to be called from FakeDBI ------------------
+ method connect( Str $user, Str $password, Str $params ) {
+ # warn "in FakeDBD::mysql.connect('$user',*,'$params')";
+ my ( $mysql_client, $mysql_error );
+ unless defined $mysql_client {
+ $mysql_client = mysql_init( pir::null__P() );
+ $mysql_error = mysql_error( $mysql_client );
+ }
+ my @params = $params.split(';');
+ my %params;
+ for @params -> $p {
+ my ( $key, $value ) = $p.split('=');
+ %params{$key} = $value;
+ }
+ my $host = %params<host> // 'localhost';
+ my $port = %params<port> // 0;
+ my $database = %params<database> // 'mysql';
+ # real_connect() returns either the same client pointer or null
+ my $result = mysql_real_connect( $mysql_client, $host,
+ $user, $password, $database, $port, pir::null__P(), 0 );
+ my $error = mysql_error( $mysql_client );
+ my $connection;
+ if $error eq '' {
+ $connection = FakeDBD::mysql::Connection.bless(
+ FakeDBD::mysql::Connection.CREATE(),
+ mysql_client => $mysql_client
+ );
+ }
+ return $connection;
+ }
}
# warn "module FakeDBD::mysql.pm has loaded";
+=begin pod
+
# 'zavolaj' is a Native Call Interface for Rakudo/Parrot. 'FakeDBI' and
# 'FakeDBD::mysql' are Perl 6 modules that use 'zavolaj' to use the
# standard mysqlclient library. There is a long term Parrot based
@@ -149,3 +190,9 @@ sub mysql_use_result( OpaquePointer $mysql_client )
# and Perl 6. FakeDBI is not that, it is a naive rewrite of the
# similarly named Perl 5 modules. Hence the 'Fake' part of the name.
+=head1 SEE ALSO
+The MySQL 5.1 Reference Manual, C API.
+L<http://dev.mysql.com/doc/refman/5.1/en/c-api-function-overview.html>
+
+=end pod
+
View
66 lib/FakeDBI.pm6
@@ -1,60 +1,48 @@
-# FakeDBI.pm
+# FakeDBI.pm6
-class FakeDBI::StatementHandle {
- has $!statement;
- method execute(*@params) {
- }
-}
-
-class FakeDBI::DatabaseHandle {
- has $!driver;
- method disconnect() {
- # warn "disconnecting...\n";
- return Bool::True;
- }
- method prepare( Str $statement ) {
- warn "entering FakeDBI::DatabaseHandle.prepare()";
- }
-}
+#class FakeDBI::DatabaseHandle {
+# has $!driver;
+# has $.connection;
+# method prepare( Str $statement ) {
+# warn "in FakeDBI::DatabaseHandle.prepare()";
+# my $statement_handle = FakeDBI::StatementHandle.bless(
+# FakeDBI::StatementHandle.CREATE(),
+# database_handle => self,
+# statement => $statement
+# );
+# return $statement_handle;
+# }
+#}
class FakeDBI:auth<mberends>:ver<0.0.1> {
-# my $!error_string;
method connect( $dsn, $username, $password ) {
- # warn "entering FakeDBI.connect('$dsn')";
+ # warn "in FakeDBI.connect('$dsn')";
# Divide $dsn up into its separate fields.
my ( $prefix, $drivername, $params ) = $dsn.split(':');
- # warn "connecting prefix=$prefix driver=$drivername";
- my $driver = self.install_driver( "$drivername" );
- $driver.connect( $username, $password, $params );
- my $handle = FakeDBI::DatabaseHandle.bless(
- FakeDBI::DatabaseHandle.CREATE(),
- driver => $driver
- );
- return $handle;
+ my $driver = self.install_driver( $drivername );
+ # warn "calling FakeDBD::" ~ $drivername ~ ".connect($username,*,$params)";
+ my $connection = $driver.connect( $username, $password, $params );
+ return $connection;
}
method install_driver( $drivername ) {
- # warn "begin FakeDBI.install_driver('$drivername')";
+ # warn "in FakeDBI.install_driver('$drivername')";
my $result;
# the need($n, {} ) argument would be a hash of named argements,
# but it dies with: get_pmc_keyed() not implemented in class ''
# Perl6::Module::Loader.need( "FakeDBD::$drivername", {} );
$result = Perl6::Module::Loader.need( "FakeDBD::$drivername" );
unless $result {
-# $error_string = "install_driver cannot load FakeDBD::$drivername";
- die "install_driver cannot load FakeDBD::$drivername";
+ warn "install_driver cannot load FakeDBD::$drivername in $*PROGRAM_NAME";
+ exit( 1 ); # instead of dying with an unnecessary stack trace
}
- my $dr;
+ my $driver;
given $drivername {
- when 'mysql' { use FakeDBD::mysql; $dr = FakeDBD::mysql.new(); }
- default { die "driver name '$drivername' is not known"; }
+ when 'mysql' { use FakeDBD::mysql; $driver = FakeDBD::mysql.new(); }
+ default { die "driver name '$drivername' is not known"; }
}
- return $dr;
- }
- method data_sources( $driver, %params? ) {
- my @databases = ();
- return @databases;
+ return $driver;
}
method errstr() {
-# return $error_string;
+# return $!errstr;
}
}
View
349 t/10-mysql.t
@@ -16,60 +16,39 @@
use Test;
-plan 5;
+plan 20;
use FakeDBI;
# The file 'lib.pl' customizes the testing environment per DBD, but all
# this test script currently needs is the variables listed here.
-my $hostname = 'localhost';
-my $port = 3306;
-my $database = 'zavolaj';
+my $mdriver = 'mysql';
+my $hostname = 'localhost';
+my $port = 3306;
+my $database = 'zavolaj';
my $test_user = 'testuser';
my $test_password = 'testpass';
-my $test_dsn = "FakeDBI:mysql:database=$database;host=$hostname;port=$port";
-my $table = 't1';
+my $test_dsn = "FakeDBI:$mdriver" ~ ":database=$database;" ~
+ "host=$hostname;port=$port";
+my $table = 't1';
#-----------------------------------------------------------------------
# from perl5 DBD/mysql/t/00base.t
-##!perl -w
-##
-## $Id: 00base.t 11244 2008-05-11 15:13:10Z capttofu $
-##
-## This is the base test, tries to install the drivers. Should be
-## executed as the very first test.
-##
-#
#use Test::More tests => 6;
-#
-##
-## Include lib.pl
-##
-#use vars qw($mdriver $table);
-#use lib 't', '.';
-#require 'lib.pl';
-#
## Base DBD Driver Test
#BEGIN {
# use_ok('DBI') or BAIL_OUT "Unable to load DBI";
# use_ok('DBD::mysql') or BAIL_OUT "Unable to load DBD::mysql";
#}
-#
#$switch = DBI->internal;
#cmp_ok ref $switch, 'eq', 'DBI::dr', 'Internal set';
-#
## This is a special case. install_driver should not normally be used.
#$drh= DBI->install_driver($mdriver);
-#
#ok $drh, 'Install driver';
-#
#cmp_ok ref $drh, 'eq', 'DBI::dr', 'DBI::dr set';
-#
#ok $drh->{Version}, "Version $drh->{Version}";
#print "Driver version is ", $drh->{Version}, "\n";my $mdriver = 'mysql';
-#
-my $mdriver = 'mysql';
-my $drh = Mu;
+my $drh;
$drh = FakeDBI.install_driver($mdriver);
ok $drh, 'Install driver'; # test 1
my $drh_version;
@@ -78,196 +57,198 @@ ok $drh_version > 0, "FakeDBD::mysql version $drh_version"; # test 2
#-----------------------------------------------------------------------
# from perl5 DBD/mysql/t/10connect.t
-##!perl -w
-## vim: ft=perl
-#
-#use Test::More ;
-#use DBI;
-#use DBI::Const::GetInfoType;
-#use strict;
-#use vars qw($mdriver);
-#$|= 1;
-#
-#use vars qw($test_dsn $test_user $test_password);
-#use lib 't', '.';
-#require 'lib.pl';
-#
-#my $dbh;
-#eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
-# { RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
-#
-#if ($@) {
-# plan skip_all => "ERROR: $DBI::errstr Can't continue test";
-#}
#plan tests => 2;
-#
#ok defined $dbh, "Connected to database";
-#
-#ok $dbh->disconnect();##!perl -w
+#ok $dbh->disconnect();
#
my $dbh;
-#try {
- $dbh = FakeDBI.connect( $test_dsn, $test_user, $test_password
-# ,RaiseError => 1, PrintError => 1, AutoCommit => 0
+try {
+ $dbh = FakeDBI.connect( $test_dsn, $test_user, $test_password,
+ RaiseError => 1, PrintError => 1, AutoCommit => 0
);
-# CATCH { die "ERROR: {FakeDBI.errstr}. Can't continue test"; }
-#}
-ok defined $dbh, 'Connected to database'; # test 3
+# CATCH { die "ERROR: {FakeDBI.errstr}. Can't continue test"; }
+}
+ok defined $dbh, "Connected to database"; # test 3
my $result = $dbh.disconnect();
ok $result, 'disconnect returned true'; # test 4
#-----------------------------------------------------------------------
# from perl5 DBD/mysql/t/20createdrop.t
+#plan tests => 4;
+#ok(defined $dbh, "Connected to database");
+#ok($dbh->do("DROP TABLE IF EXISTS $table"), "making slate clean");
+#ok($dbh->do("CREATE TABLE $table (id INT(4), name VARCHAR(64))"), "creating $table");
+#ok($dbh->do("DROP TABLE $table"), "dropping created $table");
+#$dbh->disconnect();
+
+try {
+ $dbh = FakeDBI.connect( $test_dsn, $test_user, $test_password,
+ RaiseError => 1, PrintError => 1, AutoCommit => 0 );
+# CATCH { die "ERROR: {FakeDBI.errstr}. Can't continue test\n"; }
+}
+ok(defined $dbh, "Connected to database"); # test 5
+ok($dbh.do("DROP TABLE IF EXISTS $table"), "making slate clean"); # test 6
+ok($dbh.do("CREATE TABLE $table (id INT(4), name VARCHAR(64))"), "creating $table"); # test 7
+ok($dbh.do("DROP TABLE $table"), "dropping created $table"); # test 8
+
+#-----------------------------------------------------------------------
+# from perl5 DBD/mysql/t/25lockunlock.t
+#plan tests => 13;
+#my $create= <<EOT;
+#CREATE TABLE $table (
+# id int(4) NOT NULL default 0,
+# name varchar(64) NOT NULL default ''
+# )
+#EOT
+#ok $dbh->do("DROP TABLE IF EXISTS $table"), "drop table if exists $table";
+#ok $dbh->do($create), "create table $table";
+#ok $dbh->do("LOCK TABLES $table WRITE"), "lock table $table";
+#ok $dbh->do("INSERT INTO $table VALUES(1, 'Alligator Descartes')"), "Insert ";
+#ok $dbh->do("DELETE FROM $table WHERE id = 1"), "Delete";
+#my $sth;
+#eval {$sth= $dbh->prepare("SELECT * FROM $table WHERE id = 1")};
+#ok !$@, "Prepare of select";
+#ok defined($sth), "Prepare of select";
+#ok $sth->execute , "Execute";
+#my ($row, $errstr);
+#$row = $sth->fetchrow_arrayref;
+#$errstr= $sth->errstr;
+#ok !defined($row), "Fetch should have failed";
+#ok !defined($errstr), "Fetch should have failed";
+#ok $dbh->do("UNLOCK TABLES"), "Unlock tables";
+#ok $dbh->do("DROP TABLE $table"), "Drop table $table";
+#ok $dbh->disconnect, "Disconnecting";
+my $create="
+CREATE TABLE $table (
+ id int(4) NOT NULL default 0,
+ name varchar(64) NOT NULL default ''
+)
+";
+ok $dbh.do("DROP TABLE IF EXISTS $table"), "drop table if exists $table"; # test 9
+ok $dbh.do($create), "create table $table";
+ok $dbh.do("LOCK TABLES $table WRITE"), "lock table $table";
+ok $dbh.do("INSERT INTO $table VALUES(1, 'Alligator Descartes')"), "Insert ";
+ok $dbh.do("DELETE FROM $table WHERE id = 1"), "Delete";
+my $sth;
+try {
+ $sth= $dbh.prepare("SELECT * FROM $table WHERE id = 1");
+}
+ok defined($sth), "Prepare of select";
+ok $sth.execute , "Execute";
+my ($row, $errstr);
+$row = $sth.fetchrow_arrayref;
+$errstr= $sth.errstr;
+ok !defined($row), "Fetch should have failed";
+ok !defined($errstr), "Fetch should have failed";
+ok $dbh.do("UNLOCK TABLES"), "Unlock tables";
+ok $dbh.do("DROP TABLE $table"), "Drop table $table";
+ok $dbh.disconnect, "Disconnecting";
+
+#-----------------------------------------------------------------------
+# from perl5 DBD/mysql/t/29warnings.t
+##!perl -w
+## vim: ft=perl
+#
+#use Test::More;
#use DBI;
#use DBI::Const::GetInfoType;
+#use lib '.', 't';
+#require 'lib.pl';
#use strict;
#$|= 1;
#
#use vars qw($table $test_dsn $test_user $test_password);
-#use lib 't', '.';
-#require 'lib.pl';
#
#my $dbh;
#eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
-# { RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
+# { RaiseError => 1, PrintError => 1, AutoCommit => 0});};
#
#if ($@) {
-# plan skip_all => "ERROR: $DBI::errstr. Can't continue test";
+# plan skip_all => "ERROR: $@. Can't continue test";
#}
-#plan tests => 4;
+#plan tests => 4;
#
#ok(defined $dbh, "Connected to database");
#
-#ok($dbh->do("DROP TABLE IF EXISTS $table"), "making slate clean");
+#SKIP: {
+# skip "Server doesn't report warnings", 3
+# if $dbh->get_info($GetInfoType{SQL_DBMS_VER}) lt "4.1";
#
-#ok($dbh->do("CREATE TABLE $table (id INT(4), name VARCHAR(64))"), "creating $table");
+# my $sth;
+# ok($sth= $dbh->prepare("DROP TABLE IF EXISTS no_such_table"));
+# ok($sth->execute());
#
-#ok($dbh->do("DROP TABLE $table"), "dropping created $table");
+# is($sth->{mysql_warning_count}, 1);
+#};
#
-#$dbh->disconnect();
-
-#try {
- $dbh = FakeDBI.connect( $test_dsn, $test_user, $test_password #,
-# RaiseError => 1, PrintError => 1, AutoCommit => 0
- );
-# CATCH { die "ERROR: {FakeDBI.errstr}. Can't continue test"; }
-#}
-ok( defined $dbh, "Connected to database"); # test 5
-#ok( $dbh.do("DROP TABLE IF EXISTS $table"), "making slate clean"); # test 6
-$dbh.disconnect;
-
-=begin pod
-
-#-----------------------------------------------------------------------
-# from perl5 DBD/mysql/t/25lockunlock.t
-# (missing - file seems to contain 30insertfetch
-
-#-----------------------------------------------------------------------
-# from perl5 DBD/mysql/t/29warnings.t
+#$dbh->disconnect;
#-----------------------------------------------------------------------
# from perl5 DBD/mysql/t/30insertfetch.t
+## This is a simple insert/fetch test.
+##
+#plan tests => 13;
+#
+#my $create= <<EOT;
+#CREATE TABLE $table (
+# id int(4) NOT NULL default 0,
+# name varchar(64) NOT NULL default ''
+# )
+#EOT
+#
+#ok $dbh->do("DROP TABLE IF EXISTS $table"), "drop table if exists $table";
+#ok $dbh->do($create), "create table $table";
+#ok $dbh->do("LOCK TABLES $table WRITE"), "lock table $table";
+#ok $dbh->do("INSERT INTO $table VALUES(1, 'Alligator Descartes')"), "Insert ";
+#ok $dbh->do("DELETE FROM $table WHERE id = 1"), "Delete";
+#my $sth;
+#eval {$sth= $dbh->prepare("SELECT * FROM $table WHERE id = 1")};
+#ok !$@, "Prepare of select";
+#ok defined($sth), "Prepare of select";
+#ok $sth->execute , "Execute";
+#my ($row, $errstr);
+#$errstr= '';
+#$row = $sth->fetchrow_arrayref;
+#$errstr= $sth->errstr;
+#ok !defined($row), "Fetch should have failed";
+#ok !defined($errstr), "Fetch should have failed";
+#ok $dbh->do("UNLOCK TABLES"), "Unlock tables";
+#ok $dbh->do("DROP TABLE $table"), "Drop table $table";
+#ok $dbh->disconnect, "Disconnecting";
-#!perl -w
-#
-# $Id: 30insertfetch.t 1228 2004-09-04 01:23:38Z capttofu $
-#
-# This is a simple insert/fetch test.
-#
-use Test::More;
-use DBI ();
-use strict;
-use lib 't', '.';
-require 'lib.pl';
-
-#
-# Make -w happy
-#
-use vars qw($table $test_dsn $test_user $test_password);
-
-my $dbh;
-eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
- { RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
-
-if ($@) {
- plan skip_all => "Can't connect to database ERROR: $DBI::errstr. Can't continue test";
-}
-
-plan tests => 13;
-
-my $create= <<EOT;
-CREATE TABLE $table (
- id int(4) NOT NULL default 0,
- name varchar(64) NOT NULL default ''
- )
-EOT
-
-ok $dbh->do("DROP TABLE IF EXISTS $table"), "drop table if exists $table";
-
-ok $dbh->do($create), "create table $table";
-
-ok $dbh->do("LOCK TABLES $table WRITE"), "lock table $table";
-
-ok $dbh->do("INSERT INTO $table VALUES(1, 'Alligator Descartes')"), "Insert ";
-
-ok $dbh->do("DELETE FROM $table WHERE id = 1"), "Delete";
-
-my $sth;
-eval {$sth= $dbh->prepare("SELECT * FROM $table WHERE id = 1")};
-
-ok !$@, "Prepare of select";
-
-ok defined($sth), "Prepare of select";
-
-ok $sth->execute , "Execute";
-
-my ($row, $errstr);
-$errstr= '';
-$row = $sth->fetchrow_arrayref;
-$errstr= $sth->errstr;
-ok !defined($row), "Fetch should have failed";
-ok !defined($errstr), "Fetch should have failed";
-
-ok $dbh->do("UNLOCK TABLES"), "Unlock tables";
-ok $dbh->do("DROP TABLE $table"), "Drop table $table";
-ok $dbh->disconnect, "Disconnecting";
#-----------------------------------------------------------------------
-# from P5 DBD/mysql/t/30insertid.t
-
-use Test::More;
-use DBI;
-use DBI::Const::GetInfoType;
-use lib '.', 't';
-require 'lib.pl';
-use strict;
-$|= 1;
-
-,use vars qw($table $test_dsn $test_user $test_password);
-
-my $dbh;
-eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
- { RaiseError => 1, PrintError => 1, AutoCommit => 0});};
-
-if ($@) {
- plan skip_all => "ERROR: $@. Can't continue test";
-}
-plan tests => 4;
+# from perl5 DBD/mysql/t/30insertid.t
+#plan tests => 18;
+#ok $dbh->do("DROP TABLE IF EXISTS $table");
+#my $create = <<EOT;
+#CREATE TABLE $table (
+# id INT(3) PRIMARY KEY AUTO_INCREMENT NOT NULL,
+# name VARCHAR(64))
+#EOT
+#ok $dbh->do($create), "create $table";
+#my $query= "INSERT INTO $table (name) VALUES (?)";
+#my $sth;
+#ok ($sth= $dbh->prepare($query));
+#ok defined $sth;
+#ok $sth->execute("Jochen");
+#is $dbh->{'mysql_insertid'}, 1, "insert id == $dbh->{mysql_insertid}";
+#ok $sth->execute("Patrick");
+#ok (my $sth2= $dbh->prepare("SELECT max(id) FROM $table"));
+#ok defined $sth2;
+#ok $sth2->execute();
+#my $max_id;
+#ok ($max_id= $sth2->fetch());
+#ok defined $max_id;
+#cmp_ok $sth->{'mysql_insertid'}, '==', $max_id->[0], "sth insert id $sth->{'mysql_insertid'} == max(id) $max_id->[0] in $table";
+#cmp_ok $dbh->{'mysql_insertid'}, '==', $max_id->[0], "dbh insert id $dbh->{'mysql_insertid'} == max(id) $max_id->[0] in $table";
+#ok $sth->finish();
+#ok $sth2->finish();
+#ok $dbh->do("DROP TABLE $table");
+#ok $dbh->disconnect();
-ok(defined $dbh, "Connected to database");
-
-SKIP: {
- skip "Server doesn't report warnings", 3
- if $dbh->get_info($GetInfoType{SQL_DBMS_VER}) lt "4.1";
-
- my $sth;
- ok($sth= $dbh->prepare("DROP TABLE IF EXISTS no_such_table"));
- ok($sth->execute());
-
- is($sth->{mysql_warning_count}, 1);
-};
+=begin pod
-$dbh->disconnect;
#-----------------------------------------------------------------------
#!perl -w
# vim: ft=perl
Please sign in to comment.
Something went wrong with that request. Please try again.