X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FResultSet.pm;h=5c87ffa38900305e77f77fa3e8e68e57e77a2420;hb=307f12659a1a370e5e41a23ef35839e2807f1ca4;hp=124600b8b7549ede36bd97a8b151dc3d30d67d83;hpb=d5a14c53a280677a116b2efb393853a783281b2a;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index 124600b..5c87ffa 100644
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -3,28 +3,23 @@ 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 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 ();
 
-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",
@@ -98,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();
   }
@@ -301,7 +296,6 @@ always return a resultset, even in list context.
 
 =cut
 
-my $callsites_warned;
 sub search_rs {
   my $self = shift;
 
@@ -410,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) {
@@ -697,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;
@@ -797,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) = @_;
 
@@ -834,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;
@@ -1076,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!)'
@@ -1859,7 +1837,7 @@ sub delete_all {
 
 Accepts either an arrayref of hashrefs or alternatively an arrayref of arrayrefs.
 For the arrayref of hashrefs style each hashref should be a structure suitable
-forsubmitting to a $resultset->create(...) method.
+for submitting to a $resultset->create(...) method.
 
 In void context, C<insert_bulk> in L<DBIx::Class::Storage::DBI> is used
 to insert the data, as this is a faster method.
@@ -1974,6 +1952,7 @@ sub populate {
           $reverse_relinfo->{cond},
           $self,
           $result,
+          $rel,
         );
 
         delete $data->[$index]->{$rel};
@@ -2012,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});
@@ -2194,6 +2174,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},
@@ -2343,16 +2324,14 @@ sub _merge_with_rscond {
 
     while ( my($col, $value) = each %implied ) {
       my $vref = ref $value;
-      if ($vref eq 'HASH') {
-        if (keys(%$value) && (keys %$value)[0] eq '=') {
-          $new_data{$col} = $value->{'='};
-        }
-        # in a complex condition, set_from_related needs to override
-        # the columns that are involved.
-        elsif (!exists $data->{$col} &&
-               !exists $data->{"$alias.$col"}) {
-          $self->throw_exception("unable to set_from_related via complex condition on column(s): '$col'");
-        }
+      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) ) {
         $new_data{$col} = $value;
@@ -3374,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
@@ -3566,6 +3545,7 @@ sub _merge_joinpref_attr {
 
   sub _merge_attr {
     $hm ||= do {
+      require Hash::Merge;
       my $hm = Hash::Merge->new;
 
       $hm->specify_behavior({
@@ -3655,14 +3635,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;
 }
@@ -3774,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
@@ -3814,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
@@ -3978,28 +3966,122 @@ case.
 Simple prefetches will be joined automatically, so there is no need
 for a C<join> attribute in the above search.
 
-C<prefetch> can be used with the following relationship types: C<belongs_to>,
-C<has_one> (or if you're using C<add_relationship>, any relationship declared
-with an accessor type of 'single' or 'filter'). A more complex example that
-prefetches an artists cds, the tracks on those cds, and the tags associated
-with that artist is given below (assuming many-to-many from artists to tags):
+L</prefetch> can be used with the any of the relationship types and
+multiple prefetches can be specified together. Below is a more complex
+example that prefetches a CD's artist, its liner notes (if present),
+the cover image, the tracks on that cd, and the guests on those
+tracks.
+
+ # Assuming:
+ My::Schema::CD->belongs_to( artist      => 'My::Schema::Artist'     );
+ My::Schema::CD->might_have( liner_note  => 'My::Schema::LinerNotes' );
+ My::Schema::CD->has_one(    cover_image => 'My::Schema::Artwork'    );
+ My::Schema::CD->has_many(   tracks      => 'My::Schema::Track'      );
+
+ My::Schema::Artist->belongs_to( record_label => 'My::Schema::RecordLabel' );
+
+ My::Schema::Track->has_many( guests => 'My::Schema::Guest' );
+
+
+ my $rs = $schema->resultset('CD')->search(
+   undef,
+   {
+     prefetch => [
+       { artist => 'record_label'},  # belongs_to => belongs_to
+       'liner_note',                 # might_have
+       'cover_image',                # has_one
+       { tracks => 'guests' },       # has_many => has_many
+     ]
+   }
+ );
 
- my $rs = $schema->resultset('Artist')->search(
+This will produce SQL like the following:
+
+ SELECT cd.*, artist.*, record_label.*, liner_note.*, cover_image.*,
+        tracks.*, guests.*
+   FROM cd me
+   JOIN artist artist
+     ON artist.artistid = me.artistid
+   JOIN record_label record_label
+     ON record_label.labelid = artist.labelid
+   LEFT JOIN track tracks
+     ON tracks.cdid = me.cdid
+   LEFT JOIN guest guests
+     ON guests.trackid = track.trackid
+   LEFT JOIN liner_notes liner_note
+     ON liner_note.cdid = me.cdid
+   JOIN cd_artwork cover_image
+     ON cover_image.cdid = me.cdid
+ ORDER BY tracks.cd
+
+Now the C<artist>, C<record_label>, C<liner_note>, C<cover_image>,
+C<tracks>, and C<guests> of the CD will all be available through the
+relationship accessors without the need for additional queries to the
+database.
+
+However, there is one caveat to be observed: it can be dangerous to
+prefetch more than one L<has_many|DBIx::Class::Relationship/has_many>
+relationship on a given level. e.g.:
+
+ my $rs = $schema->resultset('CD')->search(
    undef,
    {
      prefetch => [
-       { cds => 'tracks' },
-       { artist_tags => 'tags' }
+       'tracks',                         # has_many
+       { cd_to_producer => 'producer' }, # has_many => belongs_to (i.e. m2m)
      ]
    }
  );
 
+In fact, C<DBIx::Class> will emit the following warning:
+
+ Prefetching multiple has_many rels tracks and cd_to_producer at top
+ level will explode the number of row objects retrievable via ->next
+ or ->all. Use at your own risk.
+
+The collapser currently can't identify duplicate tuples for multiple
+L<has_many|DBIx::Class::Relationship/has_many> relationships and as a
+result the second L<has_many|DBIx::Class::Relationship/has_many>
+relation could contain redundant objects.
+
+=head3 Using L</prefetch> with L</join>
+
+L</prefetch> implies a L</join> with the equivalent argument, and is
+properly merged with any existing L</join> specification. So the
+following:
+
+  my $rs = $schema->resultset('CD')->search(
+   {'record_label.name' => 'Music Product Ltd.'},
+   {
+     join     => {artist => 'record_label'},
+     prefetch => 'artist',
+   }
+ );
+
+... will work, searching on the record label's name, but only
+prefetching the C<artist>.
+
+=head3 Using L</prefetch> with L</select> / L</+select> / L</as> / L</+as>
+
+L</prefetch> implies a L</+select>/L</+as> with the fields of the
+prefetched relations.  So given:
+
+  my $rs = $schema->resultset('CD')->search(
+   undef,
+   {
+     select   => ['cd.title'],
+     as       => ['cd_title'],
+     prefetch => 'artist',
+   }
+ );
+
+The L</select> becomes: C<'cd.title', 'artist.*'> and the L</as>
+becomes: C<'cd_title', 'artist.*'>.
 
-B<NOTE:> If you specify a C<prefetch> attribute, the C<join> and C<select>
-attributes will be ignored.
+=head3 CAVEATS
 
-B<CAVEATs>: Prefetch does a lot of deep magic. As such, it may not behave
-exactly as you might expect.
+Prefetch does a lot of deep magic. As such, it may not behave exactly
+as you might expect.
 
 =over 4
 
@@ -4046,7 +4128,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