Mercurial > pub > Impl

comparison Lib/IMPL/Object/Abstract.pm @ 90:dc1da0389db7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
89:3d1f584aea60 90:dc1da0389db7
17 my @sequence; 17 my @sequence;
18 18
19 my $refCTORS = *{"${class}::CTOR"}{HASH}; 19 my $refCTORS = *{"${class}::CTOR"}{HASH};
20 20
21 foreach my $super ( @{"${class}::ISA"} ) { 21 foreach my $super ( @{"${class}::ISA"} ) {
22 my $superSequence = $cacheCTOR{$super} || cache_ctor($super); 22 my $superSequence = $cacheCTOR{$super} || cache_ctor($super);
23 23
24 my $mapper = $refCTORS ? $refCTORS->{$super} : undef; 24 my $mapper = $refCTORS ? $refCTORS->{$super} : undef;
25 if (ref $mapper eq 'CODE') { 25 if (ref $mapper eq 'CODE') {
26 if ($mapper == *_pass_throgh_mapper{CODE}) { 26 if ($mapper == *_pass_throgh_mapper{CODE}) {
27 push @sequence,@$superSequence; 27 push @sequence,@$superSequence;
28 } else { 28 } else {
29 push @sequence, sub { 29 push @sequence, sub {
30 my $this = shift; 30 my $this = shift;
31 $this->$_($mapper->(@_)) foreach @$superSequence; 31 $this->$_($mapper->(@_)) foreach @$superSequence;
32 }; 32 };
33 } 33 }
34 } else { 34 } else {
35 warn "Unsupported mapper type, in '$class' for the super class '$super'" if $mapper; 35 warn "Unsupported mapper type, in '$class' for the super class '$super'" if $mapper;
36 push @sequence, sub { 36 push @sequence, sub {
37 my $this = shift; 37 my $this = shift;
38 $this->$_() foreach @$superSequence; 38 $this->$_() foreach @$superSequence;
39 }; 39 };
40 } 40 }
41 } 41 }
42 42
43 push @sequence, *{"${class}::CTOR"}{CODE} if *{"${class}::CTOR"}{CODE}; 43 push @sequence, *{"${class}::CTOR"}{CODE} if *{"${class}::CTOR"}{CODE};
44 44
45 $cacheCTOR{$class} = \@sequence; 45 $cacheCTOR{$class} = \@sequence;
46 return \@sequence; 46 return \@sequence;
47 }
48
49 sub dump_ctor {
50 my ($self) = @_;
51 $self = ref $self || $self;
52
53 warn "dumping $self .ctor";
54 warn "$_" foreach @{$cacheCTOR{$self}||[]};
47 } 55 }
48 56
49 sub callCTOR { 57 sub callCTOR {
50 my $self = shift; 58 my $self = shift;
51 my $class = ref $self; 59 my $class = ref $self;