Did you run make test?
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)
(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.
(I may also move the code to github to make it easier, presumably, for
others to work together on branches without affecting the mainline.)
Tim.
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();
>
