Refactoring, cleanup, lose unnecessary resultset/cursor objects

diff --git a/lib/DBIx/Class/Cursor.pm b/lib/DBIx/Class/Cursor.pm
index 5d935c7..d79bd12 100644 (file)
--- a/lib/DBIx/Class/Cursor.pm
+++ b/lib/DBIx/Class/Cursor.pm
@@ -15,4 +15,15 @@ sub reset {
   die "Virtual method!";
 }
 
+sub all {
+  my ($self) = @_;
+  $self->reset;
+  my @all;
+  while (my @row = $self->next) {
+    push(@all, \@row);
+  }
+  $self->reset;
+  return @all;
+}
+
 1;

diff --git a/lib/DBIx/Class/PK.pm b/lib/DBIx/Class/PK.pm
index 20576bd..ed0b830 100644 (file)
--- a/lib/DBIx/Class/PK.pm
+++ b/lib/DBIx/Class/PK.pm
@@ -54,18 +54,21 @@ sub find {
   if (ref $vals[0] eq 'HASH') {
     $query = $vals[0];
   } elsif (@pk == @vals) {
-    my $ret = ($class->search_literal($class->_ident_cond, @vals, $attrs))[0];
+    $query = {};
+    @{$query}{@pk} = @vals;
+    #my $ret = ($class->search_literal($class->_ident_cond, @vals, $attrs))[0];
     #warn "$class: ".join(', ', %{$ret->{_column_data}});
-    return $ret;
+    #return $ret;
   } else {
     $query = {@vals};
   }
   $class->throw( "Can't find unless all primary keys are specified" )
     unless (keys %$query >= @pk); # If we check 'em we run afoul of uc/lc
                                   # column names etc. Not sure what to do yet
-  my $ret = ($class->search($query))[0];
-  #warn "$class: ".join(', ', %{$ret->{_column_data}});
-  return $ret;
+  #return $class->search($query)->next;
+  my @cols = $class->_select_columns;
+  my @row = $class->storage->select_single($class->_table_name, \@cols, $query);
+  return (@row ? $class->_row_to_object(\@cols, \@row) : ());
 }
 
 sub discard_changes {

diff --git a/lib/DBIx/Class/Relationship/Accessor.pm b/lib/DBIx/Class/Relationship/Accessor.pm
index 12d8f8f..7e215d4 100644 (file)
--- a/lib/DBIx/Class/Relationship/Accessor.pm
+++ b/lib/DBIx/Class/Relationship/Accessor.pm
@@ -25,7 +25,7 @@ sub add_relationship_accessor {
       } elsif (exists $self->{_relationship_data}{$rel}) {
         return $self->{_relationship_data}{$rel};
       } else {
-        my ($val) = $self->search_related($rel, {}, {});
+        my $val = $self->find_related($rel, {}, {});
         return unless $val;
         return $self->{_relationship_data}{$rel} = $val;
       }

diff --git a/lib/DBIx/Class/Relationship/Base.pm b/lib/DBIx/Class/Relationship/Base.pm
index 05f2508..ba71b30 100644 (file)
--- a/lib/DBIx/Class/Relationship/Base.pm
+++ b/lib/DBIx/Class/Relationship/Base.pm
@@ -182,9 +182,25 @@ sub new_related {
   return $self->resolve_class($rel_obj->{class})->new(\%fields);
 }
 
+sub find_related {
+  my $self = shift;
+  my $rel = shift;
+  my $rel_obj = $self->_relationships->{$rel};
+  $self->throw( "No such relationship ${rel}" ) unless $rel_obj;
+  my ($cond) = $self->resolve_condition($rel_obj->{cond}, { _action => 'convert' });
+  $self->throw( "Invalid query: @_" ) if (@_ > 1 && (@_ % 2 == 1));
+  my $attrs = { };
+  if (@_ > 1 && ref $_[$#_] eq 'HASH') {
+    $attrs = { %{ pop(@_) } };
+  }
+  my $query = ((@_ > 1) ? {@_} : shift);
+  $query = ($query ? { '-and' => [ $cond, $query ] } : $cond);
+  return $self->resolve_class($rel_obj->{class})->find($query);
+}
+
 sub find_or_create_related {
   my $self = shift;
-  return ($self->search_related(@_))[0] || $self->create_related(@_);
+  return $self->find_related(@_) || $self->create_related(@_);
 }
 
 sub set_from_related {

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index e7cbd88..644ff76 100644 (file)
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -48,20 +48,15 @@ sub count {
 
   my $db_class = $self->{class};
   my @cols = 'COUNT(*)';
-  my $cursor = $db_class->storage->select($db_class->_table_name, \@cols,
+  my ($c) = $db_class->storage->select_single($db_class->_table_name, \@cols,
                                             $self->{cond}, $self->{attrs});
-  return ($cursor->next)[0];
+  return $c; # ($cursor->next)[0];
 }
 
 sub all {
   my ($self) = @_;
-  $self->reset;
-  my @all;
-  while (my $obj = $self->next) {
-    push(@all, $obj);
-  }
-  $self->reset;
-  return @all;
+  return map { $self->{class}->_row_to_object($self->{cols}, $_); }
+           $self->{cursor}->all;
 }
 
 sub reset {

diff --git a/lib/DBIx/Class/Row.pm b/lib/DBIx/Class/Row.pm
index 86841ef..f789b29 100644 (file)
--- a/lib/DBIx/Class/Row.pm
+++ b/lib/DBIx/Class/Row.pm
@@ -208,10 +208,11 @@ sub store_column {
   return $self->{_column_data}{$column} = $value;
 }
 
-sub _row_to_object { # WARNING: Destructive to @$row
+sub _row_to_object {
   my ($class, $cols, $row) = @_;
-  my $new = $class->new;
-  $new->store_column($_, shift @$row) for @$cols;
+  my %vals;
+  $vals{$cols->[$_]} = $row->[$_] for 0 .. $#$cols;
+  my $new = $class->new(\%vals);
   $new->in_storage(1);
   return $new;
 }

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 13b7cc0..453d51c 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -123,6 +123,16 @@ sub select {
   return $self->cursor->new($sth, \@bind, $attrs);
 }
 
+sub select_single {
+  my ($self, $ident, $select, $condition, $attrs) = @_;
+  my $order = $attrs->{order_by};
+  if (ref $condition eq 'SCALAR') {
+    $order = $1 if $$condition =~ s/ORDER BY (.*)$//i;
+  }
+  my ($rv, $sth, @bind) = $self->_execute('select', $attrs->{bind}, $ident, $select, $condition, $order);
+  return $sth->fetchrow_array;
+}
+
 sub sth {
   shift->dbh->prepare(@_);
 }

diff --git a/lib/DBIx/Class/Storage/DBI/Cursor.pm b/lib/DBIx/Class/Storage/DBI/Cursor.pm
index 87b0267..3ccaef9 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Cursor.pm
+++ b/lib/DBIx/Class/Storage/DBI/Cursor.pm
@@ -21,18 +21,29 @@ sub next {
   my ($self) = @_;
   return if $self->{attrs}{rows}
     && $self->{pos} >= $self->{attrs}{rows}; # + $self->{attrs}{offset});
+  my $sth = $self->{sth};
   unless ($self->{live_sth}) {
-    $self->{sth}->execute(@{$self->{args} || []});
+    $sth->execute(@{$self->{args} || []});
     if (my $offset = $self->{attrs}{offset}) {
-      $self->{sth}->fetch for 1 .. $offset;
+      $sth->fetch for 1 .. $offset;
     }
     $self->{live_sth} = 1;
   }
-  my @row = $self->{sth}->fetchrow_array;
+  my @row = $sth->fetchrow_array;
   $self->{pos}++ if @row;
   return @row;
 }
 
+sub all {
+  my ($self) = @_;
+  return $self->SUPER::all if $self->{attrs}{rows};
+  my $sth = $self->{sth};
+  $sth->finish if $sth->{Active};
+  $sth->execute(@{$self->{args} || []});
+  delete $self->{live_sth};
+  return @{$sth->fetchall_arrayref};
+}
+
 sub reset {
   my ($self) = @_;
   $self->{sth}->finish if $self->{sth}->{Active};

diff --git a/lib/DBIx/Class/Table.pm b/lib/DBIx/Class/Table.pm
index ba79341..9aa00ab 100644 (file)
--- a/lib/DBIx/Class/Table.pm
+++ b/lib/DBIx/Class/Table.pm
@@ -169,7 +169,7 @@ creates one and returns that instead
 sub find_or_create {
   my $class    = shift;
   my $hash     = ref $_[0] eq "HASH" ? shift: {@_};
-  my ($exists) = $class->search($hash);
+  my $exists = $class->find($hash);
   return defined($exists) ? $exists : $class->create($hash);
 }