Author: REHSACK
Date: Thu May 6 02:31:36 2010
New Revision: 13945
Modified:
dbi/trunk/lib/DBD/DBM.pm
Log:
- do not fill column names on CREATE TABLE
- use {row} member for fetching (SQL::Eval::Table expects it)
- "return undef" -> "return" (won't produces array containing 1
undef element in list context).
Modified: dbi/trunk/lib/DBD/DBM.pm
==============================================================================
--- dbi/trunk/lib/DBD/DBM.pm (original)
+++ dbi/trunk/lib/DBD/DBM.pm Thu May 6 02:31:36 2010
@@ -24,7 +24,7 @@
#################
use base qw( DBD::File );
use vars qw($VERSION $ATTRIBUTION $drh $methods_already_installed);
-$VERSION = '0.04';
+$VERSION = '0.05';
$ATTRIBUTION = 'DBD::DBM by Jeff Zucker';
# no need to have driver() unless you need private methods
@@ -418,33 +418,11 @@
croak "Cannot tie(%h $tie_class @tie_args): $@" if ($@);
}
- # COLUMN NAMES
- #
my $store = $dbh->{dbm_tables}->{$tname}->{store_metadata};
$store = $dbh->{dbm_store_metadata} unless ( defined $store );
$store = 1 unless ( defined $store );
$dbh->{dbm_tables}->{$tname}->{store_metadata} = $store;
- my ( $meta_data, $schema, $col_names );
- $meta_data = $col_names = $h{"_metadata \0"} if $store;
- if ( $meta_data and $meta_data =~ m~<dbd_metadata>(.+)</dbd_metadata>~is )
- {
- $schema = $col_names = $1;
- $schema =~ s~.*<schema>(.+)</schema>.*~$1~is;
- $col_names =~ s~.*<col_names>(.+)</col_names>.*~$1~is;
- }
- $col_names ||=
- $dbh->{dbm_tables}->{$tname}->{c_cols}
- || $dbh->{dbm_tables}->{$tname}->{cols}
- || $dbh->{dbm_cols}
- || [ 'k', 'v' ];
- $col_names = [ split /,/, $col_names ] if ( ref $col_names ne 'ARRAY' );
- $dbh->{dbm_tables}->{$tname}->{cols} = $col_names;
- $dbh->{dbm_tables}->{$tname}->{schema} = $schema;
-
- my $i;
- my %col_nums = map { $_ => $i++ } @$col_names;
-
my $tbl = {
table_name => $tname,
file => $file,
@@ -456,10 +434,38 @@
lock_fh => $lock_table->{fh},
lock_ext => $lockext,
nolock => $nolock,
- col_nums => \%col_nums,
- col_names => $col_names
+ col_names => {},
+ col_nums => [],
};
+ # COLUMN NAMES
+ #
+ unless( $createMode )
+ {
+ my ( $meta_data, $schema, $col_names );
+ $meta_data = $col_names = $h{"_metadata \0"} if $store;
+ if ( $meta_data and $meta_data =~
m~<dbd_metadata>(.+)</dbd_metadata>~is )
+ {
+ $schema = $col_names = $1;
+ $schema =~ s~.*<schema>(.+)</schema>.*~$1~is;
+ $col_names =~ s~.*<col_names>(.+)</col_names>.*~$1~is;
+ }
+ $col_names ||=
+ $dbh->{dbm_tables}->{$tname}->{c_cols}
+ || $dbh->{dbm_tables}->{$tname}->{cols}
+ || $dbh->{dbm_cols}
+ || [ 'k', 'v' ];
+ $col_names = [ split /,/, $col_names ] if ( ref $col_names ne 'ARRAY' );
+ $dbh->{dbm_tables}->{$tname}->{cols} = $col_names;
+ $dbh->{dbm_tables}->{$tname}->{schema} = $schema;
+
+ my $i;
+ my %col_nums = map { $_ => $i++ } @$col_names;
+
+ $tbl->{col_nums} = \%col_nums;
+ $tbl->{col_names} = $col_names;
+ }
+
my $class = ref($self);
$class =~ s/::Statement/::Table/;
bless( $tbl, $class );
@@ -505,28 +511,14 @@
@ary = each %{ $self->{hash} } if ( $self->{store_metadata} and $ary[0]
and $ary[0] eq "_metadata \0" );
my ( $key, $val ) = @ary;
- return undef unless ($key);
+ unless ($key)
+ {
+ delete $self->{row};
+ return;
+ }
my @row = ( ref($val) eq 'ARRAY' ) ? ( $key, @$val ) : ( $key, $val );
+ $self->{row} = @row ? \...@row : undef;
return wantarray ? @row : \...@row;
-
- # fetch without %each
- #
- # $self->{keys} = [sort keys %{$self->{hash}}] unless $self->{keys};
- # my $key = shift @{$self->{keys}};
- # $key = shift @{$self->{keys}} if $self->{store_metadata}
- # and $key
- # and $key eq "_metadata \0";
- # return undef unless defined $key;
- # my @ary;
- # $row = $self->{hash}->{$key};
- # if (ref $row eq 'ARRAY') {
- # @ary = ( $key, @{$row} );
- # }
- # else {
- # @ary = ($key,$row);
- # }
- # return (@ary) if wantarray;
- # return \...@ary;
}
# you must define push_row
@@ -591,7 +583,7 @@
{
my ( $self, $data, $aryref ) = @_;
my $key = shift @$aryref;
- return undef unless defined $key;
+ return unless(defined $key);
my $row = ( ref($aryref) eq 'ARRAY' ) ? $aryref : [$aryref];
$self->{hash}->{$key} = $self->{mldbm} ? $row : $row->[0];
}
