Author: hmbrand
Date: Fri Jun 4 05:01:41 2010
New Revision: 14102
Modified:
dbi/trunk/lib/DBD/File.pm
Log:
tidy, recode and sanity-check.
This version also checked against DBD::CSV. All tests PASS
Go Jeff! :)
Modified: dbi/trunk/lib/DBD/File.pm
==============================================================================
--- dbi/trunk/lib/DBD/File.pm (original)
+++ dbi/trunk/lib/DBD/File.pm Fri Jun 4 05:01:41 2010
@@ -40,10 +40,10 @@
DBI->setup_driver ("DBD::File"); # only needed once but harmless to repeat
my %accessors = (
- versions => 'get_file_versions',
- get_meta => 'get_file_meta',
- set_meta => 'set_file_meta',
- clear_meta => 'clear_file_meta',
+ versions => "get_file_versions",
+ get_meta => "get_file_meta",
+ set_meta => "set_file_meta",
+ clear_meta => "clear_file_meta",
);
sub driver ($;$)
@@ -82,7 +82,7 @@
my $inject = sprintf <<'EOI', $dbclass, $method, $dbclass, $funcname;
sub %s::%s
{
- my $func = %s->can( '%s' );
+ my $func = %s->can (q{%s});
goto &$func;
}
EOI
@@ -121,12 +121,12 @@
# must be done first, because setting flags implicitly calls $dbdname::st->STORE
$this->func ("init_valid_attributes");
- #$this->{f_ext} = "";
- $this->{f_dir} = File::Spec->curdir ();
- $this->{f_meta} = {};
- #$this->{f_map} = {};
+ # f_ext should not be initialized
+ # f_map is deprecated (but might return)
+ $this->{f_dir} = File::Spec->curdir ();
+ $this->{f_meta} = {};
$this->{f_meta_map} = {}; # choose new name because it contains other keys
- $this->STORE (sql_identifier_case => 2); # SQL_IC_LOWER
+ $this->STORE (sql_identifier_case => 2); # SQL_IC_LOWER
$this->STORE (sql_quoted_identifier_case => 3); # SQL_IC_SENSITIVE
my ($var, $val);
@@ -146,7 +146,7 @@
elsif ($var =~ m/^(.+?)=>(.*)/s) {
$var = $1;
($val = $2) =~ s/\\(.)/$1/g;
- my $ref = eval($val);
+ my $ref = eval $val;
$this->$var ($ref);
}
}
@@ -400,7 +400,7 @@
croak "attribute '$attrib' must have a value from 1 .. 4 (SQL_IC_UPPER .. SQL_IC_MIXED)";
}
- if (($attrib =~ m/^f_/ && $dbh->{f_readonly_attrs}{$attrib} or
+ if (($attrib =~ m/^f_/ && $dbh->{f_readonly_attrs}{$attrib} or
$attrib =~ m/^sql_/ && $dbh->{sql_readonly_attrs}{$attrib}) and
defined $dbh->{$attrib}) {
croak "attribute '$attrib' is readonly and must not be modified";
@@ -416,23 +416,23 @@
sub get_versions
{
my $dbh = $_[0];
- my %version;
- $version{'DBD::File'} = $dbh->{f_version} . " using " . $dbh->{sql_handler} . " ";
- $version{'DBD::File'} .= $dbh->{sql_handler} eq "SQL::Statement"
- ? $dbh->{sql_statement_version}
- : $dbh->{sql_nano_version};
- $version{'DBI'} = $DBI::VERSION;
- $version{"DBI::PurePerl"} = $DBI::PurePerl::VERSION if ($DBI::PurePerl);
- $version{OS} = "$^O ($Config::Config{osvers})";
- $version{Perl} = "$] ($Config::Config{archname})";
-
- my @versions;
- foreach my $vk (sort keys %version) {
- push (@versions, sprintf ("%-16s %s", $vk, $version{$vk} ));
- }
+ my %vsn = (
+ OS => "$^O ($Config::Config{osvers})",
+ Perl => "$] ($Config::Config{archname})",
+ DBI => $DBI::VERSION,
+
+ "DBD::File" => join " ",
+ $dbh->{f_version}, "using", $dbh->{sql_handler},
+ $dbh->{sql_handler} eq "SQL::Statement"
+ ? $dbh->{sql_statement_version}
+ : $dbh->{sql_nano_version},
+ );
+ $DBI::PurePerl and $vsn{"DBI::PurePerl"} = $DBI::PurePerl::VERSION;
+
+ my @versions = map { sprintf "%-16s %s", $_, $vsn{$_} } sort keys %vsn;
- return wantarray ? @versions : join ("\n", @versions);
- } # get_file_versions
+ return wantarray ? @versions : join "\n", @versions;
+ } # get_versions
sub get_file_meta
{
@@ -440,7 +440,7 @@
my $class = $dbh->FETCH ("ImplementorClass");
$class =~ s/::db$/::Table/;
- my (undef, $meta) = $class->get_table_meta( $dbh, $table, 1 );
+ my (undef, $meta) = $class->get_table_meta ($dbh, $table, 1);
$meta or croak "No such table '$table'";
# prevent creation of undef attributes
@@ -454,7 +454,7 @@
my $class = $dbh->FETCH ("ImplementorClass");
$class =~ s/::db$/::Table/;
- my (undef, $meta) = $class->get_table_meta( $dbh, $table, 1 );
+ my (undef, $meta) = $class->get_table_meta ($dbh, $table, 1);
$meta or croak "No such table '$table'";
$meta->{$attr} = $value;
@@ -467,7 +467,7 @@
my $class = $dbh->FETCH ("ImplementorClass");
$class =~ s/::db$/::Table/;
- my (undef, $meta) = $class->get_table_meta( $dbh, $table, 1 );
+ my (undef, $meta) = $class->get_table_meta ($dbh, $table, 1);
$meta and %{$meta} = ();
return;
@@ -858,23 +858,25 @@
my $cmpsub;
if ($respect_case) {
$cmpsub = sub {
- my ( $fn, undef, $sfx ) = File::Basename::fileparse( $_, qr/\.[^.]*/ );
- return ( lc $sfx eq lc $ext or (!$req and !$sfx) ) if $fn eq $tbl;
+ my ($fn, undef, $sfx) = File::Basename::fileparse ($_, qr/\.[^.]*/);
+ $fn eq $tbl and
+ return (lc $sfx eq lc $ext or !$req && !$sfx);
return 0;
}
}
else {
$cmpsub = sub {
- my ( $fn, undef, $sfx ) = File::Basename::fileparse( $_, qr/\.[^.]*/ );
- return ( lc $sfx eq lc $ext or (!$req and !$sfx) ) if lc $fn eq lc $tbl;
+ my ($fn, undef, $sfx) = File::Basename::fileparse ($_, qr/\.[^.]*/);
+ lc $fn eq lc $tbl and
+ return (lc $sfx eq lc $ext or !$req && !$sfx);
return 0;
}
}
opendir my $dh, $searchdir or croak "Can't open '$searchdir': $!";
- my @f = sort { length $b <=> length $a } ( grep { &$cmpsub($_) } readdir $dh );
- @f > 0 and @f <= 2 and $file = $f[0];
- !$respect_case and $meta->{sql_identifier_case} == 4 and # XXX SQL_IC_MIXED
+ my @f = sort { length $b <=> length $a } grep { &$cmpsub ($_) } readdir $dh;
+ @f > 0 && @f <= 2 and $file = $f[0];
+ !$respect_case && $meta->{sql_identifier_case} == 4 and # XXX SQL_IC_MIXED
($tbl = $file) =~ s/$ext$//i;
closedir $dh or croak "Can't close '$searchdir': $!";
@@ -941,7 +943,7 @@
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};
+ defined $dbh->{f_meta}{$table} and $meta = $dbh->{f_meta}{$table};
unless ($meta->{initialized}) {
$self->bootstrap_table_meta ($dbh, $meta, $table);
@@ -949,7 +951,7 @@
$self->file2table ($meta, $table, $file_is_table, $respect_case) or return;
}
- if( defined $meta->{table_name} and $table ne $meta->{table_name} ) {
+ if (defined $meta->{table_name} and $table ne $meta->{table_name}) {
$dbh->{f_meta_map}{$table} = $meta->{table_name};
$table = $meta->{table_name};
}
lmpx.com only provides a reader for public news (NNTP) servers. It is not
affiliated with the servers or forums shown here and is not responsible for
the content of articles, which is written by their respective authors.