[svn:dbi] r14006 - in dbi/trunk: lib/DBI t

Author: REHSACK
Date: Sat May 22 07:35:28 2010
New Revision: 14006

Added:
   dbi/trunk/t/49dbd_file.t
Modified:
   dbi/trunk/lib/DBI/DBD.pm

Log:
Add test for DBD::File basics


Modified: dbi/trunk/lib/DBI/DBD.pm
==============================================================================
--- dbi/trunk/lib/DBI/DBD.pm	(original)
+++ dbi/trunk/lib/DBI/DBD.pm	Sat May 22 07:35:28 2010
@@ -3331,7 +3331,7 @@
 		add => [ q{$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic'} ],
 	},
 	n => {	name => "DBI::SQL::Nano",
-		match => qr/^(?:5\ddbm_\w+|85gofer)\.t$/,
+		match => qr/^(?:49dbd_file|5\ddbm_\w+|85gofer)\.t$/,
 		add => [ q{$ENV{DBI_SQL_NANO} = 1} ],
 	},
     #   mx => {	name => "DBD::Multiplex",

Added: dbi/trunk/t/49dbd_file.t
==============================================================================
--- (empty file)
+++ dbi/trunk/t/49dbd_file.t	Sat May 22 07:35:28 2010
@@ -0,0 +1,105 @@
+#!perl -w
+$|=1;
+
+use strict;
+
+use Test::More;
+
+my $using_dbd_gofer = ($ENV{DBI_AUTOPROXY}||'') =~ /^dbi:Gofer.*transport=/i;
+
+#use DBI;
+
+my $tbl;
+BEGIN { $tbl = "db_". $$ . "_" };
+END   { $tbl and unlink glob "${tbl}*" }
+
+use_ok ("DBI");
+use_ok ("DBD::File");
+
+my $rowidx = 0;
+my @rows = ( [ 'Hello World' ], [ 'Hello DBI Developers' ], );
+
+my $dbh;
+
+# Check if we can connect at all
+ok ($dbh = DBI->connect ("dbi:File:"), "Connect clean");
+is (ref $dbh, "DBI::db", "Can connect to DBD::File driver");
+
+# Check if all the basic DBI attributes are accepted
+ok ($dbh = DBI->connect ("dbi:File:", undef, undef, {
+    RaiseError		=> 1,
+    PrintError		=> 1,
+    AutoCommit		=> 1,
+    ChopBlanks		=> 1,
+    ShowErrorStatement	=> 1,
+    FetchHashKeyName	=> "NAME_lc",
+    }), "Connect with DBI attributes");
+
+# Check if all the f_ attributes are accepted, in two ways
+ok ($dbh = DBI->connect ("dbi:File:f_ext=.txt;f_dir=.;f_encoding=cp1252;f_schema=test"), "Connect with driver attributes in DSN");
+
+my $encoding = "iso-8859-1";
+
+ok ($dbh = DBI->connect ("dbi:File:", undef, undef, {
+    f_ext	=> ".txt/r",
+    f_dir	=> ".",
+    f_schema	=> undef,
+    f_encoding	=> $encoding,
+    f_lock	=> 0,
+
+    RaiseError	=> 0,
+    PrintError	=> 0,
+    }), "Connect with driver attributes in hash");
+
+my $sth;
+ok ($sth = $dbh->prepare ("select * from t_sbdgf_53442Gz"), "Prepare select from non-existing file");
+
+{   my @msg;
+    eval {
+	local $SIG{__DIE__} = sub { push @msg, @_ };
+	$sth->execute;
+	};
+    like ("@msg", qr{Cannot open ./t_sbdgf_}, "Cannot open non-existing file");
+    }
+
+# Now test some basic SQL statements
+#if (open my $fh, ">", "$tbl.txt") {
+#    print $fh "txt\nPlain text\n";
+#    close $fh;
+#    }
+ok ($dbh->do ("create table $tbl (txt varchar (20))"), "Create table $tbl");
+ok (-f "$tbl.txt", "Test table exists");
+
+ok ($sth = $dbh->prepare ("select * from $tbl"), "Prepare select *");
+$rowidx = 0;
+SKIP: {
+    skip "method intrusion didn't work with proxying", 1 if $using_dbd_gofer;
+    ok ($sth->execute, "execute");
+    diag $dbh->errstr if $dbh->errstr;
+}
+
+ok ($dbh->do ("drop table $tbl"), "table drop");
+is (-s "$tbl.txt", undef, "Test table removed");
+
+done_testing ();
+
+sub DBD::File::Table::fetch_row ($$)
+{
+    my ( $self, $data ) = @_;
+    my $meta = $self->{meta};
+    if( $rowidx >= scalar @rows ) {
+	$self->{row} = undef;
+	}
+    else {
+	$self->{row} = $rows[$rowidx++];
+	}
+    return $self->{row};
+    } # fetch_row
+
+
+sub DBD::File::Table::push_names ($$$)
+{
+    my ( $self, $data, $row_aryref ) = @_;
+    my $meta = $self->{meta};
+    @{$meta->{col_names}} = @{$row_aryref};
+    } # push_names