[svn:dbi] r14145 - in dbi/trunk: lib/DBD t

[REHSACK]

Author: REHSACK
Date: Mon Jun 14 13:14:31 2010
New Revision: 14145

Modified:
   dbi/trunk/lib/DBD/File.pm
   dbi/trunk/t/49dbd_file.t

Log:
add support to retrieve multiple meta data sets
add appropriate tests for retrieving meta data sets


Modified: dbi/trunk/lib/DBD/File.pm
==============================================================================
--- dbi/trunk/lib/DBD/File.pm   (original)
+++ dbi/trunk/lib/DBD/File.pm   Mon Jun 14 13:14:31 2010
@@ -520,7 +520,7 @@
     return wantarray ? @versions : join "\n", @versions;
     } # get_versions
 
-sub get_file_meta
+sub get_single_table_meta
 {
     my ($dbh, $table, $attr) = @_;
     my $meta;
@@ -535,6 +535,42 @@
 
     # prevent creation of undef attributes
     return $class->get_table_meta_attr ($meta, $attr);
+    } # get_single_table_meta
+
+sub get_file_meta
+{
+    my ($dbh, $table, $attr) = @_;
+
+    my $gstm = $dbh->{ImplementorClass}->can ("get_single_table_meta");
+
+    $table eq "*" and
+       $table = [ ".", keys %{$dbh->{f_meta}} ];
+    $table eq "+" and
+       $table = [ grep { m/^[_A-Za-z0-9]+$/ } keys %{$dbh->{f_meta}} ];
+    ref ($table) eq "Regexp" and
+       $table = [ grep { $_ =~ $table } keys %{$dbh->{f_meta}} ];
+
+    unless (ref ($table) or ref ($attr)) {
+       return &$gstm ($dbh, $table, $attr);
+       }
+    else {
+       ref $attr or $attr = [ $attr ];
+       "ARRAY" eq ref $table or
+           croak "Invalid argument for \$table - SCALAR, Regexp or ARRAY 
expected but got " . ref $table;
+       "ARRAY" eq ref $attr or
+           croak "Invalid argument for \$attr - SCALAR or ARRAY expected but 
got " . ref $attr;
+
+       my %results;
+       foreach my $tname (@{$table}) {
+           my %tattrs;
+           foreach my $aname (@{$attr}) {
+               $tattrs{$aname} = &$gstm ($dbh, $tname, $aname);
+               }
+               $results{$tname} = \%tattrs;
+           }
+
+       return \%results;
+       }
     } # get_file_meta
 
 sub set_file_meta

Modified: dbi/trunk/t/49dbd_file.t
==============================================================================
--- dbi/trunk/t/49dbd_file.t    (original)
+++ dbi/trunk/t/49dbd_file.t    Mon Jun 14 13:14:31 2010
@@ -101,6 +101,20 @@
 ok ($dbh->do ("create table $tbl (txt varchar (20))"), "Create table $tbl") or 
diag $dbh->errstr;
 ok (-f $tbl_file, "Test table exists");
 
+is ($dbh->f_get_meta ($tbl, "f_fqfn"), $tbl_file, "get single table meta 
data");
+is_deeply ($dbh->f_get_meta ([$tbl, "t_sbdgf_53442Gz"], [qw(f_dir f_ext)]),
+           {
+              $tbl => {
+                  f_dir => $dir,
+                  f_ext => q(.txt),
+              },
+              t_sbdgf_53442Gz =>  {
+                  f_dir => $dir,
+                  f_ext => q(.txt),
+              },
+          },
+          "get multiple meta data");
+
 # Expected: ("unix", "perlio", "encoding(iso-8859-1)")
 # use Data::Peek; DDumper [ @tfh ];
 my @layer = grep { $_ eq "encoding($encoding)" } @tfhl;