Clarify ResultSet RV docs, bring set_cache RV in line with tests
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSet.pm
index 4e06ed6..78f4303 100644 (file)
@@ -2,10 +2,7 @@ package DBIx::Class::ResultSet;
 
 use strict;
 use warnings;
-use overload
-        '0+'     => "count",
-        'bool'   => "_bool",
-        fallback => 1;
+use base qw/DBIx::Class/;
 use Carp::Clan qw/^DBIx::Class/;
 use DBIx::Class::Exception;
 use Data::Page;
@@ -13,8 +10,14 @@ use Storable;
 use DBIx::Class::ResultSetColumn;
 use DBIx::Class::ResultSourceHandle;
 use List::Util ();
-use Scalar::Util ();
-use base qw/DBIx::Class/;
+use Scalar::Util qw/blessed weaken/;
+use Try::Tiny;
+use namespace::clean;
+
+use overload
+        '0+'     => "count",
+        'bool'   => "_bool",
+        fallback => 1;
 
 __PACKAGE__->mk_group_accessors('simple' => qw/_result_class _source_handle/);
 
@@ -57,7 +60,12 @@ represents.
 
 The query that the ResultSet represents is B<only> executed against
 the database when these methods are called:
-L</find> L</next> L</all> L</first> L</single> L</count>
+L</find>, L</next>, L</all>, L</first>, L</single>, L</count>.
+
+If a resultset is used in a numeric context it returns the L</count>.
+However, if it is used in a boolean context it is B<always> true.  So if
+you want to check if a resultset has any results, you must use C<if $rs
+!= 0>.
 
 =head1 EXAMPLES
 
@@ -101,7 +109,7 @@ attributes with the same keys need resolving.
 L</join>, L</prefetch>, L</+select>, L</+as> attributes are merged
 into the existing ones from the original resultset.
 
-The L</where>, L</having> attribute, and any search conditions are
+The L</where> and L</having> attributes, and any search conditions, are
 merged with an SQL C<AND> to the existing condition from the original
 resultset.
 
@@ -142,13 +150,6 @@ Which is the same as:
 
 See: L</search>, L</count>, L</get_column>, L</all>, L</create>.
 
-=head1 OVERLOADING
-
-If a resultset is used in a numeric context it returns the L</count>.
-However, if it is used in a boolean context it is always true.  So if
-you want to check if a resultset has any results use C<if $rs != 0>.
-C<if $rs> will always be true.
-
 =head1 METHODS
 
 =head2 new
