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

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;