Mercurial > pub > Impl
diff Lib/IMPL/Object/Abstract.pm @ 90:dc1da0389db7
Small improvements in the abstract object class
Added support for a class data, documentation
Additional tests for the new functionality
author | wizard |
---|---|
date | Mon, 26 Apr 2010 03:10:03 +0400 |
parents | 76b878ad6596 |
children | 0667064553ef |
line wrap: on
line diff
--- a/Lib/IMPL/Object/Abstract.pm Wed Apr 21 17:39:45 2010 +0400 +++ b/Lib/IMPL/Object/Abstract.pm Mon Apr 26 03:10:03 2010 +0400 @@ -19,25 +19,25 @@ my $refCTORS = *{"${class}::CTOR"}{HASH}; foreach my $super ( @{"${class}::ISA"} ) { - my $superSequence = $cacheCTOR{$super} || cache_ctor($super); - - my $mapper = $refCTORS ? $refCTORS->{$super} : undef; - if (ref $mapper eq 'CODE') { - if ($mapper == *_pass_throgh_mapper{CODE}) { - push @sequence,@$superSequence; - } else { - push @sequence, sub { - my $this = shift; - $this->$_($mapper->(@_)) foreach @$superSequence; - }; - } - } else { - warn "Unsupported mapper type, in '$class' for the super class '$super'" if $mapper; - push @sequence, sub { - my $this = shift; - $this->$_() foreach @$superSequence; - }; - } + my $superSequence = $cacheCTOR{$super} || cache_ctor($super); + + my $mapper = $refCTORS ? $refCTORS->{$super} : undef; + if (ref $mapper eq 'CODE') { + if ($mapper == *_pass_throgh_mapper{CODE}) { + push @sequence,@$superSequence; + } else { + push @sequence, sub { + my $this = shift; + $this->$_($mapper->(@_)) foreach @$superSequence; + }; + } + } else { + warn "Unsupported mapper type, in '$class' for the super class '$super'" if $mapper; + push @sequence, sub { + my $this = shift; + $this->$_() foreach @$superSequence; + }; + } } push @sequence, *{"${class}::CTOR"}{CODE} if *{"${class}::CTOR"}{CODE}; @@ -46,6 +46,14 @@ return \@sequence; } +sub dump_ctor { + my ($self) = @_; + $self = ref $self || $self; + + warn "dumping $self .ctor"; + warn "$_" foreach @{$cacheCTOR{$self}||[]}; +} + sub callCTOR { my $self = shift; my $class = ref $self;