Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Merge remote branch 'mberends/master'
Conflicts:
	Makefile
	lib/MiniDBI.pm6
  • Loading branch information
Dave Olszewski committed Jul 2, 2010
2 parents 299edb0 + db65fed commit 217a2b8
Show file tree
Hide file tree
Showing 12 changed files with 330 additions and 145 deletions.
122 changes: 68 additions & 54 deletions Makefile
@@ -1,4 +1,4 @@
# Makefile for FakeDBI
# Makefile for MiniDBI

PERL_EXE = perl
PERL6_EXE = perl6
Expand All @@ -10,101 +10,115 @@ 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
# first (therefore default) target is MiniDBI.pir
all: lib/MiniDBI.pir

lib/FakeDBD.pir: lib/FakeDBD.pm6
$(PERL6_EXE) --target=pir --output=lib/FakeDBD.pir lib/FakeDBD.pm6
lib/MiniDBD.pir: lib/MiniDBD.pm6
$(PERL6_EXE) --target=pir --output=lib/MiniDBD.pir lib/MiniDBD.pm6

lib/FakeDBD/CSV.pir: lib/FakeDBD/CSV.pm6 lib/FakeDBD.pir
export PERL6LIB=lib; $(PERL6_EXE) --target=pir --output=lib/FakeDBD/CSV.pir lib/FakeDBD/CSV.pm6
lib/MiniDBD/CSV.pir: lib/MiniDBD/CSV.pm6 lib/MiniDBD.pir
export PERL6LIB=lib; $(PERL6_EXE) --target=pir --output=lib/MiniDBD/CSV.pir lib/MiniDBD/CSV.pm6

lib/FakeDBD/mysql.pir: lib/FakeDBD/mysql.pm6 lib/FakeDBD.pir
export PERL6LIB=lib; $(PERL6_EXE) --target=pir --output=lib/FakeDBD/mysql.pir lib/FakeDBD/mysql.pm6
lib/MiniDBD/mysql.pir: lib/MiniDBD/mysql.pm6 lib/MiniDBD.pir
export PERL6LIB=lib; $(PERL6_EXE) --target=pir --output=lib/MiniDBD/mysql.pir lib/MiniDBD/mysql.pm6

lib/FakeDBD/Pg.pir: lib/FakeDBD/Pg.pm6 lib/FakeDBD.pir
lib/FakeDBD/Pg.pir: lib/FakeDBD/Pg.pm6 lib/MiniDBD.pir
export PERL6LIB=lib; $(PERL6_EXE) --target=pir --output=lib/FakeDBD/Pg.pir lib/FakeDBD/Pg.pm6

lib/FakeDBI.pir: lib/FakeDBI.pm6 lib/FakeDBD/CSV.pir lib/FakeDBD/mysql.pir lib/FakeDBD/Pg.pir
export PERL6LIB=lib; $(PERL6_EXE) --target=pir --output=lib/FakeDBI.pir lib/FakeDBI.pm6
lib/MiniDBD/PgPir.pir: lib/MiniDBD/PgPir.pm6 lib/MiniDBD.pir
export PERL6LIB=lib; $(PERL6_EXE) --target=pir --output=lib/MiniDBD/PgPir.pir lib/MiniDBD/PgPir.pm6

test: lib/FakeDBI.pir lib/FakeDBD/CSV.pir lib/FakeDBD/mysql.pir lib/FakeDBD/Pg.pir
lib/MiniDBI.pir: lib/MiniDBI.pm6 lib/MiniDBD/CSV.pir lib/MiniDBD/mysql.pir lib/MiniDBD/PgPir.pir lib/FakeDBD/Pg.pir
export PERL6LIB=lib; $(PERL6_EXE) --target=pir --output=lib/MiniDBI.pir lib/MiniDBI.pm6

test: lib/MiniDBI.pir lib/MiniDBD/CSV.pir lib/MiniDBD/mysql.pir lib/MiniDBD/PgPir.pir lib/FakeDBD/Pg.pir
@#export PERL6LIB=lib; prove --exec $(PERL6_EXE) t/10-mysql.t
@#export PERL6LIB=lib; prove --exec $(PERL6_EXE) t/20-CSV-common.t
@#export PERL6LIB=lib; prove --exec $(PERL6_EXE) t/25-mysql-common.t
@#export PERL6LIB=lib; prove --exec $(PERL6_EXE) t/30-pgpir.t
export PERL6LIB=lib; prove --exec $(PERL6_EXE) t/

