Author: REHSACK
Date: Fri Aug 27 10:19:31 2010
New Revision: 14339
Modified:
dbi/trunk/lib/DBD/DBM.pm
dbi/trunk/lib/DBD/File.pm
Log:
add two phase initialization support
Modified: dbi/trunk/lib/DBD/DBM.pm
==============================================================================
--- dbi/trunk/lib/DBD/DBM.pm (original)
+++ dbi/trunk/lib/DBD/DBM.pm Fri Aug 27 10:19:31 2010
@@ -24,7 +24,7 @@
#################
use base qw( DBD::File );
use vars qw($VERSION $ATTRIBUTION $drh $methods_already_installed);
-$VERSION = '0.05';
+$VERSION = '0.06';
$ATTRIBUTION = 'DBD::DBM by Jens Rehsack';
# no need to have driver() unless you need private methods
@@ -150,9 +150,9 @@
sub init_default_attributes
{
- my $dbh = shift;
+ my ( $dbh, $phase ) = @_;
- $dbh->SUPER::init_default_attributes();
+ $dbh->SUPER::init_default_attributes($phase);
$dbh->{f_lockfile} = '.lck';
return $dbh;
@@ -163,29 +163,35 @@
my ( $dbh, $table ) = @_;
$table ||= '';
+ my $meta;
my $class = $dbh->{ImplementorClass};
$class =~ s/::db$/::Table/;
- $table and
- my ( undef, $meta ) = $class->get_table_meta( $dbh, $table, 1 );
+ $table and ( undef, $meta ) = $class->get_table_meta( $dbh, $table, 1 );
$meta or ( $meta = {} and $class->bootstrap_table_meta( $dbh, $meta,
$table ) );
my $dver;
- my $eval_str;
- $eval_str = sprintf( '$dver = $%s::VERSION', $meta->{dbm_type} );
- eval $eval_str;
my $dtype = $meta->{dbm_type};
- $dtype .= ' (' . $dver . ')' if $dver;
+ eval {
+ $dver = $meta->{dbm_type}->VERSION();
+ $dtype .= " ($dver)";
+ };
if ( $meta->{dbm_mldbm} )
{
$dtype .= ' + MLDBM';
- $eval_str = '$dver = $MLDBM::VERSION';
- eval $eval_str;
- $dtype .= ' (' . $dver . ')' if $dver;
+ eval {
+ $dver = MLDBM->VERSION();
+ $dtype .= " ($dver)";
+ };
$dtype .= ' + ' . $meta->{dbm_mldbm};
- $eval_str = sprintf( 'require MLDBM::Serializer::%s;' . '$dver =
$MLDBM::Serializer::%s::VERSION',
- $meta->{dbm_mldbm}, $meta->{dbm_mldbm} );
- eval $eval_str;
- $dtype .= ' (' . $dver . ')' if $dver;
+ eval {
+ my $ser_class = "MLDBM::Serializer::" . $meta->{dbm_mldbm};
+ my $ser_mod = $ser_class;
+ $ser_mod =~ s|::|/|g;
+ $ser_mod .= ".pm";
+ require $ser_mod;
+ $dver = $ser_class->VERSION();
+ $dver and $dtype .= " ($dver)";
+ };
}
return sprintf( "%s using %s", $dbh->{dbm_version}, $dtype );
}
@@ -204,14 +210,14 @@
{
my ( $sth, $attr ) = @_;
- if( $attr eq "NULLABLE" )
+ if ( $attr eq "NULLABLE" )
{
- my @colnames = $sth->sql_get_colnames();
+ my @colnames = $sth->sql_get_colnames();
- # XXX only BerkeleyDB fails having NULL values for non-MLDBM databases,
- # none accept it for key - but it requires more knowledge between
- # queries and tables storage to return fully correct information
- $attr eq "NULLABLE" and return [ map { 0 } @colnames ];
+ # XXX only BerkeleyDB fails having NULL values for non-MLDBM databases,
+ # none accept it for key - but it requires more knowledge between
+ # queries and tables storage to return fully correct information
+ $attr eq "NULLABLE" and return [ map { 0 } @colnames ];
}
return $sth->SUPER::FETCH($attr);
@@ -258,10 +264,10 @@
}
my %reset_on_modify = (
- dbm_type => "dbm_tietype",
- dbm_mldbm => "dbm_tietype",
-);
-__PACKAGE__->register_reset_on_modify(\%reset_on_modify);
+ dbm_type => "dbm_tietype",
+ dbm_mldbm => "dbm_tietype",
+ );
+__PACKAGE__->register_reset_on_modify( \%reset_on_modify );
sub bootstrap_table_meta
{
@@ -405,10 +411,13 @@
if ( $meta->{dbm_store_metadata} and not $meta->{hash}->{"_metadata
\0"} )
{
$schema or $schema = '';
- $meta->{hash}->{"_metadata \0"} = join( "",
- "<dbd_metadata>",
"<schema>$schema</schema>", "<col_names>",
- join( ",", @{$col_names} )
. "</col_names>",
- "</dbd_metadata>" );
+ $meta->{hash}->{"_metadata \0"} =
+ "<dbd_metadata>"
+ . "<schema>$schema</schema>"
+ . "<col_names>"
+ . join( ",", @{$col_names} )
+ . "</col_names>"
+ . "</dbd_metadata>";
}
$meta->{schema} = $schema;
@@ -426,7 +435,9 @@
untie %{ $meta->{hash} } if ( $meta->{hash} );
$self->SUPER::drop($data);
# XXX extra_files
- unlink $meta->{f_fqbn} . '.dir' if ( -f $meta->{f_fqbn} . '.dir' and
$meta->{f_ext} eq '.pag/r' );
+ -f $meta->{f_fqbn} . '.dir'
+ and $meta->{f_ext} eq '.pag/r'
+ and unlink( $meta->{f_fqbn} . '.dir' );
return 1;
}
@@ -444,7 +455,10 @@
# fetch with %each
#
my @ary = each %{ $meta->{hash} };
- @ary = each %{ $meta->{hash} } if ( $meta->{dbm_store_metadata} and
$ary[0] and $ary[0] eq "_metadata \0" );
+ $meta->{dbm_store_metadata}
+ and $ary[0]
+ and $ary[0] eq "_metadata \0"
+ and @ary = each %{ $meta->{hash} };
my ( $key, $val ) = @ary;
unless ($key)
@@ -472,18 +486,11 @@
my $key = shift @$row_aryref;
my $exists;
eval { $exists = exists( $meta->{hash}->{$key} ); };
- $exists
- and croak "Row with PK '$key' already exists";
+ $exists and croak "Row with PK '$key' already exists";
- if ( $meta->{dbm_mldbm} )
- {
- $meta->{hash}->{$key} = $row_aryref;
- }
- else
- {
- $meta->{hash}->{$key} = $row_aryref->[0];
- }
- 1;
+ $meta->{hash}->{$key} = $meta->{dbm_mldbm} ? $row_aryref :
$row_aryref->[0];
+
+ return 1;
}
# this is where you grab the column names from a CREATE statement
@@ -509,7 +516,10 @@
$schema =~ s/^[^\(]+\((.+)\)$/$1/s;
$schema = $stmt->schema_str() if ( $stmt->can('schema_str') );
$meta->{hash}->{"_metadata \0"} =
- "<dbd_metadata>" . "<schema>$schema</schema>" .
"<col_names>$col_names</col_names>" . "</dbd_metadata>";
+ "<dbd_metadata>"
+ . "<schema>$schema</schema>"
+ . "<col_names>$col_names</col_names>"
+ . "</dbd_metadata>";
}
# fetch_one_row, delete_one_row, update_one_row
Modified: dbi/trunk/lib/DBD/File.pm
==============================================================================
--- dbi/trunk/lib/DBD/File.pm (original)
+++ dbi/trunk/lib/DBD/File.pm Fri Aug 27 10:19:31 2010
@@ -35,7 +35,7 @@
use Carp;
use vars qw(@ISA $VERSION $drh);
-$VERSION = "0.39";
+$VERSION = "0.40";
$drh = undef; # holds driver handle(s) once initialized
@@ -214,42 +214,49 @@
sub init_default_attributes
{
- my $dbh = shift;
+ my ($dbh, $phase) = @_;
# must be done first, because setting flags implicitly calls
$dbdname::db->STORE
- $dbh->SUPER::init_default_attributes ();
+ $dbh->SUPER::init_default_attributes ($phase);
+
+ # DBI::BD::SqlEngine::dr::connect will detect old-style drivers and
+ # don't call twice
+ defined $phase or $phase = 0;
+
+ if( 0 == $phase ) {
+ # f_ext should not be initialized
+ # f_map is deprecated (but might return)
+ $dbh->{f_dir} = Cwd::abs_path (File::Spec->curdir ());
+ $dbh->{f_meta} = {};
+ $dbh->{f_meta_map} = {}; # choose new name because it contains other
keys
+
+ # complete derived attributes, if required
+ (my $drv_class = $dbh->{ImplementorClass}) =~ s/::db$//;
+ my $drv_prefix = DBI->driver_prefix ($drv_class);
+ my $valid_attrs = $drv_prefix . "valid_attrs";
+ my $ro_attrs = $drv_prefix . "readonly_attrs";
+
+ my @comp_attrs = ();
+ if (exists $dbh->{$drv_prefix . "meta"}) {
+ my $attr = $dbh->{$drv_prefix . "meta"};
+ defined $attr and defined $dbh->{$valid_attrs} and
+ !defined $dbh->{$valid_attrs}{$attr} and
+ $dbh->{$valid_attrs}{$attr} = 1;
+
+ my %h;
+ tie %h, "DBD::File::TieTables", $dbh;
+ $dbh->{$attr} = \%h;
+
+ push @comp_attrs, "meta";
+ }
- # f_ext should not be initialized
- # f_map is deprecated (but might return)
- $dbh->{f_dir} = Cwd::abs_path (File::Spec->curdir ());
- $dbh->{f_meta} = {};
- $dbh->{f_meta_map} = {}; # choose new name because it contains other keys
-
- # complete derived attributes, if required
- (my $drv_class = $dbh->{ImplementorClass}) =~ s/::db$//;
- my $drv_prefix = DBI->driver_prefix ($drv_class);
- my $valid_attrs = $drv_prefix . "valid_attrs";
- my $ro_attrs = $drv_prefix . "readonly_attrs";
-
- my @comp_attrs = ();
- if (exists $dbh->{$drv_prefix . "meta"}) {
- my $attr = $dbh->{$drv_prefix . "meta"};
- defined $attr and defined $dbh->{$valid_attrs} and !defined
$dbh->{$valid_attrs}{$attr} and
- $dbh->{$valid_attrs}{$attr} = 1;
-
- my %h;
- tie %h, "DBD::File::TieTables", $dbh;
- $dbh->{$attr} = \%h;
-
- push @comp_attrs, "meta";
- }
-
- foreach my $comp_attr (@comp_attrs) {
- my $attr = $drv_prefix . $comp_attr;
- defined $dbh->{$valid_attrs} and !defined $dbh->{$valid_attrs}{$attr}
and
- $dbh->{$valid_attrs}{$attr} = 1;
- defined $dbh->{$ro_attrs} and !defined $dbh->{$ro_attrs}{$attr} and
- $dbh->{$ro_attrs}{$attr} = 1;
+ foreach my $comp_attr (@comp_attrs) {
+ my $attr = $drv_prefix . $comp_attr;
+ defined $dbh->{$valid_attrs} and !defined
$dbh->{$valid_attrs}{$attr} and
+ $dbh->{$valid_attrs}{$attr} = 1;
+ defined $dbh->{$ro_attrs} and !defined $dbh->{$ro_attrs}{$attr} and
+ $dbh->{$ro_attrs}{$attr} = 1;
+ }
}
return $dbh;
@@ -294,11 +301,11 @@
}
my $dver;
- my $eval_str;
- $eval_str = sprintf '$dver = $%s::VERSION', "IO::File";
- eval $eval_str;
my $dtype = "IO::File";
- $dver and $dtype .= " ($dver)";
+ eval {
+ $dver = IO::File->VERSION ();
+ $dtype .= " ($dver)";
+ };
$meta->{f_encoding} and $dtype .= " + " . $meta->{f_encoding} . "
encoding";
