[svn:dbi] r14084 - dbi/trunk/lib/DBD

Author: hmbrand
Date: Fri May 28 12:51:42 2010
New Revision: 14084

Modified:
   dbi/trunk/lib/DBD/File.pm

Log:
Fix table_info () and table names

and some tidying

Modified: dbi/trunk/lib/DBD/File.pm
==============================================================================
--- dbi/trunk/lib/DBD/File.pm	(original)
+++ dbi/trunk/lib/DBD/File.pm	Fri May 28 12:51:42 2010
@@ -97,6 +97,8 @@
 	$this->func ("init_valid_attributes");
 	my ($var, $val);
 	$this->{f_dir} = File::Spec->curdir ();
+	$this->{f_ext} = "";
+	$this->{f_map} = {};
 	while (length $dbname) {
 	    if ($dbname =~ s/^((?:[^\\;]|\\.)*?);//s) {
 		$var    = $1;
@@ -346,24 +348,29 @@
 	    File::Spec->file_name_is_absolute ($value) or
 	        $value = Cwd::abs_path ($value);
 	    }
+
 	if ($attrib eq "f_ext") {
 	    $value eq "" || $value =~ m{^\.\w+(?:/[rR]*)?$} or
 		carp "'$value' doesn't look like a valid file extension attribute\n";
 	    }
-	if (($attrib eq "sql_identifier_case" or $attrib eq "sql_quoted_identifier_case") and
-	    ($value < 1 or $value > 4)) {
+
+	if (    $attrib eq "sql_identifier_case" ||
+	        $attrib eq "sql_quoted_identifier_case"
+	    and
+		$value < 1 || $value > 4) {
 	    croak "attribute '$attrib' must have a value from 1 .. 4 (SQL_IC_UPPER .. SQL_IC_MIXED)";
 	    }
 
-        if (( 0 == index( $attrib, "f_" ) and $dbh->{f_readonly_attrs}->{$attrib}) or 
-            ( 0 == index( $attrib, "sql_" ) and $dbh->{sql_readonly_attrs}->{$attrib}) and
-	    defined($dbh->{$attrib})) {
+        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";
 	    }
 
 	$dbh->{$attrib} = $value;
 	return 1;
 	}
+
     return $dbh->SUPER::STORE ($attrib, $value);
     } # STORE
 
@@ -436,10 +443,12 @@
 	    ? defined $dbh->{f_schema} && $dbh->{f_schema} ne ""
 		? $dbh->{f_schema} : undef
 	    : eval { getpwuid ((stat $dir)[4]) }; # XXX Win32::pwent
+	my %seen;
 	while (defined ($file = readdir ($dirh))) {
 	    my ($tbl, $meta) = $class->get_table_meta ($dbh, $file, 0, 0) or next; # XXX
 	    # $tbl && $meta && -f $meta->{f_fqfn} or next;
-	    push @tables, [ undef, $schema, $tbl, "TABLE", undef ];
+	    $seen{"$schema\0$tbl"}++ or
+		push @tables, [ undef, $schema, $tbl, "TABLE", undef ];
 	    }
 	unless (closedir $dirh) {
 	    $dbh->set_err ($DBI::stderr, "Cannot close directory $dir: $!");
@@ -734,15 +743,17 @@
 	}
 
     # (my $tbl = $file) =~ s/$ext$//i;
-    my ( $tbl, $dir, undef ) = File::Basename::fileparse( $file, $ext );
-    Cwd::abs_path( $dir ) eq $meta->{f_dir} and
-        $dir = "";
+    my ($tbl, $dir, undef) = File::Basename::fileparse ($file, $ext);
+    Cwd::abs_path ($dir) eq $meta->{f_dir} and
+	$dir = "";
     !$respect_case and $meta->{sql_identifier_case} == 1 and # XXX SQL_IC_UPPER
-        $tbl = uc($tbl);
+        $tbl = uc $tbl;
     !$respect_case and $meta->{sql_identifier_case} == 2 and # XXX SQL_IC_LOWER
-        $tbl = lc($tbl);
+        $tbl = lc $tbl;
     $file_is_table and $file = "$tbl$ext";
-    my $searchdir = File::Spec->file_name_is_absolute ($dir) ? $dir : File::Spec->catdir ($meta->{f_dir}, $dir);
+    my $searchdir = File::Spec->file_name_is_absolute ($dir)
+	? $dir
+	: File::Spec->catdir ($meta->{f_dir}, $dir);
 
     # Fully Qualified File Name
     unless ($respect_case) { # table names are case insensitive in SQL
@@ -750,12 +761,14 @@
 	my @f = grep { lc $_ eq lc $file } readdir $dh;
 	@f == 1 and $file = $f[0];
 	!$respect_case and $meta->{sql_identifier_case} == 4 and # XXX SQL_IC_MIXED
-	    ($tbl = $file ) =~ s/$ext$//i;
+	    ($tbl = $file) =~ s/$ext$//i;
 	closedir $dh or croak "Can't close '$searchdir': $!";
 	}
-    my $fqfn = Cwd::abs_path( File::Spec->catfile ($searchdir, $file) );
+    my $fqfn = Cwd::abs_path (File::Spec->catfile ($searchdir, $file));
     my $fqbn = File::Spec->catfile ($searchdir, $tbl);
-    $dir and $tbl = File::Spec->catfile ($dir, $tbl);
+
+    (my $tdir = $dir) =~ s{^\./}{};	# We do not want all tables to start with ./
+    $tdir and $tbl = File::Spec->catfile ($tdir, $tbl);
 
     $file = $fqfn;
     if ($ext) {
@@ -772,11 +785,11 @@
 
     $meta->{f_fqfn} = $fqfn;
     $meta->{f_fqbn} = $file;
-    !defined ($meta->{f_lockfile}) && $meta->{f_lockfile} and
+    !defined $meta->{f_lockfile} && $meta->{f_lockfile} and
 	$meta->{f_fqln} = $meta->{f_fqbn} . $meta->{f_lockfile};
 
     $meta->{table_name} = $tbl;
-    $respect_case or $tbl = lc($tbl); # for internal storage
+    $respect_case or $tbl = lc $tbl; # for internal storage
 
     return $tbl;
     } # file2table
@@ -811,16 +824,9 @@
 	$table =~ s/\"$//;
 	}
 
-    my $meta;
-    if( defined( $dbh->{f_meta}->{$table} ) ) {
-	$meta = $dbh->{f_meta}->{$table};
-	}
-    else {
-	$meta = {};
-	}
-
-    unless( $meta->{initialized} ) {
-	$self->bootstrap_table_meta($dbh, $meta, $table);
+    my $meta = $dbh->{f_meta}{$table} || {};
+    unless ($meta->{initialized}) {
+	$self->bootstrap_table_meta ($dbh, $meta, $table);
 
 	unless (defined $meta->{f_fqfn}) {
 	    $table = $self->file2table ($meta, $table, $file_is_table, $respect_case);
@@ -829,7 +835,7 @@
 
 	$self->init_table_meta ($dbh, $meta, $table);
 	$meta->{initialized} = 1;
-	$dbh->{f_meta}->{$table} = $meta;
+	$dbh->{f_meta}{$table} = $meta;
 	}
 
     return ($table, $meta);