On 09/17/10 14:52, Tim Bunce wrote:
Did you run make test?

I did, but I can do again. Probably I interrupted it (unsure).

This causes a whole bunch of (gofer related) test failures for me:

     t/zvg_51dbm_file.t       (Wstat: 512 Tests: 8 Failed: 0)
     t/zvxgn_51dbm_file.t     (Wstat: 512 Tests: 8 Failed: 0)
     t/zvxgnp_51dbm_file.t    (Wstat: 512 Tests: 8 Failed: 0)
     t/zvxgp_51dbm_file.t     (Wstat: 512 Tests: 8 Failed: 0)

Yes, late dbh attribute modifications are not allowed with Gofer,
they must fail. My fault, sorry.

(There's also a warning from t/51dbm_file.t)

I don't want to delay any 1.614 any longer, it's already taken too long,
so I've uploaded what was 1.613_95 (r14408) as 1.614.

In future I'll declare a 'code freeze' in the run up to a release.

Would be ok for me.

(I may also move the code to github to make it easier, presumably, for
others to work together on branches without affecting the mainline.)

In that case I wouldn't continue my effort on the pure-perl DBD's etc.,
git might be ok if there is someone who could guide me, but github isn't.

I further don't understand what's so difficult on svn cp dbi/trunk dbi/branches/foo - and a merge back after that - but this is another discussion and it's probably done by others ...

Tim.

/Jens

On Thu, Sep 16, 2010 at 01:59:36PM -0700, rehs...@cvs.perl.org wrote:
Author: REHSACK
Date: Thu Sep 16 13:59:35 2010
New Revision: 14409

Modified:
    dbi/trunk/lib/DBD/File.pm
    dbi/trunk/t/51dbm_file.t

Log:
Fixed issue in DBD::File when users set individual file name for tables
   via f_meta compatibility interface - reported by H.Merijn Brand while
   working on RT#61168

Modified: dbi/trunk/lib/DBD/File.pm
==============================================================================
--- dbi/trunk/lib/DBD/File.pm   (original)
+++ dbi/trunk/lib/DBD/File.pm   Thu Sep 16 13:59:35 2010
@@ -737,21 +737,27 @@
        }

      # (my $tbl = $file) =~ s/$ext$//i;
-    my ($tbl, $dir, $user_spec_file);
+    my ($tbl, $basename, $dir, $fn_ext, $user_spec_file);
      if ($file_is_table and defined $meta->{f_file}) {
        $tbl = $file;
-       ($file, $dir, undef) = File::Basename::fileparse ($meta->{f_file});
+       ($basename, $dir, $fn_ext) = File::Basename::fileparse 
($meta->{f_file}, $fn_any_ext_regex);
+       $file = $basename . $fn_ext;
        $user_spec_file = 1;
        }
      else {
-       ($tbl, $dir, undef) = File::Basename::fileparse ($file, $ext);
+       ($basename, $dir, undef) = File::Basename::fileparse ($file, $ext);
+       $file = $tbl = $basename;
        $user_spec_file = 0;
        }

-    !$respect_case and $meta->{sql_identifier_case} == 1 and # XXX SQL_IC_UPPER
+    if (!$respect_case and $meta->{sql_identifier_case} == 1) { # XXX 
SQL_IC_UPPER
+        $basename = uc $basename;
          $tbl = uc $tbl;
-    !$respect_case and $meta->{sql_identifier_case} == 2 and # XXX SQL_IC_LOWER
+       }
+    if( !$respect_case and $meta->{sql_identifier_case} == 2) { # XXX 
SQL_IC_LOWER
+        $basename = lc $basename;
          $tbl = lc $tbl;
+       }

      my $searchdir = File::Spec->file_name_is_absolute ($dir)
        ? ($dir =~ s|/$||, $dir)
