Merge 'DBIx-Class-current' into 'param_bind'
Matt S Trout [Sat, 30 Dec 2006 19:16:20 +0000 (19:16 +0000)]
r33850@cain (orig r2909):  ash | 2006-11-18 01:13:36 +0000
Removed Class::Data::Accessor and DBIx::Class::AccessorGrouped and
replaced with Class::Accessor::Grouped.

component_class type accessors now just inherited and so no longer
automatcally require classes when set (noted in changes)

Added auto_install to Makefile.PL

r33996@cain (orig r2911):  matthewt | 2006-11-20 19:11:15 +0000
 r33842@cain (orig r2901):  bricas | 2006-11-16 15:54:41 +0000
 bumped ver. added some stuff to Changes i know were missing.
 r33845@cain (orig r2904):  blblack | 2006-11-16 16:43:42 +0000
 added changes entry for rt#22740
 r33846@cain (orig r2905):  castaway | 2006-11-16 16:45:29 +0000
 Added patch from Ted Carnahan to rel docs

r34019@cain (orig r2917):  matthewt | 2006-11-22 05:22:32 +0000
moved tests to compose_namespace instead of compose_connection, marked compose_connection as deprecated, undocumented DB.pm
r34020@cain (orig r2918):  matthewt | 2006-11-22 05:30:06 +0000
class reg test
r34029@cain (orig r2921):  claco | 2006-11-22 17:38:43 +0000
Updated version requirement for Class::Accessor::Grouped to 0.03
r34035@cain (orig r2925):  ningu | 2006-11-22 22:10:30 +0000
 r18925@haferschleim (orig r2919):  ningu | 2006-11-21 22:44:26 -0800
 - slight optimization to ident_condition in PK.pm
 - get ident_cond in update() before applying arguments, so a column's pk can be updated
 r18926@haferschleim (orig r2920):  ningu | 2006-11-21 22:54:10 -0800
 revert update() change
 r18953@haferschleim (orig r2922):  ningu | 2006-11-22 12:12:43 -0800
 re-commit minimal pk-mutation in update(), with test
 r18956@haferschleim (orig r2924):  ningu | 2006-11-22 14:09:07 -0800
 add shallow copy of $attrs in ResultSet->new

r34039@cain (orig r2929):  ningu | 2006-11-23 00:02:14 +0000
trivial test cleanup
r34041@cain (orig r2931):  matthewt | 2006-11-23 20:05:52 +0000
 r28722@cain (orig r2813):  castaway | 2006-10-06 19:45:42 +0000
 Versioning! With tests! Woo!

r34042@cain (orig r2932):  matthewt | 2006-11-23 20:05:58 +0000
 r28723@cain (orig r2814):  castaway | 2006-10-06 19:52:38 +0000
 s/Path::Class/File::Spec/

r34043@cain (orig r2933):  matthewt | 2006-11-23 20:06:02 +0000

r34044@cain (orig r2934):  matthewt | 2006-11-23 20:06:06 +0000

r34045@cain (orig r2935):  matthewt | 2006-11-23 20:06:09 +0000
 r34031@cain (orig r2923):  castaway | 2006-11-22 20:44:36 +0000
 Fix tests, remove some random rints

r34046@cain (orig r2936):  matthewt | 2006-11-23 20:06:14 +0000

r34142@cain (orig r2940):  ningu | 2006-11-23 21:39:33 +0000
- nuke old _resultset caching stuff
- teeny cleanup to ResultSetColumn code
r34143@cain (orig r2941):  castaway | 2006-11-23 23:33:42 +0000
Add backup_directory, make tests cleanup

r34148@cain (orig r2946):  matthewt | 2006-11-26 16:21:17 +0000
 r34145@cain (orig r2943):  nigel | 2006-11-26 13:24:39 +0000
 Added a test to check that the result from a 2 level has_many prefetch
 is the same as that got by expanding the relationships one thing at a
 time.

