introduce new_sql_engine_meta to PurePerl DBD's

Author: rehsack

lib/DBD/File.pm

@@ -956,6 +956,8 @@ sub DESTROY
     $meta->{lockfh} and $meta->{lockfh}->close ();
     undef $meta->{fh};
     undef $meta->{lockfh};
+
+    $self->SUPER::DESTROY();
     } # DESTROY
 
 1;

lib/DBI/DBD/SqlEngine.pm

@@ -41,6 +41,7 @@ DBI->setup_driver("DBI::DBD::SqlEngine");    # only needed once but harmless to
 
 my %accessors = (
                   versions   => "get_driver_versions",
+                  new_meta   => "new_sql_engine_meta",
                   get_meta   => "get_sql_engine_meta",
                   set_meta   => "set_sql_engine_meta",
                   clear_meta => "clear_sql_engine_meta",
@@ -392,6 +393,7 @@ sub init_valid_attributes
                              sql_init_phase             => 1,    # Only during initialization
                              sql_meta                   => 1,    # meta data for tables
                              sql_meta_map               => 1,    # mapping table for identifier case
+			     sql_data_source            => 1,    # reasonable datasource class
                               };
     $dbh->{sql_readonly_attrs} = {
                                sql_engine_version         => 1,    # DBI::DBD::SqlEngine version
@@ -771,7 +773,7 @@ sub get_sql_engine_meta
       and $table = [ grep { $_ =~ $table } keys %{ $dbh->{sql_meta} } ];
 
     ref $table || ref $attr
-      or return &$gstm( $dbh, $table, $attr );
+      or return $gstm->( $dbh, $table, $attr );
 
     ref $table or $table = [$table];
     ref $attr  or $attr  = [$attr];
@@ -789,14 +791,37 @@ sub get_sql_engine_meta
         my %tattrs;
         foreach my $aname ( @{$attr} )
         {
-            $tattrs{$aname} = &$gstm( $dbh, $tname, $aname );
+            $tattrs{$aname} = $gstm->( $dbh, $tname, $aname );
         }
         $results{$tname} = \%tattrs;
     }
 
     return \%results;
 }    # get_sql_engine_meta
 
+sub new_sql_engine_meta
+{
+    my ( $dbh, $table, $values ) = @_;
+    my $respect_case = 0;
+
+    "HASH" eq ref $values
+      or croak "Invalid argument for \$values - SCALAR or HASH expected but got " . ref $values;
+
+    $table =~ s/^\"// and $respect_case = 1;    # handle quoted identifiers
+    $table =~ s/\"$//;
+
+    unless ($respect_case)
+    {
+        defined $dbh->{sql_meta_map}{$table} and $table = $dbh->{sql_meta_map}{$table};
+    }
+
+    $dbh->{sql_meta}{$table} = { %{$values} };
+    ( my $class = $dbh->{ImplementorClass} ) =~ s/::db$/::Table/;
+    # XXX we should never hit DBD::File::Table::get_table_meta here ...
+    my ( undef, $meta ) = $class->get_table_meta( $dbh, $table, $respect_case );
+    1;
+}    # new_sql_engine_meta
+
 sub set_single_table_meta
 {
     my ( $dbh, $table, $attr, $value ) = @_;
@@ -806,7 +831,7 @@ sub set_single_table_meta
       and return $dbh->STORE( $attr, $value );
 
     ( my $class = $dbh->{ImplementorClass} ) =~ s/::db$/::Table/;
-    ( undef, $meta ) = $class->get_table_meta( $dbh, $table, 1 );
+    ( undef, $meta ) = $class->get_table_meta( $dbh, $table, 1 ); # 1 means: respect case
     $meta or croak "No such table '$table'";
     $class->set_table_meta_attr( $meta, $attr, $value );
 
@@ -827,7 +852,7 @@ sub set_sql_engine_meta
       and $table = [ grep { $_ =~ $table } keys %{ $dbh->{sql_meta} } ];
 
     ref $table || ref $attr
-      or return &$sstm( $dbh, $table, $attr, $value );
+      or return $sstm->( $dbh, $table, $attr, $value );
 
     ref $table or $table = [$table];
     ref $attr or $attr = { $attr => $value };
@@ -839,10 +864,9 @@ sub set_sql_engine_meta
 
     foreach my $tname ( @{$table} )
     {
-        my %tattrs;
         while ( my ( $aname, $aval ) = each %$attr )
         {
-            &$sstm( $dbh, $tname, $aname, $aval );
+            $sstm->( $dbh, $tname, $aname, $aval );
         }
     }
 
@@ -1625,6 +1649,14 @@ sub new
     return $className->SUPER::new($tbl);
 }    # new
 
+sub DESTROY
+{
+    my $self = shift;
+    my $meta = $self->{meta};
+    $self->{row} and undef $self->{row};
+    ()
+}
+
 1;
 
 =pod

lib/DBI/DBD/SqlEngine/HowTo.pod

@@ -194,10 +194,10 @@ DBI::DBD::SqlEngine provides only readonly access to this structure,
 modifications are still allowed.
 
 Primarily DBI::DBD::SqlEngine provides access via the setters
-C<get_sql_engine_meta>, C<get_single_table_meta>, C<set_single_table_meta>,
-C<set_sql_engine_meta> and C<clear_sql_engine_meta>. Those methods are
-easily accessible by the users via the C<< $dbh->func () >> interface
-provided by DBI. Well, many users don't feel comfortize when calling
+C<new_sql_engine_meta>, C<get_sql_engine_meta>, C<get_single_table_meta>,
+C<set_single_table_meta>, C<set_sql_engine_meta> and C<clear_sql_engine_meta>.
+Those methods are easily accessible by the users via the C<< $dbh->func () >>
+interface provided by DBI. Well, many users don't feel comfortize when calling
 
     # don't require extension for tables cars
     $dbh->func ("cars", "f_ext", ".csv", "set_sql_engine_meta");

t/49dbd_file.t

@@ -130,11 +130,19 @@ ok ($sth = $dbh->table_info (), "table_info");
 is_deeply (\@tables, [ map { [ undef, undef, $_, 'TABLE', 'FILE' ] } sort "000_just_testing", $tbl ], "table_info gives test table");
 
 SKIP: {
-    $using_dbd_gofer and skip "modifying meta data doesn't work with Gofer-AutoProxy", 4;
+    $using_dbd_gofer and skip "modifying meta data doesn't work with Gofer-AutoProxy", 6;
     ok ($dbh->f_set_meta ($tbl, "f_dir", $dir), "set single meta datum");
     is ($tbl_file, $dbh->f_get_meta ($tbl, "f_fqfn"), "verify set single meta datum");
     ok ($dbh->f_set_meta ($tbl, { f_dir => $dir }), "set multiple meta data");
     is ($tbl_file, $dbh->f_get_meta ($tbl, "f_fqfn"), "verify set multiple meta attributes");
+
+    ok($dbh->f_new_meta("t_bsgdf_3544G2z", {
+	f_ext	=> undef,
+	f_dir	=> $dir,
+	}), "initialize new table (meta) with settings");
+
+    my $t_bsgdf_file = File::Spec->catfile (Cwd::abs_path ($dir), "t_bsgdf_3544G2z");
+    is($t_bsgdf_file, $dbh->f_get_meta ("t_bsgdf_3544G2z", "f_fqfn"), "verify create meta from scratch");
     }
 
 ok ($sth = $dbh->prepare ("select * from $tbl"), "Prepare select * from $tbl");