Mercurial > pub > Impl
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;