From: Peter Rabbitson <ribasushi@cpan.org>
Date: Sun, 31 Jan 2010 09:25:55 +0000 (+0000)
Subject: Helper primary_columns wrapper to throw if a PK is not defined
X-Git-Tag: v0.08120~27^2~6
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e8fb771b9060f47eac9eaeef1d722cfe0dcfbe76;p=dbsrgits%2FDBIx-Class.git

Helper primary_columns wrapper to throw if a PK is not defined
---

diff --git a/lib/DBIx/Class/Ordered.pm b/lib/DBIx/Class/Ordered.pm
index 5f17790..409159e 100644
--- a/lib/DBIx/Class/Ordered.pm
+++ b/lib/DBIx/Class/Ordered.pm
@@ -797,15 +797,15 @@ sub _shift_siblings {
 
     if (grep { $_ eq $position_column } ( map { @$_ } (values %{{ $rsrc->unique_constraints }} ) ) ) {
 
-        my @pcols = $rsrc->primary_columns;
+        my @pcols = $rsrc->_pri_cols;
         my $cursor = $shift_rs->search ({}, { order_by => { "-$ord", $position_column }, columns => \@pcols } )->cursor;
         my $rs = $self->result_source->resultset;
 
-        while (my @pks = $cursor->next ) {
-
+        my @all_pks = $cusrsor->all;
+        while (my $pks = shift @all_pks) {
           my $cond;
           for my $i (0.. $#pcols) {
-            $cond->{$pcols[$i]} = $pks[$i];
+            $cond->{$pcols[$i]} = $pks->[$i];
           }
 
           $rs->search($cond)->update ({ $position_column => \ "$position_column $op 1" } );
diff --git a/lib/DBIx/Class/PK.pm b/lib/DBIx/Class/PK.pm
index cf8a194..d9bd5ad 100644
--- a/lib/DBIx/Class/PK.pm
+++ b/lib/DBIx/Class/PK.pm
@@ -37,7 +37,7 @@ sub id {
 
 sub _ident_values {
   my ($self) = @_;
-  return (map { $self->{_column_data}{$_} } $self->primary_columns);
+  return (map { $self->{_column_data}{$_} } $self->_pri_cols);
 }
 
 =head2 ID
@@ -65,7 +65,7 @@ sub ID {
     unless ref $self;
   return undef unless $self->in_storage;
   return $self->_create_ID(map { $_ => $self->{_column_data}{$_} }
-                             $self->primary_columns);
+                             $self->_pri_cols);
 }
 
 sub _create_ID {
@@ -89,7 +89,7 @@ sub ident_condition {
   my ($self, $alias) = @_;
   my %cond;
   my $prefix = defined $alias ? $alias.'.' : '';
-  $cond{$prefix.$_} = $self->get_column($_) for $self->primary_columns;
+  $cond{$prefix.$_} = $self->get_column($_) for $self->_pri_cols;
   return \%cond;
 }
 
diff --git a/lib/DBIx/Class/Relationship/BelongsTo.pm b/lib/DBIx/Class/Relationship/BelongsTo.pm
index af68b7b..471a417 100644
--- a/lib/DBIx/Class/Relationship/BelongsTo.pm
+++ b/lib/DBIx/Class/Relationship/BelongsTo.pm
@@ -24,19 +24,14 @@ sub belongs_to {
   # no join condition or just a column name
   if (!ref $cond) {
     $class->ensure_class_loaded($f_class);
-    my %f_primaries = map { $_ => 1 } eval { $f_class->primary_columns };
+    my %f_primaries = map { $_ => 1 } eval { $f_class->_pri_cols };
     $class->throw_exception(
-      "Can't infer join condition for ${rel} on ${class}; ".
-      "unable to load ${f_class}: $@"
+      "Can't infer join condition for ${rel} on ${class}: $@"
     ) if $@;
 
     my ($pri, $too_many) = keys %f_primaries;
     $class->throw_exception(
       "Can't infer join condition for ${rel} on ${class}; ".
-      "${f_class} has no primary keys"
-    ) unless defined $pri;
-    $class->throw_exception(
-      "Can't infer join condition for ${rel} on ${class}; ".
       "${f_class} has multiple primary keys"
     ) if $too_many;
 
diff --git a/lib/DBIx/Class/Relationship/HasMany.pm b/lib/DBIx/Class/Relationship/HasMany.pm
index d74a9a4..7690af8 100644
--- a/lib/DBIx/Class/Relationship/HasMany.pm
+++ b/lib/DBIx/Class/Relationship/HasMany.pm
@@ -14,7 +14,10 @@ sub has_many {
 
   unless (ref $cond) {
     $class->ensure_class_loaded($f_class);
-    my ($pri, $too_many) = $class->primary_columns;
+    my ($pri, $too_many) = eval { $class->_pri_cols };
+    $class->throw_exception(
+      "Can't infer join condition for ${rel} on ${class}: $@"
+    ) if $@;
 
     $class->throw_exception(
       "has_many can only infer join for a single primary key; ".
diff --git a/lib/DBIx/Class/Relationship/HasOne.pm b/lib/DBIx/Class/Relationship/HasOne.pm
index 1578c63..4dd97bd 100644
--- a/lib/DBIx/Class/Relationship/HasOne.pm
+++ b/lib/DBIx/Class/Relationship/HasOne.pm
@@ -24,7 +24,7 @@ sub _has_one {
     $class->ensure_class_loaded($f_class);
 
     my $pri = $class->_get_primary_key;
-  
+
     $class->throw_exception(
       "might_have/has_one needs a primary key  to infer a join; ".
       "${class} has none"
@@ -60,7 +60,11 @@ sub _has_one {
 sub _get_primary_key {
   my ( $class, $target_class ) = @_;
   $target_class ||= $class;
-  my ($pri, $too_many) = $target_class->primary_columns;
+  my ($pri, $too_many) = eval { $target_class->_pri_cols };
+  $class->throw_exception(
+    "Can't infer join condition for ${rel} on ${target_class}: $@"
+  ) if $@;
+
   $class->throw_exception(
     "might_have/has_one can only infer join for a single primary key; ".
     "${class} has more"
diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index 68b7d9b..1bf30a3 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -1256,7 +1256,7 @@ sub _count_subq_rs {
   # if we multi-prefetch we group_by primary keys only as this is what we would
   # get out of the rs via ->next/->all. We *DO WANT* to clobber old group_by regardless
   if ( keys %{$attrs->{collapse}}  ) {
-    $sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } ($rsrc->primary_columns) ]
+    $sub_attrs->{group_by} = [ map { "$attrs->{alias}.$_" } ($rsrc->_pri_cols) ]
   }
 
   $sub_attrs->{select} = $rsrc->storage->_subq_count_select ($rsrc, $sub_attrs);
@@ -1415,7 +1415,7 @@ sub _rs_update_delete {
     my $attrs = $self->_resolved_attrs_copy;
 
     delete $attrs->{$_} for qw/collapse select as/;
-    $attrs->{columns} = [ map { "$attrs->{alias}.$_" } ($self->result_source->primary_columns) ];
+    $attrs->{columns} = [ map { "$attrs->{alias}.$_" } ($self->result_source->_pri_cols) ];
 
     if ($needs_group_by_subq) {
       # make sure no group_by was supplied, or if there is one - make sure it matches
diff --git a/lib/DBIx/Class/ResultSource.pm b/lib/DBIx/Class/ResultSource.pm
index 824c34d..26b01cd 100644
--- a/lib/DBIx/Class/ResultSource.pm
+++ b/lib/DBIx/Class/ResultSource.pm
@@ -503,6 +503,16 @@ sub primary_columns {
   return @{shift->_primaries||[]};
 }
 
+sub _pri_cols {
+  my $self = shift;
+  my @pcols = $self->primary_columns
+    or $self->throw_exception (sprintf(
+      'Operation requires a primary key to be declared on %s via set_primary_key',
+      ref $self,
+    ));
+  return @pcols;
+}
+
 =head2 add_unique_constraint
 
 =over 4
diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index e07f116..f23795f 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -1606,15 +1606,7 @@ sub _subq_update_delete {
   my $rsrc = $rs->result_source;
 
   # quick check if we got a sane rs on our hands
-  my @pcols = $rsrc->primary_columns;
-  unless (@pcols) {
-    $self->throw_exception (
-      sprintf (
-        "You must declare primary key(s) on source '%s' (via set_primary_key) in order to update or delete complex resultsets",
-        $rsrc->source_name || $rsrc->from
-      )
-    );
-  }
+  my @pcols = $rsrc->_pri_cols;
 
   my $sel = $rs->_resolved_attrs->{select};
   $sel = [ $sel ] unless ref $sel eq 'ARRAY';
@@ -1667,7 +1659,7 @@ sub _per_row_update_delete {
   my ($rs, $op, $values) = @_;
 
   my $rsrc = $rs->result_source;
-  my @pcols = $rsrc->primary_columns;
+  my @pcols = $rsrc->_pri_cols;
 
   my $guard = $self->txn_scope_guard;
 
diff --git a/lib/DBIx/Class/Storage/DBI/MultiColumnIn.pm b/lib/DBIx/Class/Storage/DBI/MultiColumnIn.pm
index 2a757ea..c675c1e 100644
--- a/lib/DBIx/Class/Storage/DBI/MultiColumnIn.pm
+++ b/lib/DBIx/Class/Storage/DBI/MultiColumnIn.pm
@@ -26,7 +26,7 @@ sub _multipk_update_delete {
   my ($rs, $op, $values) = @_;
 
   my $rsrc = $rs->result_source;
-  my @pcols = $rsrc->primary_columns;
+  my @pcols = $rsrc->_pri_cols;
   my $attrs = $rs->_resolved_attrs;
 
   # naive check - this is an internal method after all, we should know what we are doing 
diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm b/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
index 45d95da..91bf586 100644
--- a/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
@@ -719,10 +719,9 @@ sub _remove_blob_cols_array {
 sub _update_blobs {
   my ($self, $source, $blob_cols, $where) = @_;
 
-  my (@primary_cols) = $source->primary_columns;
-
-  $self->throw_exception('Cannot update TEXT/IMAGE column(s) without a primary key')
-    unless @primary_cols;
+  my @primary_cols = eval { $source->_pri_cols };
+  $self->throw_exception("Cannot update TEXT/IMAGE column(s): $@")
+    if $@;
 
 # check if we're updating a single row by PK
   my $pk_cols_in_where = 0;
@@ -754,10 +753,9 @@ sub _insert_blobs {
   my $table = $source->name;
 
   my %row = %$row;
-  my (@primary_cols) = $source->primary_columns;
-
-  $self->throw_exception('Cannot update TEXT/IMAGE column(s) without a primary key')
-    unless @primary_cols;
+  my @primary_cols = eval { $source->_pri_cols} ;
+  $self->throw_exception("Cannot update TEXT/IMAGE column(s): $@")
+    if $@;
 
   $self->throw_exception('Cannot update TEXT/IMAGE column(s) without primary key values')
     if ((grep { defined $row{$_} } @primary_cols) != @primary_cols);