diff Lib/IMPL/Object.pm @ 2:78cd38551534

in develop
author Sergey
date Mon, 10 Aug 2009 17:39:08 +0400
parents 03e58a454b20
children e59f44f75f20
line wrap: on
line diff
--- a/Lib/IMPL/Object.pm	Fri Jul 17 13:30:46 2009 +0400
+++ b/Lib/IMPL/Object.pm	Mon Aug 10 17:39:08 2009 +0400
@@ -1,123 +1,18 @@
 package IMPL::Object;
 use strict;
 
-use base qw(IMPL::Class::Meta);
-
-our $MemoryLeakProtection;
-my $Cleanup = 0;
-our $Debug;
-our %leaked_objects;
-
-my %cacheCTOR;
-
-
-sub new {
-    my $class = shift;
-    my $self = bless {}, ref($class) || $class;
-    
-    $self->$_(@_) foreach @{$cacheCTOR{ref $self} || cache_ctor(ref $self)};
-  
-    $self;
-}
-my $t = 0;
-sub cache_ctor {
-    my $class = shift;
-    
-    no strict 'refs';
-    my @sequence;
-    
-    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;
-	    };
-	}
-    }
-    
-    push @sequence, *{"${class}::CTOR"}{CODE} if *{"${class}::CTOR"}{CODE};
-    
-    $cacheCTOR{$class} = \@sequence;
-    return \@sequence;
-}
-
-sub callCTOR {
-    my $self = shift;
-    my $class = ref $self;
-
-    $self->$_(@_) foreach @{$cacheCTOR{$class} || cache_ctor($class)};
-}
+use base qw(IMPL::Object::Abstract);
 
 sub surrogate {
     bless {}, ref $_[0] || $_[0];
 }
 
-sub superCTOR {
-    my $this = shift;
-
-    warn "The mehod is deprecated, at " . caller;
-}
-
-sub toString {
-    my $self = shift;
-    
-    return (ref $self || $self);
-}
-
-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 END {
-    $Cleanup = 1;
-    $MemoryLeakProtection = 0 unless $Debug;
-}
-
-sub _pass_throgh_mapper {
-    @_;
-}
-
-sub PassThroughArgs {
+sub new {
     my $class = shift;
-    $class = ref $class || $class;
-    no strict 'refs';
-    no warnings 'once';
-    ${"${class}::CTOR"}{$_} = \&_pass_throgh_mapper foreach @{"${class}::ISA"};
-}
-
-package self;
-
-our $AUTOLOAD;
-sub AUTOLOAD {
-    goto &{caller(). substr $AUTOLOAD,4};
-}
-
-package supercall;
-
-our $AUTOLOAD;
-sub AUTOLOAD {
-    my $sub;
-    my $methodName = substr $AUTOLOAD,11;
-    no strict 'refs';
-    $sub = $_->can($methodName) and $sub->(@_) foreach @{caller().'::ISA'};
+    my $self = bless {}, ref($class) || $class;    
+    $self->callCTOR(@_);
+  
+    $self;
 }
 
 =pod
@@ -173,15 +68,32 @@
 #
 # Foo: Mazzi
 # Bar: Fugi
-# Foo:
 # Bar:
 # Composite: Hello World!
 
 =h1 Description
-Базовый класс для объектов. Реализует множественное наследование
-
+Базовый класс для объектов, основанных на хеше.
 
 =h1 Members
+
+=level 4
+
+=item operator C<new>(@args)
+
+Создает экземпляр объекта и вызывает конструктор с параметрами @args.
+
+=item operator C<surrogate>()
+
+Создает неинициализированный экземпляр объекта.
+
+=back
+
+=р1 Cavearts
+
+Нужно заметить, что директива C<use base> работает не совсем прозрачно, если в нашем примере
+класс C<Composite> наследуется от C<Baz>, а затем C<Foo>, то наследование от
+C<Foo> не произойдет поскольку он уже имеется в C<Baz>. Вот не задача:)
+
 =cut
 
 1;
\ No newline at end of file