diff Lib/IMPL/Object/Abstract.pm @ 273:ad93c9f4dd93

+Added support for destructors, (special method named DTOR)
author sergey
date Tue, 29 Jan 2013 17:19:10 +0400
parents 6b1dda998839
children 8a5da17d7ef9
line wrap: on
line diff
--- a/Lib/IMPL/Object/Abstract.pm	Mon Jan 28 17:24:37 2013 +0400
+++ b/Lib/IMPL/Object/Abstract.pm	Tue Jan 29 17:19:10 2013 +0400
@@ -63,6 +63,50 @@
     $self->$_(@_) foreach @{$cacheCTOR{$class} || cache_ctor($class)};
 }
 
+sub _init_dtor {
+	my ($class) = @_;
+	
+	no strict 'refs';
+	
+	# avoid warnings for classes without destructors 
+	no warnings 'once';
+	
+	my @dtors;
+	
+	my @hierarchy = ($class);
+	my %visited;
+	
+	while(my $subclass = shift @hierarchy) {
+		if(*{"${subclass}::DTOR"}{CODE}) {
+            push @dtors, *{"${subclass}::DTOR"}{CODE};
+		}
+		
+		push @hierarchy, @{"${subclass}::ISA"};
+	}
+	
+	if (@dtors) {
+	
+		return *{"${class}::callDTOR"} = sub {
+			my ($self) = @_; 
+			my $selfClass = ref $self;
+			if ($selfClass ne $class) {
+				goto &{$selfClass->_init_dtor()};
+			} else {
+	            map $_->($self), @dtors;			
+			}
+		}
+	
+	} else {
+		return *{"${class}::callDTOR"} = sub {
+            my $self = ref $_[0];
+            
+            goto &{$self->_init_dtor()} unless $self eq $class;
+		}
+	}
+}
+
+__PACKAGE__->_init_dtor();
+
 sub toString {
     my $self = shift;
     
@@ -77,12 +121,9 @@
     0;
 }
 
-#sub DESTROY {
-#    if ($MemoryLeakProtection and $Cleanup) {
-#        my $this = shift;
-#        warn sprintf("Object leaks: %s of type %s %s",$this->can('ToString') ? $this->ToString : $this,ref $this,UNIVERSAL::can($this,'_dump') ? $this->_dump : '');
-#    }
-#}
+sub DESTROY {
+	shift->callDTOR();
+}
 
 sub END {
     $Cleanup = 1;