Patch for ReadOnly on DBI::DBD::SqlEngine and derived

Index: lib/DBD/File.pm
===================================================================
--- lib/DBD/File.pm	(Revision 15389)
+++ lib/DBD/File.pm	(Arbeitskopie)
@@ -624,6 +624,8 @@
 {
     my ($className, $data, $attrs, $flags) = @_;
 
+    # open_file must be called before inherited new is invoked
+    # because column name mapping is initialized in constructor ...
     my ($tblnm, $meta) = $className->get_table_meta ($data->{Database}, $attrs->{table}, 1) or
         croak "Cannot find appropriate file for table '$attrs->{table}'";
     $className->open_file ($meta, $attrs, $flags);
Index: lib/DBI/DBD/SqlEngine.pm
===================================================================
--- lib/DBI/DBD/SqlEngine.pm	(Revision 15389)
+++ lib/DBI/DBD/SqlEngine.pm	(Arbeitskopie)
@@ -1293,6 +1293,17 @@
                 };
     $self->{command} eq "DROP" and $flags->{dropMode} = 1;
 
+    # because column name mapping is initialized in constructor ...
+    # and therefore specific opening operations might be done before
+    # reaching DBI::DBD::SqlEngine::Table->new(), we need to intercept
+    # ReadOnly here
+    my $write_op = $createMode || $lockMode || $flags->{dropMode};
+    if( $write_op ) {
+	my ( $tblnm, $table_meta ) = $class->get_table_meta( $data->{Database}, $table, 1 )
+	  or croak "Cannot find appropriate file for table '$table'";
+	$table_meta->{readonly} and croak "Table '$table' is marked readonly - " . $self->{command} . " command forbidden";
+    }
+
     return $class->new( $data, { table => $table }, $flags );
 }    # open_table
 
@@ -1450,8 +1461,6 @@
     $flags->{createMode} && $data->{sql_stmt}{table_defs}
       and $meta->{table_defs} = $data->{sql_stmt}{table_defs};
 
-    my $columns = {};
-    my $array   = [];
     my $tbl = {
                 %{$attrs},
                 meta      => $meta,
Index: lib/DBI/SQL/Nano.pm
===================================================================
--- lib/DBI/SQL/Nano.pm	(Revision 15387)
+++ lib/DBI/SQL/Nano.pm	(Arbeitskopie)
@@ -31,7 +31,7 @@
     $VERSION = sprintf( "1.%06d", q$Revision$ =~ /(\d+)/o );
 
     $versions->{nano_version} = $VERSION;
-    if ( $ENV{DBI_SQL_NANO} || !eval { require SQL::Statement; $SQL::Statement::VERSION ge '1.28' } )
+    if ( $ENV{DBI_SQL_NANO} || !eval { require SQL::Statement; $SQL::Statement::VERSION ge '1.400' } )
     {
         @DBI::SQL::Nano::Statement::ISA = qw(DBI::SQL::Nano::Statement_);
         @DBI::SQL::Nano::Table::ISA     = qw(DBI::SQL::Nano::Table_);
Index: t/49dbd_file.t
===================================================================
--- t/49dbd_file.t	(Revision 15389)
+++ t/49dbd_file.t	(Arbeitskopie)
@@ -150,8 +150,61 @@
     $dbh->errstr and diag $dbh->errstr;
     }
 
+# ==================== ReadOnly tests =============================
+ok ($dbh = DBI->connect ("dbi:File:", undef, undef, {
+    f_ext	=> ".txt",
+    f_dir	=> $dir,
+    f_schema	=> undef,
+    f_encoding	=> $encoding,
+    f_lock	=> 0,
+
+    sql_meta    => {
+	$tbl => {
+	    col_names => [qw(txt)],
+	    }
+	},
+
+    RaiseError	=> 0,
+    PrintError	=> 0,
+    ReadOnly    => 1,
+    }), "ReadOnly connect with driver attributes in hash");
+
+ok ($sth = $dbh->prepare ("select * from $tbl"), "Prepare select * from $tbl");
+$rowidx = 0;
+SKIP: {
+    $using_dbd_gofer and skip "method intrusion didn't work with proxying", 1;
+    ok ($sth->execute, "execute on $tbl");
+    $dbh->errstr and diag $dbh->errstr;
+    }
+
+ok ($sth = $dbh->prepare ("insert into $tbl (txt) values (?)"), "prepare 'insert into $tbl'");
+is ($sth->execute ("Perl rules"), undef, "insert failed intensionally");
+diag $dbh->errstr;
+
+ok ($sth = $dbh->prepare ("delete from $tbl"), "prepare 'delete from $tbl'");
+is ($sth->execute (), undef, "delete failed intensionally");
+diag $dbh->errstr;
+
+is ($dbh->do ("drop table $tbl"), undef, "table drop failed intensionally");
+diag $dbh->errstr;
+is (-f $tbl_file, 1, "Test table not removed");
+
+# ==================== ReadWrite again tests =============================
+ok ($dbh = DBI->connect ("dbi:File:", undef, undef, {
+    f_ext	=> ".txt",
+    f_dir	=> $dir,
+    f_schema	=> undef,
+    f_encoding	=> $encoding,
+    f_lock	=> 0,
+
+    RaiseError	=> 0,
+    PrintError	=> 0,
+    }), "ReadWrite for drop connect with driver attributes in hash");
+
+# XXX add a truncate test
+
 ok ($dbh->do ("drop table $tbl"), "table drop");
-is (-s "$tbl.txt", undef, "Test table removed");
+is (-s $tbl_file, undef, "Test table removed"); # -s => size test
 
 done_testing ();