Mercurial > pub > Impl

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
+Added support for destructors, (special method named DTOR)
author sergey
date Tue, 29 Jan 2013 17:19:10 +0400
parents 6b1dda998839
children 8a5da17d7ef9
comparison
equal deleted inserted replaced
272:47db27ed5b43 273:ad93c9f4dd93
61 my $class = ref $self; 61 my $class = ref $self;
62 62
63 $self->$_(@_) foreach @{$cacheCTOR{$class} || cache_ctor($class)}; 63 $self->$_(@_) foreach @{$cacheCTOR{$class} || cache_ctor($class)};
64 } 64 }
65 65
66 sub _init_dtor {
67 my ($class) = @_;
68
69 no strict 'refs';
70
71 # avoid warnings for classes without destructors
72 no warnings 'once';
73
74 my @dtors;
75
76 my @hierarchy = ($class);
77 my %visited;
78
79 while(my $subclass = shift @hierarchy) {
80 if(*{"${subclass}::DTOR"}{CODE}) {
81 push @dtors, *{"${subclass}::DTOR"}{CODE};
82 }
83
84 push @hierarchy, @{"${subclass}::ISA"};
85 }
86
87 if (@dtors) {
88
89 return *{"${class}::callDTOR"} = sub {
90 my ($self) = @_;
91 my $selfClass = ref $self;
92 if ($selfClass ne $class) {
93 goto &{$selfClass->_init_dtor()};
94 } else {
95 map $_->($self), @dtors;
96 }
97 }
98
99 } else {
100 return *{"${class}::callDTOR"} = sub {
101 my $self = ref $_[0];
102
103 goto &{$self->_init_dtor()} unless $self eq $class;
104 }
105 }
106 }
107
108 __PACKAGE__->_init_dtor();
109
66 sub toString { 110 sub toString {
67 my $self = shift; 111 my $self = shift;
68 112
69 return (ref $self || $self); 113 return (ref $self || $self);
70 } 114 }
75 119
76 sub isDisposed { 120 sub isDisposed {
77 0; 121 0;
78 } 122 }
79 123
80 #sub DESTROY { 124 sub DESTROY {
81 # if ($MemoryLeakProtection and $Cleanup) { 125 shift->callDTOR();
82 # my $this = shift; 126 }
83 # warn sprintf("Object leaks: %s of type %s %s",$this->can('ToString') ? $this->ToString : $this,ref $this,UNIVERSAL::can($this,'_dump') ? $this->_dump : '');
84 # }
85 #}
86 127
87 sub END { 128 sub END {
88 $Cleanup = 1; 129 $Cleanup = 1;
89 } 130 }
90 131