@@ -763,14 +769,14 @@
        $dir = "";

      unless ($user_spec_file) {
-       $file_is_table and $file = "$tbl$ext";
+       $file_is_table and $file = "$basename$ext";

        # Fully Qualified File Name
        my $cmpsub;
        if ($respect_case) {
            $cmpsub = sub {
                my ($fn, undef, $sfx) = File::Basename::fileparse ($_, 
$fn_any_ext_regex);
-               $fn eq $tbl and
+               $fn eq $basename and
                    return (lc $sfx eq lc $ext or !$req&&  !$sfx);
                return 0;
                }
@@ -778,7 +784,7 @@
        else {
            $cmpsub = sub {
                my ($fn, undef, $sfx) = File::Basename::fileparse ($_, 
$fn_any_ext_regex);
-               lc $fn eq lc $tbl and
+               lc $fn eq lc $basename and
                    return (lc $sfx eq lc $ext or !$req&&  !$sfx);
                return 0;
                }
@@ -799,7 +805,7 @@
        }

      my $fqfn = File::Spec->catfile ($searchdir, $file);
-    my $fqbn = File::Spec->catfile ($searchdir, $tbl);
+    my $fqbn = File::Spec->catfile ($searchdir, $basename);

      $meta->{f_fqfn} = $fqfn;
      $meta->{f_fqbn} = $fqbn;
@@ -842,7 +848,9 @@
        $table =~ s/\"$//;
        }

-    defined $dbh->{f_meta_map}{$table} and $table = $dbh->{f_meta_map}{$table};
+    unless ($respect_case) {
+       defined $dbh->{f_meta_map}{$table} and $table = 
$dbh->{f_meta_map}{$table};
+       }

      my $meta = {};
      defined $dbh->{f_meta}{$table} and $meta = $dbh->{f_meta}{$table};
@@ -861,10 +869,12 @@

        # now we know a bit more - let's check if user can't use consequent 
spelling
        # XXX add know issue about reset sql_identifier_case here ...
-       if (defined $dbh->{f_meta}{$table}&&  
$dbh->{f_meta}{$table}{initialized}) {
+       if (defined $dbh->{f_meta}{$table}&&  
defined($dbh->{f_meta}{$table}{initialized})) {
            $meta = $dbh->{f_meta}{$table};
+           $self->file2table ($meta, $table, $file_is_table, $respect_case) or
+               return unless ($dbh->{f_meta}{$table}{initialized});
            }
-       else {
+       unless ($dbh->{f_meta}{$table}{initialized}) {
            $self->init_table_meta ($dbh, $meta, $table);
            $meta->{initialized} = 1;
            $dbh->{f_meta}{$table} = $meta;
@@ -921,7 +931,7 @@
      my ($class, $meta, $attrib, $value) = @_;
      defined $reset_on_modify{$attrib} and
        delete $meta->{$reset_on_modify{$attrib}} and
-       delete $meta->{initialized};
+       $meta->{initialized} = 0;
      } # table_meta_attr_changed

  # ====== FILE OPEN 
=============================================================

Modified: dbi/trunk/t/51dbm_file.t
==============================================================================
--- dbi/trunk/t/51dbm_file.t    (original)
+++ dbi/trunk/t/51dbm_file.t    Thu Sep 16 13:59:35 2010
@@ -2,10 +2,12 @@
  $| = 1;

  use strict;
+use warnings;
+
+use File::Copy ();
  use File::Path;
-use File::Spec;
+use File::Spec ();
  use Test::More;
-use Cwd;

  my $using_dbd_gofer = ( $ENV{DBI_AUTOPROXY} || '' ) =~ 
/^dbi:Gofer.*transport=/i;

@@ -54,6 +56,16 @@

  ok( $dbh->do(q/insert into FRED (a,b) values(2,1)/), 'insert into uppercase 
table' );

+my $fn_tbl2 = $dbh->{dbm_tables}->{fred}->{f_fqfn};
+   $fn_tbl2 =~ s/fred(\.[^.]*)?/freddy$1/;
+foreach my $fn (glob($dbh->{dbm_tables}->{fred}->{f_fqbn} . "*"))
+{
+    my $tgt_fn = $fn;
+    $tgt_fn =~ s/fred(\.[^.]*)?/freddy$1/;
+    File::Copy::copy( $fn, $tgt_fn );
+}
+$dbh->{dbm_tables}->{krueger}->{file} = $fn_tbl2;
+
  my $r = $dbh->selectall_arrayref(q/select * from Fred/);
  ok( @$r == 2, 'rows found via mixed case table' );

@@ -65,4 +77,9 @@

  ok( $dbh->do(q/drop table if exists FRED/), 'drop table' );

+my $r = $dbh->selectall_arrayref(q/select * from Krueger/);
+ok( @$r == 2, 'rows found via cloned mixed case table' );
+
+ok( $dbh->do(q/drop table if exists KRUeGEr/), 'drop table' );
+
  done_testing();


Reply via email to