r34189@cain (orig r2948):  ash | 2006-11-27 19:34:28 +0000
- $schema->deploy now accepts a list of source (name)s to deploy
- Also fixed creating of FK constraints to use is_foreign_key attr explicitly
  even if no back rel
r34191@cain (orig r2950):  ash | 2006-11-27 21:39:23 +0000
Typo fix in error message
r34192@cain (orig r2951):  ash | 2006-11-27 21:52:10 +0000
Fixed ningu's typo from rev 2929, and added test to catch error better
r34194@cain (orig r2953):  castaway | 2006-11-28 12:44:42 +0000
Add blessed checking to deflate

r34625@cain (orig r2955):  ningu | 2006-12-02 06:06:15 +0000
inline relationship and inflate code for new, update, get_column, set_column, etc.
r34626@cain (orig r2956):  ningu | 2006-12-02 06:16:31 +0000
tiny cosmetic fixes
r35150@cain (orig r2959):  blblack | 2006-12-07 02:38:17 +0000
 r12195@localhost (orig r2957):  ash | 2006-12-06 15:48:49 -0600
 More descriptive error messages courtesy of Marc Espie
 r12196@localhost (orig r2958):  ash | 2006-12-06 17:05:30 -0600
 Join condition patch from Bernhard Graf

r35222@cain (orig r2967):  blblack | 2006-12-11 14:24:48 +0000
 r12251@localhost (orig r2961):  ningu | 2006-12-09 14:39:02 -0600
 - die in Storage::DBI::Pg when it can't find the autoinc sequence
 r12253@localhost (orig r2963):  ningu | 2006-12-10 10:25:22 -0600
 add test for has_many prefetch with adjacent rows with no rel objects
 r12254@localhost (orig r2964):  ningu | 2006-12-10 10:26:59 -0600
 whoops
 r12255@localhost (orig r2965):  blblack | 2006-12-10 19:00:22 -0600
 allow pk mutation via column accessor + update
 r12316@localhost (orig r2966):  blblack | 2006-12-11 08:24:23 -0600
 better fix for pk mutation based on mst irc conversation

r35458@cain (orig r2974):  matthewt | 2006-12-28 00:34:58 +0000
 r35424@cain (orig r2969):  dwc | 2006-12-19 06:22:09 +0000
 fix find_related-based queries to correctly grep the unique key
 r35455@cain (orig r2971):  ash | 2006-12-21 21:04:33 +0000
 Made many_to_many throw an exception if its not provided with a $f_rel

r35466@cain (orig r2976):  matthewt | 2006-12-28 19:21:52 +0000
 r34017@cain (orig r2915):  ash | 2006-11-21 09:46:41 +0000
 Changed row and rs objects to not have direct handle to a source, instead a
 (schema,source_name) tuple of type ResultSourceHandle.

r35467@cain (orig r2977):  matthewt | 2006-12-28 19:21:57 +0000
 r34018@cain (orig r2916):  ash | 2006-11-21 20:58:19 +0000
 Missed a reference to {result_source}

r35468@cain (orig r2978):  matthewt | 2006-12-28 19:22:01 +0000
 r34036@cain (orig r2926):  ningu | 2006-11-22 22:23:59 +0000
 change monkier => moniker

r35469@cain (orig r2979):  matthewt | 2006-12-28 19:22:05 +0000
 r34037@cain (orig r2927):  ningu | 2006-11-22 22:34:23 +0000
 fix typo

r35470@cain (orig r2980):  matthewt | 2006-12-28 19:22:08 +0000
 r34038@cain (orig r2928):  ningu | 2006-11-22 22:44:22 +0000
 fix typo fix

r35471@cain (orig r2981):  matthewt | 2006-12-28 19:22:11 +0000

r35472@cain (orig r2982):  matthewt | 2006-12-28 19:23:55 +0000
 r34147@cain (orig r2945):  ash | 2006-11-26 16:18:42 +0000
 Made source_name read-only on source instances, r/w on classes

r35473@cain (orig r2983):  matthewt | 2006-12-28 19:24:00 +0000