# standard install is to the shared system wide directory
install: lib/FakeDBI.pir lib/FakeDBD.pir lib/FakeDBD/mysql.pir lib/FakeDBD/Pg.pir
install: lib/MiniDBI.pir lib/MiniDBD.pir lib/MiniDBD/mysql.pir lib/MiniDBD/PgPir.pir lib/FakeDBD/Pg.pir
@echo "--> $(LIBSYSTEM)"
@$(CP) lib/FakeDBI.pm6 lib/FakeDBI.pir $(LIBSYSTEM)
@$(CP) lib/FakeDBD.pm6 lib/FakeDBD.pir $(LIBSYSTEM)
@$(MKPATH) $(LIBSYSTEM)/FakeDBD
@$(CP) lib/FakeDBD/CSV.pm6 lib/FakeDBD/CSV.pir $(LIBSYSTEM)/FakeDBD
@$(CP) lib/FakeDBD/mysql.pm6 lib/FakeDBD/mysql.pir $(LIBSYSTEM)/FakeDBD
@$(CP) lib/MiniDBI.pm6 lib/MiniDBI.pir $(LIBSYSTEM)
@$(CP) lib/MiniDBD.pm6 lib/MiniDBD.pir $(LIBSYSTEM)
@$(MKPATH) $(LIBSYSTEM)/MiniDBD
@$(CP) lib/MiniDBD/CSV.pm6 lib/MiniDBD/CSV.pir $(LIBSYSTEM)/MiniDBD
@$(CP) lib/MiniDBD/mysql.pm6 lib/MiniDBD/mysql.pir $(LIBSYSTEM)/MiniDBD
@$(CP) lib/MiniDBD/PgPir.pm6 lib/MiniDBD/PgPir.pir $(LIBSYSTEM)/MiniDBD
@$(CP) lib/FakeDBD/Pg.pm6 lib/FakeDBD/Pg.pir $(LIBSYSTEM)/FakeDBD

# if user has no permission to install globally, try a personal directory
install-user: lib/FakeDBI.pir lib/FakeDBD.pir lib/FakeDBD/mysql.pir lib/FakeDBD/Pg.pir
install-user: lib/MiniDBI.pir lib/MiniDBD.pir lib/MiniDBD/mysql.pir lib/MiniDBD/PgPir.pir lib/FakeDBD/Pg.pir
@echo "--> $(LIBUSER)"
@$(CP) lib/FakeDBI.pm6 lib/FakeDBI.pir $(LIBUSER)
@$(CP) lib/FakeDBD.pm6 lib/FakeDBD.pir $(LIBUSER)
@$(MKPATH) $(LIBUSER)/FakeDBD
@$(CP) lib/FakeDBD/CSV.pm6 lib/FakeDBD/CSV.pir $(LIBUSER)/FakeDBD
@$(CP) lib/FakeDBD/mysql.pm6 lib/FakeDBD/mysql.pir $(LIBUSER)/FakeDBD
@$(CP) lib/MiniDBI.pm6 lib/MiniDBI.pir $(LIBUSER)
@$(CP) lib/MiniDBD.pm6 lib/MiniDBD.pir $(LIBUSER)
@$(MKPATH) $(LIBUSER)/MiniDBD
@$(CP) lib/MiniDBD/CSV.pm6 lib/MiniDBD/CSV.pir $(LIBUSER)/MiniDBD
@$(CP) lib/MiniDBD/mysql.pm6 lib/MiniDBD/mysql.pir $(LIBUSER)/MiniDBD
@$(CP) lib/MiniDBD/PgPir.pm6 lib/MiniDBD/PgPir.pir $(LIBUSER)/MiniDBD
@$(CP) lib/FakeDBD/Pg.pm6 lib/FakeDBD/Pg.pir $(LIBUSER)/FakeDBD

