X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FCDBICompat%2FHasMany.pm;h=ece8e2b2aeb40ee285c63991195ee2af15a420b8;hb=4a07648ace2ace5b878c63aec52b7a30c1432b4d;hp=4bf34493041a37f0cced5755e6009bc0cdea0bd5;hpb=95a70f01eae4b2c325a3a527a72cf8ae91796e8c;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/CDBICompat/HasMany.pm b/lib/DBIx/Class/CDBICompat/HasMany.pm
index 4bf3449..ece8e2b 100644
--- a/lib/DBIx/Class/CDBICompat/HasMany.pm
+++ b/lib/DBIx/Class/CDBICompat/HasMany.pm
@@ -14,7 +14,7 @@ sub has_many {
 
   if (!$self_key || $self_key eq 'id') {
     my ($pri, $too_many) = keys %{ $class->_primaries };
-    die "has_many only works with a single primary key; ${class} has more"
+    $class->throw( "has_many only works with a single primary key; ${class} has more" )
       if $too_many;
     $self_key = $pri;
   }
@@ -35,38 +35,18 @@ sub has_many {
     $f_key = lc $1 if $f_class->_columns->{lc $1};
   }
 
-  die "Unable to resolve foreign key for has_many from ${class} to ${f_class}"
+  $class->throw( "Unable to resolve foreign key for has_many from ${class} to ${f_class}" )
     unless $f_key;
-  die "No such column ${f_key} on foreign class ${f_class}"
+  $class->throw( "No such column ${f_key} on foreign class ${f_class}" )
     unless $f_class->_columns->{$f_key};
+  $args ||= {};
+  my $cascade = not (ref $args eq 'HAS' && delete $args->{no_cascade_delete});
   $class->add_relationship($rel, $f_class,
                             { "foreign.${f_key}" => "self.${self_key}" },
-                            { _type => 'has_many', %{$args || {}} } );
-  {
-    no strict 'refs';
-    *{"${class}::${rel}"} = sub { shift->search_related($rel, @_); };
-    *{"${class}::add_to_${rel}"} = sub { shift->create_related($rel, @_); };
-  }
+                            { accessor => 'multi',
+                              ($cascade ? ('cascade_delete' => 1) : ()),
+                              %$args } );
   return 1;
 }
 
-sub delete {
-  my ($self, @rest) = @_;
-  return $self->NEXT::ACTUAL::delete(@rest) unless ref $self;
-    # I'm just ignoring this for class deletes because hell, the db should
-    # be handling this anyway. Assuming we have joins we probably actually
-    # *could* do them, but I'd rather not.
-
-  my $ret = $self->NEXT::ACTUAL::delete(@rest);
-
-  my %rels = %{ $self->_relationships };
-  my @hm = grep { $rels{$_}{attrs}{_type}
-                   && $rels{$_}{attrs}{_type} eq 'has_many' } keys %rels;
-  foreach my $has_many (@hm) {
-    unless ($rels{$has_many}->{attrs}{no_cascade_delete}) {
-      $_->delete for $self->search_related($has_many)
-    }
-  }
-  return $ret;
-}
 1;