Copy the working mk_hash from HashRefInflator in -current into Cookbook

[dbsrgits/DBIx-Class-Historic.git] / lib / DBIx / Class / Storage / DBI.pm

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 6cfc4b8..cee2436 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -52,9 +52,11 @@ WHERE ROW_NUM BETWEEN $offset AND $last
 
 # While we're at it, this should make LIMIT queries more efficient,
 #  without digging into things too deeply
+use Scalar::Util 'blessed';
 sub _find_syntax {
   my ($self, $syntax) = @_;
-  my $dbhname = eval { $syntax->{Driver}->{Name}} || '';
+  my $dbhname = blessed($syntax) ?  $syntax->{Driver}{Name} : $syntax;
+#  print STDERR "Found DBH $syntax >$dbhname< ", $syntax->{Driver}->{Name}, "\n";
   if(ref($self) && $dbhname && $dbhname eq 'DB2') {
     return 'RowNumberOver';
   }
@@ -230,9 +232,18 @@ sub _join_condition {
   if (ref $cond eq 'HASH') {
     my %j;
     for (keys %$cond) {
-      my $x = '= '.$self->_quote($cond->{$_}); $j{$_} = \$x;
+      my $v = $cond->{$_};
+      if (ref $v) {
+        # XXX no throw_exception() in this package and croak() fails with strange results
+        Carp::croak(ref($v) . qq{ reference arguments are not supported in JOINS - try using \"..." instead'})
+            if ref($v) ne 'SCALAR';
+        $j{$_} = $v;
+      }
+      else {
+        my $x = '= '.$self->_quote($v); $j{$_} = \$x;
+      }
     };
-    return $self->_recurse_where(\%j);
+    return scalar($self->_recurse_where(\%j));
   } elsif (ref $cond eq 'ARRAY') {
     return join(' OR ', map { $self->_join_condition($_) } @$cond);
   } else {
@@ -777,7 +788,7 @@ sub _execute {
     $self->throw_exception("'$sql' did not generate a statement.");
   }
   if ($self->debug) {
-      my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind;
+      my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind; 
       $self->debugobj->query_end($sql, @debug_bind);
   }
   return (wantarray ? ($rv, $sth, @bind) : $rv);
@@ -828,6 +839,12 @@ sub _select {
 
 =head2 select
 
+=over 4
+
+=item Arguments: $ident, $select, $condition, $attrs
+
+=back
+
 Handle a SQL select statement.
 
 =cut
@@ -857,6 +874,12 @@ sub select_single {
 
 =head2 sth
 
+=over 4
+
+=item Arguments: $sql
+
+=back
+
 Returns a L<DBI> sth (statement handle) for the supplied SQL.
 
 =cut
@@ -869,7 +892,7 @@ sub sth {
 
 =head2 columns_info_for
 
-Returns database type info for a given table columns.
+Returns database type info for a given table column.
 
 =cut
 
@@ -903,18 +926,12 @@ sub columns_info_for {
   }
 
   my %result;
-  my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0");
+  my $sth = $dbh->prepare($self->sql_maker->select($table, undef, \'1 = 0'));
   $sth->execute;
   my @columns = @{$sth->{NAME_lc}};
   for my $i ( 0 .. $#columns ){
     my %column_info;
-    my $type_num = $sth->{TYPE}->[$i];
-    my $type_name;
-    if(defined $type_num && $dbh->can('type_info')) {
-      my $type_info = $dbh->type_info($type_num);
-      $type_name = $type_info->{TYPE_NAME} if $type_info;
-    }
-    $column_info{data_type} = $type_name ? $type_name : $type_num;
+    $column_info{data_type} = $sth->{TYPE}->[$i];
     $column_info{size} = $sth->{PRECISION}->[$i];
     $column_info{is_nullable} = $sth->{NULLABLE}->[$i] ? 1 : 0;
 
@@ -925,6 +942,18 @@ sub columns_info_for {
 
     $result{$columns[$i]} = \%column_info;
   }
+  $sth->finish;
+
+  foreach my $col (keys %result) {
+    my $colinfo = $result{$col};
+    my $type_num = $colinfo->{data_type};
+    my $type_name;
+    if(defined $type_num && $dbh->can('type_info')) {
+      my $type_info = $dbh->type_info($type_num);
+      $type_name = $type_info->{TYPE_NAME} if $type_info;
+      $colinfo->{data_type} = $type_name if $type_name;
+    }
+  }
 
   return \%result;
 }
@@ -958,7 +987,7 @@ sub sqlt_type { shift->dbh->{Driver}->{Name} }
 
 =back
 
-Creates an SQL file based on the Schema, for each of the specified
+Creates a SQL file based on the Schema, for each of the specified
 database types, in the given directory.
 
 Note that this feature is currently EXPERIMENTAL and may not work correctly
@@ -1018,8 +1047,24 @@ sub create_ddl_dir
 
 =head2 deployment_statements
 
-Create the statements for L</deploy> and
-L<DBIx::Class::Schema/deploy>.
+=over 4
+
+=item Arguments: $schema, $type, $version, $directory, $sqlt_args
+
+=back
+
+Returns the statements used by L</deploy> and L<DBIx::Class::Schema/deploy>.
+The database driver name is given by C<$type>, though the value from
+L</sqlt_type> is used if it is not specified.
+
+C<$directory> is used to return statements from files in a previously created
+L</create_ddl_dir> directory and is optional. The filenames are constructed
+from L<DBIx::Class::Schema/ddl_filename>, the schema name and the C<$version>.
+
+If no C<$directory> is specified then the statements are constructed on the
+fly using L<SQL::Translator> and C<$version> is ignored.
+
+See L<SQL::Translator/METHODS> for a list of values for C<$sqlt_args>.
 
 =cut
 
@@ -1197,4 +1242,3 @@ Andy Grundman <andy@hybridized.org>
 You may distribute this code under the same terms as Perl itself.
 
 =cut
-