Re: [svn:dbi] r14565 - in dbi/branches/sqlengine/lib: DBD DBI/DBD

I think this needs some comments in the code about
what it's doing and why.

Tim.

On Mon, Dec 13, 2010 at 02:54:02PM -0800, [email protected] wrote:
> Author: REHSACK
> Date: Mon Dec 13 14:54:01 2010
> New Revision: 14565
> 
> Modified:
>    dbi/branches/sqlengine/lib/DBD/File.pm
>    dbi/branches/sqlengine/lib/DBI/DBD/SqlEngine.pm
> 
> Log:
> fixing backward compatibility $prefix_tables thanks to Tim Bunce
> 
> 
> Modified: dbi/branches/sqlengine/lib/DBD/File.pm
> ==============================================================================
> --- dbi/branches/sqlengine/lib/DBD/File.pm	(original)
> +++ dbi/branches/sqlengine/lib/DBD/File.pm	Mon Dec 13 14:54:01 2010
> @@ -227,6 +227,7 @@
>      if (0 == $phase) {
>  	# f_ext should not be initialized
>  	# f_map is deprecated (but might return)
> +	$dbh->{f_in_gofer} = (defined ($INC{'DBD/Gofer.pm'}) and ((caller(5))[0] eq 'DBI::Gofer::Execute'));
>  	$dbh->{f_dir}      = Cwd::abs_path (File::Spec->curdir ());
>  	$dbh->{f_meta}     = {};
>  	$dbh->{f_meta_map} = {}; # choose new name because it contains other keys
> @@ -238,7 +239,7 @@
>  	my $ro_attrs = $drv_prefix . "readonly_attrs";
>  
>  	my @comp_attrs = ();
> -	if (exists $dbh->{$drv_prefix . "meta"}) {
> +	if (exists $dbh->{$drv_prefix . "meta"} and !$dbh->{f_in_gofer}) {
>  	    my $attr = $dbh->{$drv_prefix . "meta"};
>  	    defined $attr and defined $dbh->{$valid_attrs} and
>  		!defined $dbh->{$valid_attrs}{$attr} and
> @@ -269,6 +270,21 @@
>      return $_[0]->SUPER::disconnect ();
>      } # disconnect
>  
> +sub validate_FETCH_attr
> +{
> +    my ( $dbh, $attrib ) = @_;
> +
> +    if ($dbh->{f_in_gofer}) {
> +	(my $drv_class = $dbh->{ImplementorClass}) =~ s/::db$//;
> +	my $drv_prefix = DBI->driver_prefix ($drv_class);
> +	if (exists $dbh->{$drv_prefix . "meta"} and ($attrib eq $dbh->{$drv_prefix . "meta"})) {
> +	    $attrib = 'f_meta';
> +	    }
> +	}
> +
> +    return $attrib;
> +    }
> +
>  sub validate_STORE_attr
>  {
>      my ($dbh, $attrib, $value) = @_;
> 
> Modified: dbi/branches/sqlengine/lib/DBI/DBD/SqlEngine.pm
> ==============================================================================
> --- dbi/branches/sqlengine/lib/DBI/DBD/SqlEngine.pm	(original)
> +++ dbi/branches/sqlengine/lib/DBI/DBD/SqlEngine.pm	Mon Dec 13 14:54:01 2010
> @@ -445,9 +445,10 @@
>      $attrib eq "AutoCommit"
>        and return 1;
>  
> +    # Driver private attributes are lower cased
>      if ( $attrib eq ( lc $attrib ) )
>      {
> -        # Driver private attributes are lower cased
> +        $attrib = $dbh->func( $attrib, "validate_FETCH_attr" ) or return;
>  
>          my $attr_prefix;
>          $attrib =~ m/^([a-z]+_)/ and $attr_prefix = $1;
> @@ -460,8 +461,6 @@
>          my $valid_attrs = $attr_prefix . "valid_attrs";
>          my $ro_attrs    = $attr_prefix . "readonly_attrs";
>  
> -        $attrib = $dbh->func( $attrib, "validate_FETCH_attr" ) or return;
> -
>          exists $dbh->{$valid_attrs}
>            and ( $dbh->{$valid_attrs}{$attrib}
>                  or return $dbh->set_err( $DBI::stderr, "Invalid attribute '$attrib'" ) );
>