Merge branch 0.08200_track into master

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

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index fab2a27..1e976db 100644 (file)
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -3,7 +3,7 @@ package DBIx::Class::ResultSet;
 use strict;
 use warnings;
 use base qw/DBIx::Class/;
-use Carp::Clan qw/^DBIx::Class/;
+use DBIx::Class::Carp;
 use DBIx::Class::Exception;
 use DBIx::Class::ResultSetColumn;
 use Scalar::Util qw/blessed weaken/;
@@ -12,15 +12,14 @@ use Try::Tiny;
 # not importing first() as it will clash with our own method
 use List::Util ();
 
-use namespace::clean;
-
-
 BEGIN {
   # De-duplication in _merge_attr() is disabled, but left in for reference
   # (the merger is used for other things that ought not to be de-duped)
   *__HM_DEDUP = sub () { 0 };
 }
 
+use namespace::clean;
+
 use overload
         '0+'     => "count",
         'bool'   => "_bool",
@@ -94,7 +93,7 @@ another.
       year => $request->param('year'),
     });
 
-    $self->apply_security_policy( $cd_rs );
+    $cd_rs = $self->apply_security_policy( $cd_rs );
 
     return $cd_rs->all();
   }
@@ -297,7 +296,6 @@ always return a resultset, even in list context.
 
 =cut
 
-my $callsites_warned;
 sub search_rs {
   my $self = shift;
 
@@ -406,15 +404,7 @@ sub search_rs {
   } if @_;
 
   if( @_ > 1 and ! $rsrc->result_class->isa('DBIx::Class::CDBICompat') ) {
-    # determine callsite obeying Carp::Clan rules (fucking ugly but don't have better ideas)
-    my $callsite = do {
-      my $w;
-      local $SIG{__WARN__} = sub { $w = shift };
-      carp;
-      $w
-    };
-    carp 'search( %condition ) is deprecated, use search( \%condition ) instead'
-      unless $callsites_warned->{$callsite}++;
+    carp_unique 'search( %condition ) is deprecated, use search( \%condition ) instead';
   }
 
   for ($old_where, $call_cond) {
@@ -693,7 +683,7 @@ sub find {
       next if $keyref eq 'ARRAY'; # has_many for multi_create
 
       my $rel_q = $rsrc->_resolve_condition(
-        $relinfo->{cond}, $val, $key
+        $relinfo->{cond}, $val, $key, $key
       );
       die "Can't handle complex relationship conditions in find" if ref($rel_q) ne 'HASH';
       @related{keys %$rel_q} = values %$rel_q;
@@ -793,7 +783,6 @@ sub _qualify_cond_columns {
   return \%aliased;
 }
 
-my $callsites_warned_ucond;
 sub _build_unique_cond {
   my ($self, $constraint_name, $extra_cond, $croak_on_null) = @_;
 
@@ -830,20 +819,13 @@ sub _build_unique_cond {
       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 (
+    carp_unique ( 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;
@@ -1072,7 +1054,7 @@ instead. An example conversion is:
 
 sub search_like {
   my $class = shift;
-  carp (
+  carp_unique (
     'search_like() is deprecated and will be removed in DBIC version 0.09.'
    .' Instead use ->search({ x => { -like => "y%" } })'
    .' (note the outer pair of {}s - they are important!)'
@@ -1970,6 +1952,7 @@ sub populate {
           $reverse_relinfo->{cond},
           $self,
           $result,
+          $rel,
         );
 
         delete $data->[$index]->{$rel};
@@ -2008,6 +1991,7 @@ sub populate {
           $rels->{$rel}{cond},
           $child,
           $main_row,
+          $rel,
         );
 
         my @rows_to_add = ref $item->{$rel} eq 'ARRAY' ? @{$item->{$rel}} : ($item->{$rel});
@@ -2340,7 +2324,13 @@ sub _merge_with_rscond {
 
     while ( my($col, $value) = each %implied ) {
       my $vref = ref $value;
-      if ($vref eq 'HASH' && keys(%$value) && (keys %$value)[0] eq '=') {
+      if (
+        $vref eq 'HASH'
+          and
+        keys(%$value) == 1
+          and
+        (keys %$value)[0] eq '='
+      ) {
         $new_data{$col} = $value->{'='};
       }
       elsif( !$vref or $vref eq 'SCALAR' or blessed($value) ) {
@@ -3363,7 +3353,7 @@ sub _resolved_attrs {
   # subquery (since a group_by is present)
   if (delete $attrs->{distinct}) {
     if ($attrs->{group_by}) {
-      carp ("Useless use of distinct on a grouped resultset ('distinct' is ignored when a 'group_by' is present)");
+      carp_unique ("Useless use of distinct on a grouped resultset ('distinct' is ignored when a 'group_by' is present)");
     }
     else {
       # distinct affects only the main selection part, not what prefetch may
@@ -3764,6 +3754,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
@@ -3804,6 +3798,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