]> git.donarmstrong.com Git - class_modular.git/.git/commitdiff
* Added DESTROY method to call subclasses _destroy methods
authorDon Armstrong <don@donarmstrong.com>
Sat, 13 Sep 2003 05:46:53 +0000 (05:46 +0000)
committerDon Armstrong <don@donarmstrong.com>
Sat, 13 Sep 2003 05:46:53 +0000 (05:46 +0000)
git-svn-id: file:///srv/don_svn/class_modular/trunk@3 96c6a18b-02ce-0310-9fca-9eb62c757ba6

Class/Modular/Modular.pm

index 1e1a8ab99d5e88b282a9516a8c0268eaaf9a77cb..58025bfe66a820416bb25b728ab077eb30f88154 100644 (file)
@@ -2,7 +2,7 @@
 # under the terms of the GPL version 2, or any later version. See the
 # file README and COPYING for more information. Copyright 2003 by Don
 # Armstrong <don@donarmstrong.com>.
-# $Id: Modular.pm,v 1.2 2003/09/08 12:05:49 don Exp $
+# $Id: Modular.pm,v 1.3 2003/09/13 05:46:53 don Exp $
 
 package Class::Modular;
 
@@ -55,7 +55,7 @@ use Carp;
 use Data::Copy qw(deep_copy); # Used for deep copying objects
 
 BEGIN{
-     ($VERSION) = q$Revision: 1.2 $ =~ /\$Revision:\s+([^\s+])/;
+     ($VERSION) = q$Revision: 1.3 $ =~ /\$Revision:\s+([^\s+])/;
      $DEBUG = 0 unless defined $DEBUG;
 }
 
@@ -245,6 +245,40 @@ sub clone {
 }
 
 
+=head2 DESTROY
+
+=head3 Usage
+
+Called by perl.
+
+=head3 Function
+
+Calls all subclass _destroy methods.
+
+Subclasses need only implement a _destroy method if they have
+references that need to be uncircularized, or things that should be
+disconnected or closed.
+
+=cut
+
+sub DESTROY{
+     my $self = shift;
+     foreach my $subclass (keys %{$self->{_subclasses}}) {
+         # use eval to try and call the subclasses _destroy method.
+         # Ignore no such function errors, but trap other types of
+         # errors.
+         eval {
+              no strict refs;
+              &$subclass::_destroy($self,$clone);
+         };
+         if ($@) {
+              # Die unless we've hit an undefined subroutine.
+              die $@ unless $@ =~ /Undefined\s*subroutine\s*\&.*\:\:\_clone/;
+              warn "$subclass doesn't have a _clone method\n$@" if $DEBUG;
+         }
+     }
+}
+
 
 =head2 AUTOLOAD