Cursor abstracted, delete_related added

diff --git a/lib/DBIx/Class/Cursor.pm b/lib/DBIx/Class/Cursor.pm
index 3cd5505..5d935c7 100644 (file)
--- a/lib/DBIx/Class/Cursor.pm
+++ b/lib/DBIx/Class/Cursor.pm
@@ -4,44 +4,15 @@ use strict;
 use warnings;
 
 sub new {
-  my ($it_class, $sth, $args, $attrs) = @_;
-  #use Data::Dumper; warn Dumper(@_);
-  $it_class = ref $it_class if ref $it_class;
-  my $new = {
-    sth => $sth,
-    args => $args,
-    pos => 0,
-    attrs => $attrs };
-  return bless ($new, $it_class);
+  die "Virtual method!";
 }
 
 sub next {
-  my ($self) = @_;
-  return if $self->{attrs}{rows}
-    && $self->{pos} >= $self->{attrs}{rows}; # + $self->{attrs}{offset});
-  unless ($self->{live_sth}) {
-    $self->{sth}->execute(@{$self->{args} || []});
-    if (my $offset = $self->{attrs}{offset}) {
-      $self->{sth}->fetch for 1 .. $offset;
-    }
-    $self->{live_sth} = 1;
-  }
-  my @row = $self->{sth}->fetchrow_array;
-  $self->{pos}++ if @row;
-  return @row;
+  die "Virtual method!";
 }
 
 sub reset {
-  my ($self) = @_;
-  $self->{sth}->finish if $self->{sth}->{Active};
-  $self->{pos} = 0;
-  $self->{live_sth} = 0;
-  return $self;
-}
-
-sub DESTROY {
-  my ($self) = @_;
-  $self->{sth}->finish if $self->{sth}->{Active};
+  die "Virtual method!";
 }
 
 1;

diff --git a/lib/DBIx/Class/Relationship.pm b/lib/DBIx/Class/Relationship.pm
index 10807dd..1220686 100644 (file)
--- a/lib/DBIx/Class/Relationship.pm
+++ b/lib/DBIx/Class/Relationship.pm
@@ -196,6 +196,11 @@ sub update_from_related {
   $self->update;
 }
 
+sub delete_related {
+  my $self = shift;
+  return $self->search_related(@_)->delete;
+}
+
 1;
 
 =back

diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm
index eb05a62..68317a3 100644 (file)
--- a/lib/DBIx/Class/ResultSet.pm
+++ b/lib/DBIx/Class/ResultSet.pm
@@ -71,10 +71,12 @@ sub first {
   return $_[0]->reset->next;
 }
 
-sub delete_all {
+sub delete {
   my ($self) = @_;
   $_->delete for $self->all;
   return 1;
 }
 
+*delete_all = \&delete; # Yeah, yeah, yeah ...
+
 1;

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index c0b4d82..a334a19 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 use DBI;
 use SQL::Abstract;
-use DBIx::Class::Cursor;
+use DBIx::Class::Storage::DBI::Cursor;
 
 use base qw/DBIx::Class/;
 
@@ -16,8 +16,8 @@ __PACKAGE__->mk_group_accessors('simple' =>
 sub new {
   my $new = bless({}, ref $_[0] || $_[0]);
   $new->sql_maker(new SQL::Abstract);
-  $new->cursor("DBIx::Class::Cursor");
-  #$new->debug(1);
+  $new->cursor("DBIx::Class::Storage::DBI::Cursor");
+  $new->debug(1) if $ENV{DBIX_CLASS_STORAGE_DBI_DEBUG};
   return $new;
 }
 

diff --git a/lib/DBIx/Class/Storage/DBI/Cursor.pm b/lib/DBIx/Class/Storage/DBI/Cursor.pm
new file mode 100644 (file)
index 0000000..87b0267
--- /dev/null
+++ b/lib/DBIx/Class/Storage/DBI/Cursor.pm
@@ -0,0 +1,49 @@
+package DBIx::Class::Storage::DBI::Cursor;
+
+use base qw/DBIx::Class::Cursor/;
+
+use strict;
+use warnings;
+
+sub new {
+  my ($it_class, $sth, $args, $attrs) = @_;
+  #use Data::Dumper; warn Dumper(@_);
+  $it_class = ref $it_class if ref $it_class;
+  my $new = {
+    sth => $sth,
+    args => $args,
+    pos => 0,
+    attrs => $attrs };
+  return bless ($new, $it_class);
+}
+
+sub next {
+  my ($self) = @_;
+  return if $self->{attrs}{rows}
+    && $self->{pos} >= $self->{attrs}{rows}; # + $self->{attrs}{offset});
+  unless ($self->{live_sth}) {
+    $self->{sth}->execute(@{$self->{args} || []});
+    if (my $offset = $self->{attrs}{offset}) {
+      $self->{sth}->fetch for 1 .. $offset;
+    }
+    $self->{live_sth} = 1;
+  }
+  my @row = $self->{sth}->fetchrow_array;
+  $self->{pos}++ if @row;
+  return @row;
+}
+
+sub reset {
+  my ($self) = @_;
+  $self->{sth}->finish if $self->{sth}->{Active};
+  $self->{pos} = 0;
+  $self->{live_sth} = 0;
+  return $self;
+}
+
+sub DESTROY {
+  my ($self) = @_;
+  $self->{sth}->finish if $self->{sth}->{Active};
+}
+
+1;

diff --git a/t/06relationship.t b/t/06relationship.t
index 7c4984e..ec6b3aa 100644 (file)
--- a/t/06relationship.t
+++ b/t/06relationship.t
@@ -63,11 +63,10 @@ is( $cd->title, 'Greatest Hits', 'find_or_create_related new record ok' );
 is( ($artist->search_related('cds'))[4]->title, 'Greatest Hits', 'find_or_create_related new record search ok' );
 
 SKIP: {
-    skip 'Need to add delete_related', 1;
+    #skip 'Need to add delete_related', 1;
     # delete_related
-    ($cd) = DBICTest::CD->search( title => 'Greatest Hits' );
-    $artist->delete_related( cds => $cd );
-    is( DBICTest::CD->search( title => 'Greatest Hits' ), undef, 'delete_related ok' );
+    $artist->delete_related( cds => { title => 'Greatest Hits' });
+    cmp_ok( DBICTest::CD->search( title => 'Greatest Hits' ), '==', 0, 'delete_related ok' );
 };
 
 # try to add a bogus relationship using the wrong cols