Permalink
Browse files

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

…T select)
  • Loading branch information...
1 parent e9ee1a6 commit 720e7892c9e307bb3540eeac1504a985802ba6d3 Martin Berends committed May 17, 2010
Showing with 319 additions and 275 deletions.
  1. +3 −0 Makefile
  2. +19 −9 README
  3. +20 −5 lib/FakeDBD.pm6
  4. +85 −38 lib/FakeDBD/mysql.pm6
  5. +27 −39 lib/FakeDBI.pm6
  6. +165 −184 t/10-mysql.t
View
@@ -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
@@ -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
@@ -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,14 +102,97 @@ 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
# project to develop a new, comprehensive DBI architecture for Parrot
# 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
@@ -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;
}
}
Oops, something went wrong.

0 comments on commit 720e789

Please sign in to comment.