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;