# Uninstall from the shared system wide directory.
# This might leave an empty FakeDBD subdirectory behind.
# This might leave an empty MiniDBD subdirectory behind.
uninstall:
@echo "x-> $(LIBSYSTEM)"
@$(TEST_F) $(LIBSYSTEM)/FakeDBI.pm6
@$(RM_F) $(LIBSYSTEM)/FakeDBD.pm6
@$(TEST_F) $(LIBSYSTEM)/FakeDBI.pir
@$(RM_F) $(LIBSYSTEM)/FakeDBD.pir
@$(TEST_F) $(LIBSYSTEM)/FakeDBD/CSV.pm6
@$(RM_F) $(LIBSYSTEM)/FakeDBD/CSV.pm6
@$(TEST_F) $(LIBSYSTEM)/FakeDBD/CSV.pir
@$(RM_F) $(LIBSYSTEM)/FakeDBD/CSV.pir
@$(TEST_F) $(LIBSYSTEM)/FakeDBD/mysql.pm6
@$(RM_F) $(LIBSYSTEM)/FakeDBD/mysql.pm6
@$(TEST_F) $(LIBSYSTEM)/FakeDBD/mysql.pir
@$(RM_F) $(LIBSYSTEM)/FakeDBD/mysql.pir
@$(TEST_F) $(LIBSYSTEM)/MiniDBI.pm6
@$(RM_F) $(LIBSYSTEM)/MiniDBD.pm6
@$(TEST_F) $(LIBSYSTEM)/MiniDBI.pir
@$(RM_F) $(LIBSYSTEM)/MiniDBD.pir
@$(TEST_F) $(LIBSYSTEM)/MiniDBD/CSV.pm6
@$(RM_F) $(LIBSYSTEM)/MiniDBD/CSV.pm6
@$(TEST_F) $(LIBSYSTEM)/MiniDBD/CSV.pir
@$(RM_F) $(LIBSYSTEM)/MiniDBD/CSV.pir
@$(TEST_F) $(LIBSYSTEM)/MiniDBD/mysql.pm6
@$(RM_F) $(LIBSYSTEM)/MiniDBD/mysql.pm6
@$(TEST_F) $(LIBSYSTEM)/MiniDBD/mysql.pir
@$(RM_F) $(LIBSYSTEM)/MiniDBD/mysql.pir
@$(TEST_F) $(LIBSYSTEM)/MiniDBD/PgPir.pm6
@$(RM_F) $(LIBSYSTEM)/MiniDBD/PgPir.pm6
@$(TEST_F) $(LIBSYSTEM)/MiniDBD/PgPir.pir
@$(RM_F) $(LIBSYSTEM)/MiniDBD/PgPir.pir
@$(TEST_F) $(LIBSYSTEM)/FakeDBD/Pg.pm6
@$(RM_F) $(LIBSYSTEM)/FakeDBD/Pg.pm6
@$(TEST_F) $(LIBSYSTEM)/FakeDBD/Pg.pir
@$(RM_F) $(LIBSYSTEM)/FakeDBD/Pg.pir

# Uninstall from the user's own Perl 6 directory.
# This might leave an empty FakeDBD subdirectory behind.
# This might leave an empty MiniDBD subdirectory behind.
uninstall-user:
@echo "x-> $(LIBUSER)"
@$(TEST_F) $(LIBUSER)/FakeDBI.pm6
@$(RM_F) $(LIBUSER)/FakeDBI.pm6
@$(TEST_F) $(LIBUSER)/FakeDBI.pir
@$(RM_F) $(LIBUSER)/FakeDBI.pir
@$(TEST_F) $(LIBUSER)/FakeDBD/CSV.pm6
@$(RM_F) $(LIBUSER)/FakeDBD/CSV.pm6
@$(TEST_F) $(LIBUSER)/FakeDBD/CSV.pir
@$(RM_F) $(LIBUSER)/FakeDBD/CSV.pir
@$(TEST_F) $(LIBUSER)/FakeDBD/mysql.pm6
@$(RM_F) $(LIBUSER)/FakeDBD/mysql.pm6
@$(TEST_F) $(LIBUSER)/FakeDBD/mysql.pir
@$(RM_F) $(LIBUSER)/FakeDBD/mysql.pir
@$(TEST_F) $(LIBUSER)/MiniDBI.pm6
@$(RM_F) $(LIBUSER)/MiniDBI.pm6
@$(TEST_F) $(LIBUSER)/MiniDBI.pir
@$(RM_F) $(LIBUSER)/MiniDBI.pir
@$(TEST_F) $(LIBUSER)/MiniDBD/CSV.pm6
@$(RM_F) $(LIBUSER)/MiniDBD/CSV.pm6
@$(TEST_F) $(LIBUSER)/MiniDBD/CSV.pir
@$(RM_F) $(LIBUSER)/MiniDBD/CSV.pir
@$(TEST_F) $(LIBUSER)/MiniDBD/mysql.pm6
@$(RM_F) $(LIBUSER)/MiniDBD/mysql.pm6
@$(TEST_F) $(LIBUSER)/MiniDBD/mysql.pir
@$(RM_F) $(LIBUSER)/MiniDBD/mysql.pir
@$(TEST_F) $(LIBUSER)/MiniDBD/PgPir.pm6
@$(RM_F) $(LIBUSER)/MiniDBD/PgPir.pm6
@$(TEST_F) $(LIBUSER)/MiniDBD/PgPir.pir
@$(RM_F) $(LIBUSER)/MiniDBD/PgPir.pir
@$(TEST_F) $(LIBUSER)/FakeDBD/Pg.pm6
@$(RM_F) $(LIBUSER)/FakeDBD/Pg.pm6
@$(TEST_F) $(LIBUSER)/FakeDBD/Pg.pir
@$(RM_F) $(LIBUSER)/FakeDBD/Pg.pir

