Author: REHSACK
Date: Wed Jun 30 03:37:17 2010
New Revision: 14201
Modified:
dbi/trunk/lib/DBD/DBM.pm
dbi/trunk/lib/DBD/File.pm
Log:
- remove duplicated code from DBD::File
- add register_reset_on_modify to DBD::File::Table
- register meta flags to reset in DBD::DBM
Modified: dbi/trunk/lib/DBD/DBM.pm
==============================================================================
--- dbi/trunk/lib/DBD/DBM.pm (original)
+++ dbi/trunk/lib/DBD/DBM.pm Wed Jun 30 03:37:17 2010
@@ -257,6 +257,12 @@
return $tbl;
}
+my %reset_on_modify = (
+ dbm_type => "dbm_tietype",
+ dbm_mldbm => "dbm_tietype",
+);
+__PACKAGE__->register_reset_on_modify(\%reset_on_modify);
+
sub bootstrap_table_meta
{
my ( $self, $dbh, $meta, $table ) = @_;
Modified: dbi/trunk/lib/DBD/File.pm
==============================================================================
--- dbi/trunk/lib/DBD/File.pm (original)
+++ dbi/trunk/lib/DBD/File.pm Wed Jun 30 03:37:17 2010
@@ -110,49 +110,6 @@
@DBD::File::dr::ISA = qw(DBI::DBD::SqlEngine::dr);
$DBD::File::dr::imp_data_size = 0;
-sub connect ($$;$$$)
-{
- my ($drh, $dbname, $user, $auth, $attr)= @_;
-
- # create a 'blank' dbh
- my $this = DBI::_new_dbh ($drh, {
- Name => $dbname,
- USER => $user,
- CURRENT_USER => $user,
- });
-
- if ($this) {
- # must be done first, because setting flags implicitly calls
$dbdname::db->STORE
- $this->func ("init_default_attributes");
-
- my ($var, $val);
- while (length $dbname) {
- if ($dbname =~ s/^((?:[^\\;]|\\.)*?);//s) {
- $var = $1;
- }
- else {
- $var = $dbname;
- $dbname = "";
- }
- if ($var =~ m/^(.+?)=(.*)/s) {
- $var = $1;
- ($val = $2) =~ s/\\(.)/$1/g;
- $this->{$var} = $val;
- }
- elsif ($var =~ m/^(.+?)=>(.*)/s) {
- $var = $1;
- ($val = $2) =~ s/\\(.)/$1/g;
- my $ref = eval $val;
- $this->$var ($ref);
- }
- }
-
- $this->STORE (Active => 1);
- }
-
- return $this;
- } # connect
-
sub dsn_quote
{
my $str = shift;
@@ -318,21 +275,6 @@
return $dbh;
} # init_default_attributes
-sub sql_parser_object
-{
- my $dbh = shift;
- my $parser = {
- dialect => "CSV",
- RaiseError => $dbh->FETCH ("RaiseError"),
- PrintError => $dbh->FETCH ("PrintError"),
- };
- my $sql_flags = $dbh->FETCH ("sql_flags") || {};
- %$parser = (%$parser, %$sql_flags);
- $parser = SQL::Parser->new ($parser->{dialect}, $parser);
- $dbh->{sql_parser_object} = $parser;
- return $parser;
- } # cache_sql_parser_object
-
sub disconnect ($)
{
$_[0]->STORE (Active => 0);
@@ -949,6 +891,20 @@
return ($table, $meta);
} # get_table_meta
+my %reset_on_modify = (
+ f_file => "f_fqfn",
+ f_dir => "f_fqfn",
+ f_ext => "f_fqfn",
+ f_lockfile => "f_fqfn", # forces new file2table call
+);
+
+sub register_reset_on_modify
+{
+ my ($proto, $extra_resets) = @_;
+ %reset_on_modify = (%reset_on_modify, %$extra_resets);
+ return;
+ } # register_reset_on_modify
+
sub get_table_meta_attr
{
my ($class, $meta, $attrib) = @_;
@@ -957,13 +913,6 @@
return;
} # get_table_meta_attr
-my %reset_on_modify = (
- f_file => "f_fqfn",
- f_dir => "f_fqfn",
- f_ext => "f_fqfn",
- f_lockfile => "f_fqfn", # forces new file2table call
-);
-
sub set_table_meta_attr
{
my ($class, $meta, $attrib, $value) = @_;
@@ -1126,7 +1075,7 @@
=head1 NAME
-DBD::File - Base class for writing DBI drivers
+DBD::File - Base class for writing file based DBI drivers
=head1 SYNOPSIS
