Changed $sth->{TYPE} to be NUMERIC in DBD::File

Author: H.Merijn Brand - Tux

Changes

@@ -11,8 +11,10 @@ DBI::Changes - List of significant changes to the DBI
     Fixed selectrow_*ref to return undef on error in list context
         instead if an empty list.
     Changed t/42prof_data.t more informative
+    Changed $sth->{TYPE} to be NUMERIC in DBD::File drivers as per the
+	DBI docs. Note TYPE_NAME is now also available. [H.Merijn Brand]
 
-=head2 Changes in DBI 1.632 - 5th Nov 2014
+=head2 Changes in DBI 1.632 - 9th Nov 2014
 
     Fixed risk of memory corruption with many arguments to methods
         originally reported by OSCHWALD for Callbacks but may apply

lib/DBD/File.pm

@@ -321,20 +321,50 @@ sub FETCH
 
 	    # fill overall_defs unless we know
 	    unless (exists $sth->{f_overall_defs} && ref $sth->{f_overall_defs}) {
+		my $types = $sth->{Database}{Types};
+		unless ($types) { # Feth types only once per database
+		    if (my $t = $sth->{Database}->type_info_all ()) {
+			foreach my $i (1 .. $#$t) {
+			    $types->{uc $t->[$i][0]}   = $t->[$i][1];
+			    $types->{$t->[$i][1]} ||= uc $t->[$i][0];
+			    }
+			}
+		    # sane defaults
+		    for ([  0, ""		],
+			 [  1, "CHAR"		],
+			 [  4, "INTEGER"	],
+			 [ 12, "VARCHAR"	],
+			 ) {
+			$types->{$_->[0]} ||= $_->[1];
+			$types->{$_->[1]} ||= $_->[0];
+			}
+		    $sth->{Database}{Types} = $types;
+		    }
 		my $all_meta =
 		    $sth->{Database}->func ("*", "table_defs", "get_sql_engine_meta");
 		while (my ($tbl, $meta) = each %$all_meta) {
 		    exists $meta->{table_defs} && ref $meta->{table_defs} or next;
 		    foreach (keys %{$meta->{table_defs}{columns}}) {
-			$sth->{f_overall_defs}{$_} = $meta->{table_defs}{columns}{$_};
+			my $field_info = $meta->{table_defs}{columns}{$_};
+			if (defined $field_info->{data_type} &&
+				    $field_info->{data_type} !~ m/^[0-9]+$/) {
+			    $field_info->{type_name} = uc $field_info->{data_type};
+			    $field_info->{data_type} = $types->{$field_info->{type_name}} || 0;
+			    }
+			$field_info->{type_name} ||= $types->{$field_info->{data_type}} || "CHAR";
+			$sth->{f_overall_defs}{$_} = $field_info;
 			}
 		    }
 		}
 
 	    my @colnames = $sth->sql_get_colnames ();
 
 	    $attr eq "TYPE"      and
-		return [ map { $sth->{f_overall_defs}{$_}{data_type}   || "CHAR" }
+		return [ map { $sth->{f_overall_defs}{$_}{data_type}   || 12 }
+			    @colnames ];
+
+	    $attr eq "TYPE_NAME" and
+		return [ map { $sth->{f_overall_defs}{$_}{type_name}   || "VARCHAR" }
 			    @colnames ];
 
 	    $attr eq "PRECISION" and

t/49dbd_file.t

@@ -176,8 +176,10 @@ ok ($dbh = DBI->connect ("dbi:File:", undef, undef, {
 ok ($sth = $dbh->prepare ("select * from $tbl"), "Prepare select * from $tbl");
 $rowidx = 0;
 SKIP: {
-    $using_dbd_gofer and skip "method intrusion didn't work with proxying", 1;
+    $using_dbd_gofer and skip "method intrusion didn't work with proxying", 3;
     ok ($sth->execute, "execute on $tbl");
+    like ($_, qr{^[0-9]+$},   "TYPE is numeric")  for @{$sth->{TYPE}};
+    like ($_, qr{^[A-Z]\w+$}, "TYPE_NAME is set") for @{$sth->{TYPE_NAME}};
     $dbh->errstr and diag $dbh->errstr;
     }