Added count, count_related, and tests

diff --git a/lib/DBIx/Class/Relationship.pm b/lib/DBIx/Class/Relationship.pm
index da768ac..87f8f11 100644 (file)
--- a/lib/DBIx/Class/Relationship.pm
+++ b/lib/DBIx/Class/Relationship.pm
@@ -182,6 +182,22 @@ sub update_from_related {
   $self->update;
 }
 
+sub count_related {
+  my $self = shift;
+  my $rel = shift;
+  my $rel_obj = $self->_relationships->{$rel};
+  $self->throw( "No such relationship ${rel}" ) unless $rel_obj;
+  my $cond = $rel_obj->{cond};
+  my $count_cond = {};
+  foreach my $key (keys %$cond) {
+    $key =~ m/^foreign\.([^\.]+)$/;
+    my $count_key = $1;
+    $cond->{$key} =~ m/^self\.([^\.]+)$/;
+    $count_cond->{$count_key} = $self->get_column($1);
+  }
+  return $rel_obj->{class}->count( $count_cond );
+}
+
 1;
 
 =back

diff --git a/lib/DBIx/Class/Table.pm b/lib/DBIx/Class/Table.pm
index 4163480..ec750fe 100644 (file)
--- a/lib/DBIx/Class/Table.pm
+++ b/lib/DBIx/Class/Table.pm
@@ -170,6 +170,22 @@ sub retrieve_from_sql {
   return $class->sth_to_objects($sth, \@vals, \@cols, { where => $cond });
 }
 
+sub count {
+  my $class = shift;
+  my $attrs = { };
+  if (@_ > 1 && ref $_[$#_] eq 'HASH') {
+    $attrs = { %{ pop(@_) } };
+  }
+  my $query    = ref $_[0] eq "HASH" ? shift: {@_};
+  my ($cond, @param)  = $class->_cond_resolve($query, $attrs);
+  my $sth = $class->_get_sth( 'select', [ 'COUNT(*)' ],
+                                $class->_table_name, $cond );
+  $sth->execute(@param);
+  my ($count) = $sth->fetchrow_array;
+  $sth->finish;
+  return $count;
+}
+
 sub sth_to_objects {
   my ($class, $sth, $args, $cols, $attrs) = @_;
   my @cols = ((ref $cols eq 'ARRAY') ? @$cols : @{$sth->{NAME_lc}} );

diff --git a/t/01core.t b/t/01core.t
index 692c6cb..7a80931 100644 (file)
--- a/t/01core.t
+++ b/t/01core.t
@@ -1,6 +1,6 @@
 use Test::More;
 
-plan tests => 19;
+plan tests => 20;
 
 use lib qw(t/lib);
 
@@ -73,3 +73,5 @@ $new->update;
 $new_again = DBICTest::Artist->retrieve(4);
 
 is($new_again->name, 'Man With A Spoon', 'Retrieved correctly');
+
+is(DBICTest::Artist->count, 4, 'count ok');

diff --git a/t/06relationship.t b/t/06relationship.t
index ed19fb5..d89a0ed 100644 (file)
--- a/t/06relationship.t
+++ b/t/06relationship.t
@@ -1,6 +1,6 @@
 use Test::More;
 
-plan tests => 7;
+plan tests => 8;
 
 use lib qw(t/lib);
 
@@ -26,6 +26,9 @@ $artist->create_related( 'cds', {
 } );
 is( ($artist->search_related('cds'))[3]->title, 'Big Flop', 'create_related ok' );
 
+# count_related
+is( $artist->count_related('cds'), 4, 'count_related ok' );
+
 SKIP: {
 
   #skip "Relationship with invalid cols not yet checked", 1;