Fixed: RS example code was broken

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSet.pm

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index 5c862e3..8f894a0 100644 (file)
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -5,13 +5,9 @@ use warnings;
 use base qw/DBIx::Class/;
 use Carp::Clan qw/^DBIx::Class/;
 use DBIx::Class::Exception;
-use Data::Page;
 use DBIx::Class::ResultSetColumn;
-use DBIx::Class::ResultSourceHandle;
-use Hash::Merge ();
 use Scalar::Util qw/blessed weaken/;
 use Try::Tiny;
-use Storable qw/nfreeze thaw/;
 
 # not importing first() as it will clash with our own method
 use List::Util ();
@@ -98,7 +94,7 @@ another.
       year => $request->param('year'),
     });
 
-    $self->apply_security_policy( $cd_rs );
+    $cd_rs = $self->apply_security_policy( $cd_rs );
 
     return $cd_rs->all();
   }
@@ -739,7 +735,7 @@ sub find {
       }++;
 
       push @unique_queries, try {
-        $self->_build_unique_cond ($c_name, $call_cond)
+        $self->_build_unique_cond ($c_name, $call_cond, 'croak_on_nulls')
       } || ();
     }
 
@@ -797,8 +793,9 @@ sub _qualify_cond_columns {
   return \%aliased;
 }
 
+my $callsites_warned_ucond;
 sub _build_unique_cond {
-  my ($self, $constraint_name, $extra_cond) = @_;
+  my ($self, $constraint_name, $extra_cond, $croak_on_null) = @_;
 
   my @c_cols = $self->result_source->unique_constraint_columns($constraint_name);
 
@@ -810,15 +807,45 @@ sub _build_unique_cond {
   };
 
   # trim out everything not in $columns
-  $final_cond = { map { $_ => $final_cond->{$_} } @c_cols };
-
-  if (my @missing = grep { ! defined $final_cond->{$_} } (@c_cols) ) {
+  $final_cond = { map {
+    exists $final_cond->{$_}
+      ? ( $_ => $final_cond->{$_} )
+      : ()
+  } @c_cols };
+
+  if (my @missing = grep
+    { ! ($croak_on_null ? defined $final_cond->{$_} : exists $final_cond->{$_}) }
+    (@c_cols)
+  ) {
     $self->throw_exception( sprintf ( "Unable to satisfy requested constraint '%s', no values for column(s): %s",
       $constraint_name,
       join (', ', map { "'$_'" } @missing),
     ) );
   }
 
+  if (
+    !$croak_on_null
+      and
+    !$ENV{DBIC_NULLABLE_KEY_NOWARN}
+      and
+    my @undefs = grep { ! defined $final_cond->{$_} } (keys %$final_cond)
+  ) {
+    my $callsite = do {
+      my $w;
+      local $SIG{__WARN__} = sub { $w = shift };
+      carp;
+      $w
+    };
+
+    carp ( sprintf (
+      "NULL/undef values supplied for requested unique constraint '%s' (NULL "
+    . 'values in column(s): %s). This is almost certainly not what you wanted, '
+    . 'though you can set DBIC_NULLABLE_KEY_NOWARN to disable this warning.',
+      $constraint_name,
+      join (', ', map { "'$_'" } @undefs),
+    )) unless $callsites_warned_ucond->{$callsite}++;
+  }
+
   return $final_cond;
 }
 
@@ -2163,6 +2190,7 @@ sub pager {
 ### necessary for future development of DBIx::DS. Do *NOT* change this code
 ### before talking to ribasushi/mst
 
+  require Data::Page;
   my $pager = Data::Page->new(
     0,  #start with an empty set
     $attrs->{rows},
@@ -3527,6 +3555,7 @@ sub _merge_joinpref_attr {
 
   sub _merge_attr {
     $hm ||= do {
+      require Hash::Merge;
       my $hm = Hash::Merge->new;
 
       $hm->specify_behavior({
@@ -3616,14 +3645,14 @@ sub STORABLE_freeze {
   # A cursor in progress can't be serialized (and would make little sense anyway)
   delete $to_serialize->{cursor};
 
-  nfreeze($to_serialize);
+  Storable::nfreeze($to_serialize);
 }
 
 # need this hook for symmetry
 sub STORABLE_thaw {
   my ($self, $cloning, $serialized) = @_;
 
-  %$self = %{ thaw($serialized) };
+  %$self = %{ Storable::thaw($serialized) };
 
   $self;
 }
@@ -3735,6 +3764,10 @@ passed to object inflation. Note that the 'artist' is the name of the
 column (or relationship) accessor, and 'name' is the name of the column
 accessor in the related table.
 
+B<NOTE:> You need to explicitly quote '+columns' when defining the attribute.
+Not doing so causes Perl to incorrectly interpret +columns as a bareword with a
+unary plus operator before it.
+
 =head2 include_columns
 
 =over 4
@@ -3775,6 +3808,10 @@ identifier aliasing. You can however alias a function, so you can use it in
 e.g. an C<ORDER BY> clause. This is done via the C<-as> B<select function
 attribute> supplied as shown in the example above.
 
+B<NOTE:> You need to explicitly quote '+select'/'+as' when defining the attributes.
+Not doing so causes Perl to incorrectly interpret them as a bareword with a
+unary plus operator before it.
+
 =head2 +select
 
 =over 4
@@ -4007,7 +4044,7 @@ Makes the resultset paged and specifies the page to retrieve. Effectively
 identical to creating a non-pages resultset and then calling ->page($page)
 on it.
 
-If L<rows> attribute is not specified it defaults to 10 rows per page.
+If L</rows> attribute is not specified it defaults to 10 rows per page.
 
 When you have a paged resultset, L</count> will only return the number
 of rows in the page. To get the total, use the L</pager> and call