Cleanup
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / ResultSet.pm
index 41dbfb4..8d683e0 100644 (file)
@@ -10,6 +10,7 @@ use Data::Page;
 use Storable;
 use Scalar::Util qw/weaken/;
 
+use DBIx::Class::ResultSetColumn;
 use base qw/DBIx::Class/;
 __PACKAGE__->load_components(qw/AccessorGroup/);
 __PACKAGE__->mk_group_accessors('simple' => qw/result_source result_class/);
@@ -59,8 +60,6 @@ In the examples below, the following table classes are used:
 
 =item Return Value: $rs
 
-=item 
-
 =back
 
 The resultset constructor. Takes a source object (usually a
@@ -186,7 +185,7 @@ sub new {
                  # year = 2005 OR year = 2004
 
 If you need to pass in additional attributes but no additional condition,
-call it as C<search(undef, \%attrs);>.
+call it as C<search(undef, \%attrs)>.
 
   # "SELECT name, artistid FROM $artist_table"
   my @all_artists = $schema->resultset('Artist')->search(undef, {
@@ -267,7 +266,7 @@ sub search_literal {
 
 =over 4
 
-=item Arguments: (@values | \%cols), \%attrs?
+=item Arguments: @values | \%cols, \%attrs?
 
 =item Return Value: $row_object
 
@@ -296,40 +295,58 @@ sub find {
   my ($self, @vals) = @_;
   my $attrs = (@vals > 1 && ref $vals[$#vals] eq 'HASH' ? pop(@vals) : {});
 
-  my @cols = $self->result_source->primary_columns;
+  my %unique_constraints = $self->result_source->unique_constraints;
+  $self->throw_exception(
+    "Can't find unless a primary key or unique constraint is defined"
+  ) unless %unique_constraints;
+
+  my @constraint_names = keys %unique_constraints;
   if (exists $attrs->{key}) {
-    my %uniq = $self->result_source->unique_constraints;
     $self->throw_exception(
       "Unknown key $attrs->{key} on '" . $self->result_source->name . "'"
-    ) unless exists $uniq{$attrs->{key}};
-    @cols = @{ $uniq{$attrs->{key}} };
-  }
-  #use Data::Dumper; warn Dumper($attrs, @vals, @cols);
-  $self->throw_exception(
-    "Can't find unless a primary key or unique constraint is defined"
-  ) unless @cols;
-
-  my $query;
-  if (ref $vals[0] eq 'HASH') {
-    $query = { %{$vals[0]} };
-  } elsif (@cols == @vals) {
-    $query = {};
-    @{$query}{@cols} = @vals;
-  } else {
-    $query = {@vals};
+    ) unless exists $unique_constraints{$attrs->{key}};
+
+    @constraint_names = ($attrs->{key});
   }
-  foreach my $key (grep { ! m/\./ } keys %$query) {
-    $query->{"$self->{attrs}{alias}.$key"} = delete $query->{$key};
+
+  my @unique_hashes;
+  foreach my $name (@constraint_names) {
+    my @unique_cols = @{ $unique_constraints{$name} };
+    my %unique_hash;
+    if (ref $vals[0] eq 'HASH') {
+      %unique_hash =
+        map  { $_ => $vals[0]->{$_} }
+        grep { exists $vals[0]->{$_} }
+        @unique_cols;
+    }
+    elsif (@unique_cols == @vals) {
+      # Assume the argument order corresponds to the constraint definition
+      @unique_hash{@unique_cols} = @vals;
+    }
+    elsif (@vals % 2 == 0) {
+      # Fix for CDBI calling with a hash
+      %unique_hash = @vals;
+    }
+
+    foreach my $key (grep { ! m/\./ } keys %unique_hash) {
+      $unique_hash{"$self->{attrs}{alias}.$key"} = delete $unique_hash{$key};
+    }
+
+    #use Data::Dumper; warn Dumper \@vals, \@unique_cols, \%unique_hash;
+    push @unique_hashes, \%unique_hash if %unique_hash;
   }
-  #warn Dumper($query);
-  
+
+  # Handle cases where the ResultSet already defines the query
+  my $query = @unique_hashes ? \@unique_hashes : undef;
+
   if (keys %$attrs) {
-      my $rs = $self->search($query,$attrs);
-      return keys %{$rs->{collapse}} ? $rs->next : $rs->single;
-  } else {
-      return keys %{$self->{collapse}} ?
-        $self->search($query)->next :
-        $self->single($query);
+    my $rs = $self->search($query, $attrs);
+    return keys %{$rs->{collapse}} ? $rs->next : $rs->single;
+  }
+  else {
+    return keys %{$self->{collapse}}
+      ? $self->search($query)->next
+      : $self->single($query);
   }
 }
 
@@ -347,7 +364,7 @@ sub find {
     name => 'Emo-R-Us',
   });
 
-Search the specified relationship, optionally specify a condition and
+Searches the specified relationship, optionally specifying a condition and
 attributes for matching records. See L</ATTRIBUTES> for more information.
 
 =cut
@@ -416,6 +433,28 @@ sub single {
   return (@data ? $self->_construct_object(@data) : ());
 }
 
+=head2 get_column
+
+=over 4
+
+=item Arguments: $cond?
+
+=item Return Value: $resultsetcolumn
+
+=back
+
+  my $max_length = $rs->get_column('length')->max;
+
+Returns a ResultSetColumn instance for $column based on $self
+
+=cut
+
+sub get_column {
+  my ($self, $column) = @_;
+
+  my $new = DBIx::Class::ResultSetColumn->new($self, $column);
+  return $new;
+}
 
 =head2 search_like
 
@@ -430,7 +469,7 @@ sub single {
   # WHERE title LIKE '%blue%'
   $cd_rs = $rs->search_like({ title => '%blue%'});
 
-Perform a search, but use C<LIKE> instead of C<=> as the condition. Note
+Performs a search, but uses C<LIKE> instead of C<=> as the condition. Note
 that this is simply a convenience method. You most likely want to use
 L</search> with specific operators.
 
@@ -457,8 +496,8 @@ sub search_like {
 =back
 
 Returns a resultset or object list representing a subset of elements from the
-resultset slice is called on.  Indexes are from 0 - i.e. to get the first
-three records, call
+resultset slice is called on. Indexes are from 0, i.e., to get the first
+three records, call:
 
   my ($one, $two, $three) = $rs->slice(0, 2);
 
@@ -466,12 +505,13 @@ three records, call
 
 sub slice {
   my ($self, $min, $max) = @_;
-  my $attrs = { %{ $self->{attrs} || {} } };
-  $attrs->{offset} ||= 0;
+  my $attrs = {}; # = { %{ $self->{attrs} || {} } };
+  $attrs->{offset} = $self->{attrs}{offset} || 0;
   $attrs->{offset} += $min;
   $attrs->{rows} = ($max ? ($max - $min + 1) : 1);
-  my $slice = (ref $self)->new($self->result_source, $attrs);
-  return (wantarray ? $slice->all : $slice);
+  return $self->search(undef(), $attrs);
+  #my $slice = (ref $self)->new($self->result_source, $attrs);
+  #return (wantarray ? $slice->all : $slice);
 }
 
 =head2 next
@@ -493,6 +533,10 @@ Can be used to efficiently iterate over records in the resultset:
     print $cd->title;
   }
 
+Note that you need to store the resultset object, and call C<next> on it. 
+Calling C<< resultset('Table')->next >> repeatedly will always return the
+first record from the resultset.
+
 =cut
 
 sub next {
@@ -617,7 +661,7 @@ is derived.
 
 =over 4
 
-=item Arguments: ($cond, \%attrs?)?
+=item Arguments: $cond, \%attrs??
 
 =item Return Value: $count
 
@@ -772,7 +816,7 @@ sub reset {
 =back
 
 Resets the resultset and returns an object for the first result (if the
-resultset contains anything).
+resultset returns anything).
 
 =cut
 
@@ -780,6 +824,71 @@ sub first {
   return $_[0]->reset->next;
 }
 
+# _cond_for_update_delete
+#
+# update/delete require the condition to be modified to handle
+# the differing SQL syntax available.  This transforms the $self->{cond}
+# appropriately, returning the new condition.
+
+sub _cond_for_update_delete {
+  my ($self) = @_;
+  my $cond = {};
+
+  if (!ref($self->{cond})) {
+    # No-op. No condition, we're updating/deleting everything
+  }
+  elsif (ref $self->{cond} eq 'ARRAY') {
+    $cond = [
+      map {
+        my %hash;
+        foreach my $key (keys %{$_}) {
+          $key =~ /([^.]+)$/;
+          $hash{$1} = $_->{$key};
+        }
+        \%hash;
+      } @{$self->{cond}}
+    ];
+  }
+  elsif (ref $self->{cond} eq 'HASH') {
+    if ((keys %{$self->{cond}})[0] eq '-and') {
+      $cond->{-and} = [];
+
+      my @cond = @{$self->{cond}{-and}};
+      for (my $i = 0; $i < @cond - 1; $i++) {
+        my $entry = $cond[$i];
+
+        my %hash;
+        if (ref $entry eq 'HASH') {
+          foreach my $key (keys %{$entry}) {
+            $key =~ /([^.]+)$/;
+            $hash{$1} = $entry->{$key};
+          }
+        }
+        else {
+          $entry =~ /([^.]+)$/;
+          $hash{$entry} = $cond[++$i];
+        }
+
+        push @{$cond->{-and}}, \%hash;
+      }
+    }
+    else {
+      foreach my $key (keys %{$self->{cond}}) {
+        $key =~ /([^.]+)$/;
+        $cond->{$1} = $self->{cond}{$key};
+      }
+    }
+  }
+  else {
+    $self->throw_exception(
+      "Can't update/delete on resultset with condition unless hash or array"
+    );
+  }
+
+  return $cond;
+}
+
+
 =head2 update
 
 =over 4
@@ -800,8 +909,11 @@ sub update {
   my ($self, $values) = @_;
   $self->throw_exception("Values for update must be a hash")
     unless ref $values eq 'HASH';
+
+  my $cond = $self->_cond_for_update_delete;
+
   return $self->result_source->storage->update(
-    $self->result_source->from, $values, $self->{cond}
+    $self->result_source->from, $values, $cond
   );
 }
 
@@ -815,8 +927,8 @@ sub update {
 
 =back
 
-Fetches all objects and updates them one at a time.  Note that C<update_all>
-will run cascade triggers while L</update> will not.
+Fetches all objects and updates them one at a time. Note that C<update_all>
+will run DBIC cascade triggers, while L</update> will not.
 
 =cut
 
@@ -841,7 +953,8 @@ sub update_all {
 =back
 
 Deletes the contents of the resultset from its result source. Note that this
-will not run cascade triggers. See L</delete_all> if you need triggers to run.
+will not run DBIC cascade triggers. See L</delete_all> if you need triggers
+to run.
 
 =cut
 
@@ -849,43 +962,9 @@ sub delete {
   my ($self) = @_;
   my $del = {};
 
-  if (!ref($self->{cond})) {
-
-    # No-op. No condition, we're deleting everything
-
-  } elsif (ref $self->{cond} eq 'ARRAY') {
-
-    $del = [ map { my %hash;
-      foreach my $key (keys %{$_}) {
-        $key =~ /([^.]+)$/;
-        $hash{$1} = $_->{$key};
-      }; \%hash; } @{$self->{cond}} ];
-
-  } elsif (ref $self->{cond} eq 'HASH') {
-
-    if ((keys %{$self->{cond}})[0] eq '-and') {
-
-      $del->{-and} = [ map { my %hash;
-        foreach my $key (keys %{$_}) {
-          $key =~ /([^.]+)$/;
-          $hash{$1} = $_->{$key};
-        }; \%hash; } @{$self->{cond}{-and}} ];
-
-    } else {
-
-      foreach my $key (keys %{$self->{cond}}) {
-        $key =~ /([^.]+)$/;
-        $del->{$1} = $self->{cond}{$key};
-      }
-    }
+  my $cond = $self->_cond_for_update_delete;
 
-  } else {
-    $self->throw_exception(
-      "Can't delete on resultset with condition unless hash or array"
-    );
-  }
-
-  $self->result_source->storage->delete($self->result_source->from, $del);
+  $self->result_source->storage->delete($self->result_source->from, $cond);
   return 1;
 }
 
@@ -899,8 +978,8 @@ sub delete {
 
 =back
 
-Fetches all objects and deletes them one at a time.  Note that C<delete_all>
-will run cascade triggers while L</delete> will not.
+Fetches all objects and deletes them one at a time. Note that C<delete_all>
+will run DBIC cascade triggers, while L</delete> will not.
 
 =cut
 
@@ -947,7 +1026,7 @@ sub pager {
 
 Returns a resultset for the $page_number page of the resultset on which page
 is called, where each page contains a number of rows equal to the 'rows'
-attribute set on the resultset, or 10 by default
+attribute set on the resultset (10 by default).
 
 =cut
 
@@ -1069,9 +1148,9 @@ sub find_or_create {
 
   $class->update_or_create({ col => $val, ... });
 
-First, search for an existing row matching one of the unique constraints
-(including the primary key) on the source of this resultset.  If a row is
-found, update it with the other given column values.  Otherwise, create a new
+First, searches for an existing row matching one of the unique constraints
+(including the primary key) on the source of this resultset. If a row is
+found, updates it with the other given column values. Otherwise, creates a new
 row.
 
 Takes an optional C<key> attribute to search on a specific unique constraint.
@@ -1090,7 +1169,7 @@ For example:
 If no C<key> is specified, it searches on all unique constraints defined on the
 source, including the primary key.
 
-If the C<key> is specified as C<primary>, search only on the primary key.
+If the C<key> is specified as C<primary>, it searches only on the primary key.
 
 See also L</find> and L</find_or_create>.
 
@@ -1101,30 +1180,11 @@ sub update_or_create {
   my $attrs = (@_ > 1 && ref $_[$#_] eq 'HASH' ? pop(@_) : {});
   my $hash = ref $_[0] eq 'HASH' ? shift : {@_};
 
-  my %unique_constraints = $self->result_source->unique_constraints;
-  my @constraint_names   = (exists $attrs->{key}
-                            ? ($attrs->{key})
-                            : keys %unique_constraints);
-
-  my @unique_hashes;
-  foreach my $name (@constraint_names) {
-    my @unique_cols = @{ $unique_constraints{$name} };
-    my %unique_hash =
-      map  { $_ => $hash->{$_} }
-      grep { exists $hash->{$_} }
-      @unique_cols;
-
-    push @unique_hashes, \%unique_hash
-      if (scalar keys %unique_hash == scalar @unique_cols);
-  }
-
-  if (@unique_hashes) {
-    my $row = $self->single(\@unique_hashes);
-    if (defined $row) {
-      $row->set_columns($hash);
-      $row->update;
-      return $row;
-    }
+  my $row = $self->find($hash, $attrs);
+  if (defined $row) {
+    $row->set_columns($hash);
+    $row->update;
+    return $row;
   }
 
   return $self->create($hash);
@@ -1140,7 +1200,7 @@ sub update_or_create {
 
 =back
 
-Gets the contents of the cache for the resultset if the cache is set
+Gets the contents of the cache for the resultset, if the cache is set.
 
 =cut
 
@@ -1263,6 +1323,8 @@ overview of them:
 
 =item Value: ($order_by | \@order_by)
 
+=back
+
 Which column(s) to order the results by. This is currently passed
 through directly to SQL, so you can give e.g. C<year DESC> for a
 descending order on the column `year'.
@@ -1471,7 +1533,7 @@ avoid using C<from> unless you cannot achieve the desired result using C<join>.
 In simple terms, C<from> works as follows:
 
     [
-        { <alias> => <table>, -join-type => 'inner|left|right' }
+        { <alias> => <table>, -join_type => 'inner|left|right' }
         [] # nested JOIN (optional)
         { <table.column> => <foreign_table.foreign_key> }
     ]
@@ -1534,7 +1596,7 @@ with a father in the person table, we could explicitly use C<INNER JOIN>:
             from => [
                 { child => 'person' },
                 [
-                    { father => 'person', -join-type => 'inner' },
+                    { father => 'person', -join_type => 'inner' },
                     { 'father.id' => 'child.father_id' }
                 ],
             ]
@@ -1580,6 +1642,20 @@ A arrayref of columns to group by. Can include columns of joined tables.
 
   group_by => [qw/ column1 column2 ... /]
 
+=head2 having
+
+=over 4
+
+=item Value: $condition
+
+=back
+
+HAVING is a select statement attribute that is applied between GROUP BY and
+ORDER BY. It is applied to the after the grouping calculations have been
+done. 
+
+  having => { 'count(employee)' => { '>=', 100 } }
+
 =head2 distinct
 
 =over 4