Skip to content
Browse files

initial, non-working DBD::PgPir - uses parrots Pg.pir as a backend

  • Loading branch information...
1 parent 69d6f1d commit 445833260bc011bff102fda065cde095d077772d @moritz moritz committed
Showing with 97 additions and 0 deletions.
  1. +67 −0 lib/FakeDBD/PgPir.pm6
  2. +30 −0 t/30-pgpir.t
View
67 lib/FakeDBD/PgPir.pm6
@@ -0,0 +1,67 @@
+pir::load_bytecode("Pg.pir");
+
+class FakeDBD::PgPir::StatementHandle does FakeDBD::StatementHandle {
+ has $!name;
+ has $!RaiseError;
+
+}
+
+class FakeDBD::PgPir::Connection does FakeDBD::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 FakeDBD::PgPir:auth<moritz> {
+
+ 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(rx{\s*\=\s*}, 2)}).flat;
+
+
+ my %opt =
+ user => pg_escape($user),
+ password => pg_escape($password),
+ %params;
+ %opt<application_name> //= 'Perl6FakeDBD';
+
+ say "Options: %opt.perl()";
+
+ # nearly scary how concise this is in Perl 6 :-)
+ my $connection_string = %opt.fmt('%s=%s', ';');
+ my $con = $pg.connectdb($connection_string);
+ }
+
+ method finish() {
+ $!pg_conn.finish() if $.Bool;
+ }
+}
+
+# vim: ft=perl6
View
30 t/30-pgpir.t
@@ -0,0 +1,30 @@
+use v6;
+use Test;
+plan *;
+
+use FakeDBI;
+
+my $mdriver = 'PgPir';
+my $host = 'localhost';
+my $port = 5432;
+my $database = 'testdb';
+my $user = 'testuser';
+my $password = 'Cho5thae';
+
+my $test_dsn = "FakeDBI:{$mdriver}:dbname=$database;host=$host;port=$port";
+
+my $drh = FakeDBI.install_driver($mdriver);
+ok $drh, 'Install driver';
+
+my $dbh;
+lives_ok { $dbh = FakeDBI.connect($test_dsn, $user, $password,
+ RaiseError => 1, PrintError => 1, AutoCommit => 1) },
+ 'Connecting lives';
+
+ok defined($dbh), 'DBH is defined';
+ok $dbh, 'DBH is true';
+# lives_ok { $dbh.finish }, 'Can finish DBH';
+#nok $dbh, 'finished DBH is false';
+
+
+done_testing;

0 comments on commit 4458332

Please sign in to comment.
Something went wrong with that request. Please try again.