@@ -199,7 +200,6 @@ sub new {
   my $self = {
     _source_handle => $source,
     cond => $attrs->{where},
-    count => undef,
     pager => undef,
     attrs => $attrs
   };
@@ -538,8 +538,8 @@ sub find {
       : $self->_add_alias($input_query, $alias);
   }
 
-  # Run the query
-  my $rs = $self->search ($query, $attrs);
+  # Run the query, passing the result_class since it should propagate for find
+  my $rs = $self->search ($query, {result_class => $self->result_class, %$attrs});
   if (keys %{$rs->_resolved_attrs->{collapse}}) {
     my $row = $rs->next;
     carp "Query returned more than one row" if $rs->next;
@@ -682,15 +682,15 @@ sub cursor {
 
 =item Arguments: $cond?
 
-=item Return Value: $row_object?
+=item Return Value: $row_object | undef
 
 =back
 
   my $cd = $schema->resultset('CD')->single({ year => 2001 });
 
 Inflates the first result without creating a cursor if the resultset has
-any records in it; if not returns nothing. Used by L</find> as a lean version of
-L</search>.
+any records in it; if not returns C<undef>. Used by L</find> as a lean version
+of L</search>.
 
 While this method can take an optional search condition (just like L</search>)
 being a fast-code-path it does not recognize search attributes. If you need to
@@ -913,7 +913,7 @@ sub slice {
   $attrs->{offset} = $self->{attrs}{offset} || 0;
   $attrs->{offset} += $min;
   $attrs->{rows} = ($max ? ($max - $min + 1) : 1);
-  return $self->search(undef(), $attrs);
+  return $self->search(undef, $attrs);
   #my $slice = (ref $self)->new($self->result_source, $attrs);
   #return (wantarray ? $slice->all : $slice);
 }
@@ -924,7 +924,7 @@ sub slice {
 
 =item Arguments: none
 
-=item Return Value: $result?
+=item Return Value: $result | undef
 
 =back
 
@@ -950,6 +950,7 @@ sub next {
     return $cache->[$self->{all_cache_position}++];
   }
   if ($self->{attrs}{cache}) {
+    delete $self->{pager};
     $self->{all_cache_position} = 1;
     return ($self->all)[0];
   }
@@ -1240,14 +1241,12 @@ sub _count_rs {
   my $rsrc = $self->result_source;
   $attrs ||= $self->_resolved_attrs;
 
-  # only take pieces we need for a simple count
-  my $tmp_attrs = { map
-    { $_ => $attrs->{$_} }
-    qw/ alias from where bind join /
-  };
+  my $tmp_attrs = { %$attrs };
+  # take off any limits, record_filter is cdbi, and no point of ordering nor locking a count
+  delete @{$tmp_attrs}{qw/rows offset order_by record_filter for/};
 
   # overwrite the selector (supplied by the storage)
-  $tmp_attrs->{select} = $rsrc->storage->_count_select ($rsrc, $tmp_attrs);
+  $tmp_attrs->{select} = $rsrc->storage->_count_select ($rsrc, $attrs);
   $tmp_attrs->{as} = 'count';
 
   my $tmp_rs = $rsrc->resultset_class->new($rsrc, $tmp_attrs)->get_column ('count');
@@ -1264,10 +1263,9 @@ sub _count_subq_rs {
   my $rsrc = $self->result_source;
   $attrs ||= $self->_resolved_attrs;
 
-  my $sub_attrs = { map
-    { $_ => $attrs->{$_} }
-    qw/ alias from where bind join group_by having rows offset /
-  };
+  my $sub_attrs = { %$attrs };
+  # extra selectors do not go in the subquery and there is no point of ordering it, nor locking it
+  delete @{$sub_attrs}{qw/collapse select _prefetch_select as order_by for/};
 
   # 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
@@ -1278,6 +1276,8 @@ sub _count_subq_rs {
   # Calculate subquery selector
   if (my $g = $sub_attrs->{group_by}) {
 
+    my $sql_maker = $rsrc->storage->sql_maker;
+
     # necessary as the group_by may refer to aliased functions
     my $sel_index;
     for my $sel (@{$attrs->{select}}) {
@@ -1286,7 +1286,17 @@ sub _count_subq_rs {
     }
 
     for my $g_part (@$g) {
-      push @{$sub_attrs->{select}}, $sel_index->{$g_part} || $g_part;
+      my $colpiece = $sel_index->{$g_part} || $g_part;
+
+      # disqualify join-based group_by's. Arcane but possible query
+      # also horrible horrible hack to alias a column (not a func.)
+      # (probably need to introduce SQLA syntax)
+      if ($colpiece =~ /\./ && $colpiece !~ /^$attrs->{alias}\./) {
+        my $as = $colpiece;
+        $as =~ s/\./__/;
+        $colpiece = \ sprintf ('%s AS %s', map { $sql_maker->_quote ($_) } ($colpiece, $as) );
+      }
+      push @{$sub_attrs->{select}}, $colpiece;
     }
   }
   else {
@@ -1298,7 +1308,7 @@ sub _count_subq_rs {
                ->new ($rsrc, $sub_attrs)
                 ->as_subselect_rs
                  ->search ({}, { columns => { count => $rsrc->storage->_count_select ($rsrc, $attrs) } })
-                  -> get_column ('count');
+                  ->get_column ('count');
 }
 
 sub _bool {
@@ -1399,12 +1409,12 @@ sub reset {
 
 =item Arguments: none
 
-=item Return Value: $object?
+=item Return Value: $object | undef
 
 =back
 
-Resets the resultset and returns an object for the first result (if the
-resultset returns anything).
+Resets the resultset and returns an object for the first result (or C<undef>
+if the resultset is empty).
 
 =cut
 
@@ -1436,7 +1446,8 @@ sub _rs_update_delete {
     # make a new $rs selecting only the PKs (that's all we really need)
     my $attrs = $self->_resolved_attrs_copy;
 
-    delete $attrs->{$_} for qw/collapse select as/;
+
+    delete $attrs->{$_} for qw/collapse _collapse_order_by select _prefetch_select as/;
     $attrs->{columns} = [ map { "$attrs->{alias}.$_" } ($self->result_source->_pri_cols) ];
 
     if ($needs_group_by_subq) {
@@ -1470,7 +1481,6 @@ sub _rs_update_delete {
     }
 
     my $subrs = (ref $self)->new($rsrc, $attrs);
-
     return $self->result_source->storage->_subq_update_delete($subrs, $op, $values);
   }
   else {
@@ -1796,11 +1806,115 @@ C<total_entries> on the L<Data::Page> object.
 
 =cut
 
+# make a wizard good for both a scalar and a hashref
+my $mk_lazy_count_wizard = sub {
+  require Variable::Magic;
+
+  my $stash = { total_rs => shift };
+  my $slot = shift; # only used by the hashref magic
+
+  my $magic = Variable::Magic::wizard (
+    data => sub { $stash },
+
+    (!$slot)
+    ? (
+      # the scalar magic
+      get => sub {
+        # set value lazily, and dispell for good
+        ${$_[0]} = $_[1]{total_rs}->count;
+        Variable::Magic::dispell (${$_[0]}, $_[1]{magic_selfref});
+        return 1;
+      },
+      set => sub {
+        # an explicit set implies dispell as well
+        # the unless() is to work around "fun and giggles" below
+        Variable::Magic::dispell (${$_[0]}, $_[1]{magic_selfref})
+          unless (caller(2))[3] eq 'DBIx::Class::ResultSet::pager';
+        return 1;
+      },
+    )
+    : (
+      # the uvar magic
+      fetch => sub {
+        if ($_[2] eq $slot and !$_[1]{inactive}) {
+          my $cnt = $_[1]{total_rs}->count;
+          $_[0]->{$slot} = $cnt;
+
+          # attempting to dispell in a fetch handle (works in store), seems
+          # to invariable segfault on 5.10, 5.12, 5.13 :(
+          # so use an inactivator instead
+          #Variable::Magic::dispell (%{$_[0]}, $_[1]{magic_selfref});
+          $_[1]{inactive}++;
+        }
+        return 1;
+      },
+      store => sub {
+        if (! $_[1]{inactive} and $_[2] eq $slot) {
+          #Variable::Magic::dispell (%{$_[0]}, $_[1]{magic_selfref});
+          $_[1]{inactive}++
+            unless (caller(2))[3] eq 'DBIx::Class::ResultSet::pager';
+        }
+        return 1;
+      },
+    ),
+  );
+
+  $stash->{magic_selfref} = $magic;
+  weaken ($stash->{magic_selfref}); # this fails on 5.8.1
+
+  return $magic;
+};
+
+# the tie class for 5.8.1
+{
+  package DBIx::Class::__DBIC_LAZY_RS_COUNT__;
+  use base qw/Tie::Hash/;
+
+  sub FIRSTKEY { my $dummy = scalar keys %{$_[0]{data}}; each %{$_[0]{data}} }
+  sub NEXTKEY  { each %{$_[0]{data}} }
+  sub EXISTS   { exists $_[0]{data}{$_[1]} }
+  sub DELETE   { delete $_[0]{data}{$_[1]} }
+  sub CLEAR    { %{$_[0]{data}} = () }
+  sub SCALAR   { scalar %{$_[0]{data}} }
+
+  sub TIEHASH {
+    $_[1]{data} = {%{$_[1]{selfref}}};
+    %{$_[1]{selfref}} = ();
+    Scalar::Util::weaken ($_[1]{selfref});
+    return bless ($_[1], $_[0]);
+  };
+
+  sub FETCH {
+    if ($_[1] eq $_[0]{slot}) {
+      my $cnt = $_[0]{data}{$_[1]} = $_[0]{total_rs}->count;
+      untie %{$_[0]{selfref}};
+      %{$_[0]{selfref}} = %{$_[0]{data}};
+      return $cnt;
+    }
+    else {
+      $_[0]{data}{$_[1]};
+    }
+  }
+
+  sub STORE {
+    $_[0]{data}{$_[1]} = $_[2];
+    if ($_[1] eq $_[0]{slot}) {
+      untie %{$_[0]{selfref}};
+      %{$_[0]{selfref}} = %{$_[0]{data}};
+    }
+    $_[2];
+  }
+}
+
 sub pager {
   my ($self) = @_;
 
   return $self->{pager} if $self->{pager};
 
+  if ($self->get_cache) {
+    $self->throw_exception ('Pagers on cached resultsets are not supported');
+  }
+
   my $attrs = $self->{attrs};
   $self->throw_exception("Can't create pager for non-paged rs")
     unless $self->{attrs}{page};
@@ -1810,13 +1924,69 @@ sub pager {
   # with a subselect) to get the real total count
   my $count_attrs = { %$attrs };
   delete $count_attrs->{$_} for qw/rows offset page pager/;
-  my $total_count = (ref $self)->new($self->result_source, $count_attrs)->count;
+  my $total_rs = (ref $self)->new($self->result_source, $count_attrs);
+
+
+### the following may seem awkward and dirty, but it's a thought-experiment
+### necessary for future development of DBIx::DS. Do *NOT* change this code
+### before talking to ribasushi/mst
 
-  return $self->{pager} = Data::Page->new(
-    $total_count,
+  my $pager = Data::Page->new(
+    0,  #start with an empty set
     $attrs->{rows},
-    $self->{attrs}{page}
+    $self->{attrs}{page},
   );
+
+  my $data_slot = 'total_entries';
+
+  # Since we are interested in a cached value (once it's set - it's set), every
+  # technique will detach from the magic-host once the time comes to fire the
+  # ->count (or in the segfaulting case of >= 5.10 it will deactivate itself)
+
+  if ($] < 5.008003) {
+    # 5.8.1 throws 'Modification of a read-only value attempted' when one tries
+    # to weakref the magic container :(
+    # tested on 5.8.1
+    tie (%$pager, 'DBIx::Class::__DBIC_LAZY_RS_COUNT__',
+      { slot => $data_slot, total_rs => $total_rs, selfref => $pager }
+    );
+  }
+  elsif ($] < 5.010) {
+    # We can use magic on the hash value slot. It's interesting that the magic is
+    # attached to the hash-slot, and does *not* stop working once I do the dummy
+    # assignments after the cast()
+    # tested on 5.8.3 and 5.8.9
+    my $magic = $mk_lazy_count_wizard->($total_rs);
+    Variable::Magic::cast ( $pager->{$data_slot}, $magic );
+
+    # this is for fun and giggles
+    $pager->{$data_slot} = -1;
+    $pager->{$data_slot} = 0;
+
+    # this does not work for scalars, but works with
+    # uvar magic below
+    #my %vals = %$pager;
+    #%$pager = ();
+    #%{$pager} = %vals;
+  }
+  else {
+    # And the uvar magic
+    # works on 5.10.1, 5.12.1 and 5.13.4 in its current form,
+    # however see the wizard maker for more notes
+    my $magic = $mk_lazy_count_wizard->($total_rs, $data_slot);
+    Variable::Magic::cast ( %$pager, $magic );
+
+    # still works
+    $pager->{$data_slot} = -1;
+    $pager->{$data_slot} = 0;
+
+    # this now works
+    my %vals = %$pager;
+    %$pager = ();
+    %{$pager} = %vals;
+  }
+
+  return $self->{pager} = $pager;
 }
 
 =head2 page
@@ -1936,7 +2106,7 @@ sub _is_deterministic_value {
   my $value = shift;
   my $ref_type = ref $value;
   return 1 if $ref_type eq '' || $ref_type eq 'SCALAR';
-  return 1 if Scalar::Util::blessed($value);
+  return 1 if blessed $value;
   return 0;
 }
 
@@ -2183,7 +2353,7 @@ or C<has_one> resultset.  Note Arrayref.
   );
 
 Example of creating a new row and also creating a row in a related
-C<belongs_to>resultset. Note Hashref.
+C<belongs_to> resultset. Note Hashref.
 
   $cd_rs->create({
     title=>"Music for Silly Walks",
@@ -2413,7 +2583,7 @@ sub update_or_new {
 
 =item Arguments: none
 
-=item Return Value: \@cache_objects?
+=item Return Value: \@cache_objects | undef
 
 =back
 
@@ -2461,7 +2631,7 @@ sub set_cache {
 
 =item Arguments: none
 
-=item Return Value: []
+=item Return Value: undef
 
 =back
 
@@ -2504,7 +2674,7 @@ sub is_paged {
 
 sub is_ordered {
   my ($self) = @_;
-  return scalar $self->result_source->storage->_parse_order_by($self->{attrs}{order_by});
+  return scalar $self->result_source->storage->_extract_order_columns($self->{attrs}{order_by});
 }
 
 =head2 related_resultset
@@ -2547,7 +2717,7 @@ sub related_resultset {
     # (the select/as attrs were deleted in the beginning), we need to flip all
     # left joins to inner, so we get the expected results
     # read the comment on top of the actual function to see what this does
-    $attrs->{from} = $rsrc->schema->storage->_straight_join_to_node ($attrs->{from}, $alias);
+    $attrs->{from} = $rsrc->schema->storage->_inner_join_to_node ($attrs->{from}, $alias);
 
 
     #XXX - temp fix for result_class bug. There likely is a more elegant fix -groditi
@@ -2966,21 +3136,33 @@ sub _resolved_attrs {
       carp ("Useless use of distinct on a grouped resultset ('distinct' is ignored when a 'group_by' is present)");
     }
     else {
-      $attrs->{group_by} = [ grep { !ref($_) || (ref($_) ne 'HASH') } @{$attrs->{select}} ];
+      my $storage = $self->result_source->schema->storage;
+      my $rs_column_list = $storage->_resolve_column_info ($attrs->{from});
+
+      my $group_spec = $attrs->{group_by} = [];
+      my %group_index;
 
+      for (@{$attrs->{select}}) {
+        if (! ref($_) or ref ($_) ne 'HASH' ) {
+          push @$group_spec, $_;
+          $group_index{$_}++;
+          if ($rs_column_list->{$_} and $_ !~ /\./ ) {
+            # add a fully qualified version as well
+            $group_index{"$rs_column_list->{$_}{-source_alias}.$_"}++;
+          }
+        }
+      }
       # add any order_by parts that are not already present in the group_by
       # we need to be careful not to add any named functions/aggregates
       # i.e. select => [ ... { count => 'foo', -as 'foocount' } ... ]
-      my %already_grouped = map { $_ => 1 } (@{$attrs->{group_by}});
+      for my $chunk ($storage->_extract_order_columns($attrs->{order_by})) {
 
-      my $storage = $self->result_source->schema->storage;
+        # only consider real columns (for functions the user got to do an explicit group_by)
+        my $colinfo = $rs_column_list->{$chunk}
+          or next;
 
-      my $rs_column_list = $storage->_resolve_column_info ($attrs->{from});
-
-      for my $chunk ($storage->_parse_order_by($attrs->{order_by})) {
-        if ($rs_column_list->{$chunk} && not $already_grouped{$chunk}++) {
-          push @{$attrs->{group_by}}, $chunk;
-        }
+        $chunk = "$colinfo->{-source_alias}.$chunk" if $chunk !~ /\./;
+        push @$group_spec, $chunk unless $group_index{$chunk}++;
       }
     }
   }
@@ -3235,6 +3417,15 @@ it and sets C<select> from that, then auto-populates C<as> from
 C<select> as normal. (You may also use the C<cols> attribute, as in
 earlier versions of DBIC.)
 
+Essentially C<columns> does the same as L</select> and L</as>.
+
+    columns => [ 'foo', { bar => 'baz' } ]
+
+is the same as
+
+    select => [qw/foo baz/],
+    as => [qw/foo bar/]
+
 =head2 +columns
 
 =over 4