r35474@cain (orig r2984):  matthewt | 2006-12-28 19:24:34 +0000
 r35456@cain (orig r2972):  ash | 2006-12-27 22:48:49 +0000
 Removed CDBI subclassing bugs. constrain_columns to work out now

r35475@cain (orig r2985):  matthewt | 2006-12-28 19:24:38 +0000
 r35457@cain (orig r2973):  ash | 2006-12-28 00:15:24 +0000
 Fixed problem with cdbi-t/13constrain.t

r35476@cain (orig r2986):  matthewt | 2006-12-28 19:24:41 +0000

lib/DBIx/Class/ResultSet.pm
lib/DBIx/Class/Row.pm
lib/DBIx/Class/Schema.pm
lib/DBIx/Class/Storage/DBI.pm
lib/DBIx/Class/Storage/DBI/Pg.pm
t/bindtype_columns.t [new file with mode: 0644]
t/lib/DBICTest/Schema/Artist.pm

index e715725..d51c4b9 100644 (file)
@@ -1111,9 +1111,9 @@ sub update {
     unless ref $values eq 'HASH';
 
   my $cond = $self->_cond_for_update_delete;
-
+   
   return $self->result_source->storage->update(
-    $self->result_source->from, $values, $cond
+    $self->result_source, $values, $cond
   );
 }
 
@@ -1163,7 +1163,7 @@ sub delete {
 
   my $cond = $self->_cond_for_update_delete;
 
-  $self->result_source->storage->delete($self->result_source->from, $cond);
+  $self->result_source->storage->delete($self->result_source, $cond);
   return 1;
 }
 