clean:
@# delete compiled files
$(RM_F) lib/*.pir lib/FakeDBD/*.pir
$(RM_F) lib/*.pir lib/MiniDBD/*.pir
@# delete all editor backup files
$(RM_F) *~ lib/*~ t/*~ lib/FakeDBD/*~
$(RM_F) *~ lib/*~ t/*~ lib/MiniDBD/*~

help:
@echo
@echo "You can make the following in 'FakeDBI':"
@echo "You can make the following in 'MiniDBI':"
@echo "clean removes compiled, temporary and backup files"
@echo "test runs a local test suite"
@echo "install copies .pm and .pir files to system perl6 lib/"
Expand Down
20 changes: 10 additions & 10 deletions lib/FakeDBD.pm6 → lib/MiniDBD.pm6
@@ -1,25 +1,25 @@
# FakeDBD.pm6
# MiniDBD.pm6
# Provide default methods for all database drivers

=begin pod
=head1 DESCRIPTION
The FakeDBD module contains generic code that should be re-used by every
The MiniDBD module contains generic code that should be re-used by every
database driver, and documentation guidelines for DBD implementation.
It is also an experiment in distributing Pod fragments in and around the
code. Without syntax highlighting, it is very awkward to work with. It
shows that this style of file layout is unsuitable for general use.
=head1 ROLES
=head2 role FakeDBD::StatementHandle
=head2 role MiniDBD::StatementHandle
The Connection C<prepare> method returns a StatementHandle object that
mainly provides the C<execute> and C<finish> methods.
=end pod

role FakeDBD::StatementHandle {
role MiniDBD::StatementHandle {

=begin pod
=head3 FakeDBD::StatementHandle members
=head3 MiniDBD::StatementHandle members
=head4 instance variables
=head5 $!errstr
The C<$!errstr> variable keeps an internal copy of the last error
Expand Down Expand Up @@ -51,13 +51,13 @@ database driver.
}

=begin pod
=head2 role FakeDBD::Connection
=head2 role MiniDBD::Connection
=end pod

role FakeDBD::Connection {
role MiniDBD::Connection {

=begin pod
=head3 FakeDBD::Connection members
=head3 MiniDBD::Connection members
=head4 instance variables
=head5 $!errstr
The C<$!errstr> variable keeps an internal copy of the last error
Expand All @@ -72,7 +72,7 @@ message retrieved from the database driver. It is cleared (when?).
=end pod

method do( Str $statement, *@params ) {
# warn "in FakeDBD::Connection.do('$statement')";
# warn "in MiniDBD::Connection.do('$statement')";
my $sth = self.prepare($statement) or return fail();
$sth.execute(@params);
# $sth.execute(@params) or return fail();
Expand All @@ -84,7 +84,7 @@ The C<disconnect> method
=end pod

method disconnect() {
# warn "in FakeDBI::DatabaseHandle.disconnect()";
# warn "in MiniDBI::DatabaseHandle.disconnect()";
return Bool::True;
}

Expand Down
28 changes: 14 additions & 14 deletions lib/FakeDBD/CSV.pm6 → lib/MiniDBD/CSV.pm6
@@ -1,8 +1,8 @@
# FakeDBD/CSV.pm6
# MiniDBD/CSV.pm6

use FakeDBD;
use MiniDBD;

grammar FakeDBD::CSV::SQL {
grammar MiniDBD::CSV::SQL {
# note: token means regex :ratchet, rule means token :sigspace
regex TOP { ^ [ <create_table> | <drop_table> | <insert> | <update>
| <delete> | <select> ] }
Expand All @@ -19,7 +19,7 @@ grammar FakeDBD::CSV::SQL {
token column_type {:i int|char|numeric}
}

class FakeDBD::CSV::SQL::actions {
class MiniDBD::CSV::SQL::actions {
method create_table(Match $m) {
print "doing CREATE TABLE ";
my $table_name = ~$m<table_name>;
Expand All @@ -36,13 +36,13 @@ class FakeDBD::CSV::SQL::actions {
method select(Match $m) { say "doing SELECT" }
}

class FakeDBD::CSV::StatementHandle does FakeDBD::StatementHandle {
class MiniDBD::CSV::StatementHandle does MiniDBD::StatementHandle {
has $!RaiseError;
has $!sql_command;
method execute(*@params is copy) {
#say "executing: $!sql_command";
my Match $sql_match = FakeDBD::CSV::SQL.parse( $!sql_command,
:actions( FakeDBD::CSV::SQL::actions ) );
my Match $sql_match = MiniDBD::CSV::SQL.parse( $!sql_command,
:actions( MiniDBD::CSV::SQL::actions ) );
say "execute " ~ $sql_match.perl;
return Bool::True;
}
Expand All @@ -54,28 +54,28 @@ class FakeDBD::CSV::StatementHandle does FakeDBD::StatementHandle {
}
}

class FakeDBD::CSV::Connection does FakeDBD::Connection {
class MiniDBD::CSV::Connection does MiniDBD::Connection {
has $!RaiseError;
method prepare( Str $sql_command ) {
my $statement_handle;
$statement_handle = FakeDBD::CSV::StatementHandle.bless(
FakeDBD::CSV::StatementHandle.CREATE(),
$statement_handle = MiniDBD::CSV::StatementHandle.bless(
MiniDBD::CSV::StatementHandle.CREATE(),
RaiseError => $!RaiseError,
sql_command => $sql_command
);
return $statement_handle;
}
}

class FakeDBD::CSV:auth<mberends>:ver<0.0.1> {
class MiniDBD::CSV:auth<mberends>:ver<0.0.1> {

has $.Version = 0.01;

method connect( Str $user, Str $password, Str $params, $RaiseError ) {
#warn "in FakeDBD::CSV.connect('$user',*,'$params')";
#warn "in MiniDBD::CSV.connect('$user',*,'$params')";
my $connection;
$connection = FakeDBD::CSV::Connection.bless(
FakeDBD::CSV::Connection.CREATE(),
$connection = MiniDBD::CSV::Connection.bless(
MiniDBD::CSV::Connection.CREATE(),
RaiseError => $RaiseError
);
return $connection;
Expand Down
74 changes: 74 additions & 0 deletions lib/MiniDBD/PgPir.pm6
@@ -0,0 +1,74 @@
use MiniDBD;
pir::load_bytecode("Pg.pir");

class MiniDBD::PgPir::StatementHandle does MiniDBD::StatementHandle {
has $!name;
has $!RaiseError;

}

class MiniDBD::PgPir::Connection does MiniDBD::Connection {
has $!pg_conn;
has $!statement_name = 'a';
has $!RaiseError;

method prepare(Str $statement) {
my $name = $!statement_name++;

# the third argument to .prepare() is the number of
# bind where we want to explicitly specify the type
my $handle = $!pg_conn.prepare($name, $statement, 0);
}

method status {
my $c = $!pg_conn;
! Q:PIR {
$P0 = find_lex '$c'
$I0 = $P0.'status'()
%r = box $I0
}
}
method Bool { $.status };
}
class MiniDBD::PgPir:auth<moritz> {

has $.Version = 0.01;

sub pg_escape($x) {
q[']
~ $x.subst(rx/\\|\'/, -> $m { '\\' ~ $m }, :g)
~ q['];
}

method connect(Str $user, Str $password, Str $params, $RaiseError) {
my $pg = pir::new__pS('Pg');

my %params = $params.split(';').map({ .split(regex {\s*\=\s*}, 2)}).flat;


my %opt =
user => pg_escape($user),
password => pg_escape($password),
# user => $user,
# password => $password,
%params;
%opt<application_name> //= 'Perl6MiniDBD';

say "Options: %opt.perl()";

# nearly scary how concise this is in Perl 6 :-)
my $connection_string = %opt.fmt('%s=%s', ';');
say "Connection string: $connection_string";
my $con = $pg.connectdb($connection_string);
say "con: $con";
}

method finish() {
$!pg_conn.finish() if $.Bool;
}
}

# vim: ft=perl6

0 comments on commit 217a2b8

Please sign in to comment.