index 8360f37..d66beb1 100644 (file)
@@ -95,8 +95,8 @@ sub insert {
     if $self->can('result_source_instance');
   $self->throw_exception("No result_source set on this object; can't insert")
     unless $source;
-  #use Data::Dumper; warn Dumper($self);
-  $source->storage->insert($source->from, { $self->get_columns });
+
+  $source->storage->insert($source, { $self->get_columns });
   $self->in_storage(1);
   $self->{_dirty_columns} = {};
   $self->{related_resultsets} = {};
@@ -135,6 +135,7 @@ sub update {
   my $ident_cond = $self->ident_condition;
   $self->throw_exception("Cannot safely update a row in a PK-less table")
     if ! keys %$ident_cond;
+
   if ($upd) {
     foreach my $key (keys %$upd) {
       if (ref $upd->{$key}) {
@@ -158,7 +159,9 @@ sub update {
   my %to_update = $self->get_dirty_columns;
   return $self unless keys %to_update;
   my $rows = $self->result_source->storage->update(
-               $self->result_source->from, \%to_update, $self->{_orig_ident} || $ident_cond);
+               $self->result_source, \%to_update,
+               $self->{_orig_ident} || $ident_cond
+             );
   if ($rows == 0) {
     $self->throw_exception( "Can't update ${self}: row not found" );
   } elsif ($rows > 1) {
@@ -197,7 +200,7 @@ sub delete {
               unless exists $self->{_column_data}{$column};
     }
     $self->result_source->storage->delete(
-      $self->result_source->from, $ident_cond);
+      $self->result_source, $ident_cond);
     $self->in_storage(undef);
   } else {
     $self->throw_exception("Can't do class delete without a ResultSource instance")
index 3981b51..4478d6f 100644 (file)
@@ -852,7 +852,7 @@ sub populate {
     }
     return @created;
   }
-  $self->storage->insert_bulk($self->source($name)->from, \@names, $data);
+  $self->storage->insert_bulk($self->source($name), \@names, $data);
 }
 
 =head2 exception_action
index 37257c4..41b30a0 100644 (file)
@@ -669,7 +669,7 @@ sub dbh {
 sub _sql_maker_args {
     my ($self) = @_;
     
-    return ( limit_dialect => $self->dbh, %{$self->_sql_maker_opts} );
+    return ( bindtype=>'columns', limit_dialect => $self->dbh, %{$self->_sql_maker_opts} );
 }
 
 sub sql_maker {
@@ -824,22 +824,48 @@ sub _prep_for_execute {
 }
 
 sub _execute {
-  my $self = shift;
-
-  my ($sql, @bind) = $self->_prep_for_execute(@_);
-
+  my ($self, $op, $extra_bind, $ident, $bind_attributes, @args) = @_;
+  
+  my ($sql, @bind) = $self->sql_maker->$op($ident, @args);
+  unshift(@bind, @$extra_bind) if $extra_bind;
   if ($self->debug) {
-      my @debug_bind = map { defined $_ ? qq{'$_'} : q{'NULL'} } @bind;
+      my @debug_bind = map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @bind;
       $self->debugobj->query_start($sql, @debug_bind);
   }
+  my $sth = eval { $self->sth($sql,$op) };
 
-  my $sth = $self->sth($sql);
+  if (!$sth || $@) {
+    $self->throw_exception(
+      'no sth generated via sql (' . ($@ || $self->_dbh->errstr) . "): $sql"
+    );
+  }
 
   my $rv;
   if ($sth) {
     my $time = time();
-    $rv = eval { $sth->execute(@bind) };
+       
+    $rv = eval {
+       
+      my $placeholder_index = 1; 
+
+      foreach my $bound (@bind) {
 
+        my $attributes = {};
+        my($column_name, $data) = @$bound;
+
+        if( $bind_attributes ) {
+          $attributes = $bind_attributes->{$column_name}
+          if defined $bind_attributes->{$column_name};
+        }                      
+
+        $data = ref $data ? ''.$data : $data; # stringify args
+
+        $sth->bind_param($placeholder_index, $data, $attributes);
+        $placeholder_index++;
+      }
+      $sth->execute;
+    };
+  
     if ($@ || !$rv) {
       $self->throw_exception("Error executing '$sql': ".($@ || $sth->errstr));
     }
@@ -847,19 +873,30 @@ sub _execute {
     $self->throw_exception("'$sql' did not generate a statement.");
   }
   if ($self->debug) {
-      my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind;
-      $self->debugobj->query_end($sql, @debug_bind);
+     my @debug_bind =
+       map { defined ($_ && $_->[1]) ? qq{'$_->[1]'} : q{'NULL'} } @bind; 
+     $self->debugobj->query_end($sql, @debug_bind);
   }
   return (wantarray ? ($rv, $sth, @bind) : $rv);
 }
 
 sub insert {
-  my ($self, $ident, $to_insert) = @_;
+  my ($self, $source, $to_insert) = @_;
+  
+  my $ident = $source->from; 
+  my $bind_attributes;
+  foreach my $column ($source->columns) {
+  
+    my $data_type = $source->column_info($column)->{data_type} || '';
+    $bind_attributes->{$column} = $self->bind_attribute_by_data_type($data_type)
+        if $data_type;
+  } 
+  
   $self->throw_exception(
     "Couldn't insert ".join(', ',
       map "$_ => $to_insert->{$_}", keys %$to_insert
     )." into ${ident}"
-  ) unless ($self->_execute('insert' => [], $ident, $to_insert));
+  ) unless ($self->_execute('insert' => [], $ident, $bind_attributes, $to_insert));
   return $to_insert;
 }
 
@@ -868,14 +905,14 @@ sub insert {
 ## scalar refs, or at least, all the same type as the first set, the statement is
 ## only prepped once.
 sub insert_bulk {
-  my ($self, $table, $cols, $data) = @_;
+  my ($self, $source, $cols, $data) = @_;
   my %colvalues;
+  my $table = $source->from;
   @colvalues{@$cols} = (0..$#$cols);
   my ($sql, @bind) = $self->sql_maker->insert($table, \%colvalues);
-# print STDERR "BIND".Dumper(\@bind);
-
+  
   if ($self->debug) {
-      my @debug_bind = map { defined $_ ? qq{'$_'} : q{'NULL'} } @bind;
+      my @debug_bind = map { defined $_->[1] ? qq{$_->[1]} : q{'NULL'} } @bind;
       $self->debugobj->query_start($sql, @debug_bind);
   }
   my $sth = $self->sth($sql);
@@ -883,16 +920,72 @@ sub insert_bulk {
 #  @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args
 
   my $rv;
+  
   ## This must be an arrayref, else nothing works!
+  
   my $tuple_status = [];
-#  use Data::Dumper;
-#  print STDERR Dumper($data);
+  
+  ##use Data::Dumper;
+  ##print STDERR Dumper( $data, $sql, [@bind] );
+       
   if ($sth) {
+  
     my $time = time();
-    $rv = eval { $sth->execute_array({ ArrayTupleFetch => sub { my $values = shift @$data;  return if !$values; return [ @{$values}[@bind] ]},
-                                       ArrayTupleStatus => $tuple_status }) };
-# print STDERR Dumper($tuple_status);
-# print STDERR "RV: $rv\n";
+       
+    #$rv = eval {
+       #
+       #  $sth->execute_array({
+
+       #    ArrayTupleFetch => sub {
+
+       #      my $values = shift @$data;  
+    #      return if !$values; 
+    #      return [ @{$values}[@bind] ];
+       #    },
+         
+       #    ArrayTupleStatus => $tuple_status,
+       #  })
+    #};
+       
+       ## Get the bind_attributes, if any exist
+       
+    my $bind_attributes;
+    foreach my $column ($source->columns) {
+  
+      my $data_type = $source->column_info($column)->{data_type} || '';
+         
+      $bind_attributes->{$column} = $self->bind_attribute_by_data_type($data_type)
+          if $data_type;
+    } 
+       
+       ## Bind the values and execute
+       
+       $rv = eval {
+       
+     my $placeholder_index = 1; 
+
+        foreach my $bound (@bind) {
+
+          my $attributes = {};
+          my ($column_name, $data_index) = @$bound;
+
+          if( $bind_attributes ) {
+            $attributes = $bind_attributes->{$column_name}
+            if defined $bind_attributes->{$column_name};
+          }
+                 
+                 my @data = map { $_->[$data_index] } @$data;
+
+          $sth->bind_param_array( $placeholder_index, [@data], $attributes );
+          $placeholder_index++;
+      }
+         $sth->execute_array( {ArrayTupleStatus => $tuple_status} );
+
+       };
+   
+#print STDERR Dumper($tuple_status);
+#print STDERR "RV: $rv\n";
+
     if ($@ || !defined $rv) {
       my $errors = '';
       foreach my $tuple (@$tuple_status)
@@ -912,11 +1005,30 @@ sub insert_bulk {
 }
 
 sub update {
-  return shift->_execute('update' => [], @_);
+  my $self = shift @_;
+  my $source = shift @_;
+  
+  my $bind_attributes;
+  foreach my $column ($source->columns) {
+  
+    my $data_type = $source->column_info($column)->{data_type} || '';
+    $bind_attributes->{$column} = $self->bind_attribute_by_data_type($data_type)
+        if $data_type;
+  }
+
+  my $ident = $source->from;
+  return $self->_execute('update' => [], $ident, $bind_attributes, @_);
 }
 
+
 sub delete {
-  return shift->_execute('delete' => [], @_);
+  my $self = shift @_;
+  my $source = shift @_;
+  
+  my $bind_attrs = {}; ## If ever it's needed...
+  my $ident = $source->from;
+  
+  return $self->_execute('delete' => [], $ident, $bind_attrs, @_);
 }
 
 sub _select {
@@ -932,7 +1044,8 @@ sub _select {
       ($order ? (order_by => $order) : ())
     };
   }
-  my @args = ('select', $attrs->{bind}, $ident, $select, $condition, $order);
+  my $bind_attrs = {}; ## Future support
+  my @args = ('select', $attrs->{bind}, $ident, $bind_attrs, $select, $condition, $order);
   if ($attrs->{software_limit} ||
       $self->sql_maker->_default_limit_syntax eq "GenericSubQ") {
         $attrs->{software_limit} = 1;
@@ -1084,6 +1197,20 @@ Returns the database driver name.
 
 sub sqlt_type { shift->dbh->{Driver}->{Name} }
 
+=head2 bind_attribute_by_data_type
+
+Given a datatype from column info, returns a database specific bind attribute for
+$dbh->bind_param($val,$attribute) or nothing if we will let the database planner
+just handle it.
+
+Generally only needed for special case column types, like bytea in postgres.
+
+=cut
+
+sub bind_attribute_by_data_type {
+    return;
+}
+
 =head2 create_ddl_dir (EXPERIMENTAL)
 
 =over 4
index bec2a8f..8f0f30d 100644 (file)
@@ -3,7 +3,7 @@ package DBIx::Class::Storage::DBI::Pg;
 use strict;
 use warnings;
 
-use DBD::Pg;
+use DBD::Pg qw(:pg_types);
 
 use base qw/DBIx::Class::Storage::DBI/;
 
@@ -58,6 +58,21 @@ sub sqlt_type {
 
 sub datetime_parser_type { return "DateTime::Format::Pg"; }
 
+sub bind_attribute_by_data_type {
+  my ($self,$data_type) = @_;
+
+  my $bind_attributes = {
+       bytea => { pg_type => DBD::Pg::PG_BYTEA },
+  };
+  if( defined $bind_attributes->{$data_type} ) {
+    return $bind_attributes->{$data_type};
+  }
+  else {
+    return;
+  }
+}
+
 1;
 
 =head1 NAME
diff --git a/t/bindtype_columns.t b/t/bindtype_columns.t
new file mode 100644 (file)
index 0000000..2d9bffe
--- /dev/null
@@ -0,0 +1,64 @@
+use strict;
+use warnings;  
+
+use Test::More;
+use lib qw(t/lib);
+use DBICTest;
+
+my ($dsn, $dbuser, $dbpass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/};
+
+$dsn   = 'dbi:Pg:dbname=postgres;host=localhost' unless $dsn;
+$dbuser        = 'postgres' unless $dbuser;
+$dbpass        = 'postgres' unless $dbpass;
+
+plan skip_all => 'Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test'
+  unless ($dsn && $dbuser);
+  
+plan tests => 3;
+
+DBICTest::Schema->compose_connection('PGTest' => $dsn, $dbuser, $dbpass);
+
+my $dbh = PGTest->schema->storage->dbh;
+
+$dbh->do(qq[
+
+       CREATE TABLE artist
+       (
+               artistid                serial  NOT NULL        PRIMARY KEY,
+               media                   bytea   NOT NULL,
+               name                    varchar NULL
+       );
+],{ RaiseError => 1, PrintError => 1 });
+
+
+PGTest::Artist->load_components(qw/ 
+
+       PK::Auto 
+       Core 
+/);
+
+PGTest::Artist->add_columns(
+       
+       "media", { 
+       
+               data_type => "bytea", 
+               is_nullable => 0, 
+       },
+);
+
+# test primary key handling
+my $big_long_string    = 'abcd' x 250000;
+
+my $new = PGTest::Artist->create({ media => $big_long_string });
+
+ok($new->artistid, "Created a blob row");
+is($new->media,        $big_long_string, "Set the blob correctly.");
+
+my $rs = PGTest::Artist->find({artistid=>$new->artistid});
+
+is($rs->get_column('media'), $big_long_string, "Created the blob correctly.");
+
+$dbh->do("DROP TABLE artist");
+
+
+
index cf6eb3a..90eb7bf 100644 (file)
@@ -12,7 +12,7 @@ __PACKAGE__->source_info({
 __PACKAGE__->add_columns(
   'artistid' => {
     data_type => 'integer',
-    is_auto_increment => 1
+    is_auto_increment => 1,
   },
   'name' => {
     data_type => 'varchar',