--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/IMPL/Object/Abstract.pm	Fri Sep 04 19:40:23 2015 +0300
@@ -0,0 +1,189 @@
+package IMPL::Object::Abstract;
+use strict;
+use warnings;
+
+use parent qw(IMPL::Class::Meta);
+use Carp qw(croak);
+
+our $MemoryLeakProtection;
+my $Cleanup = 0;
+
+my %cacheCTOR;
+
+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_through_mapper{CODE}) {
+                push @sequence,@$superSequence;
+            } else {
+                push @sequence, sub {
+                    my $this = shift;
+                    $this->$_($mapper->(@_)) foreach @$superSequence;
+                } if @$superSequence;
+            }
+        } elsif ($mapper and not ref $mapper and $mapper eq '@_') {
+        	push @sequence,@$superSequence;
+        } else {
+            warn "Unsupported mapper type, in '$class' for the super class '$super'" if $mapper;
+            push @sequence, sub {
+                my $this = shift;
+                $this->$_() foreach @$superSequence;
+            } if @$superSequence;
+        }
+    }
+    
+    push @sequence, *{"${class}::CTOR"}{CODE} if *{"${class}::CTOR"}{CODE};
+    
+    $cacheCTOR{$class} = \@sequence;
+    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;
+
+    $self->$_(@_) foreach @{$cacheCTOR{$class} || cache_ctor($class)};
+}
+
+sub _init_dtor {
+	my ($class) = @_;
+	
+	no strict 'refs';
+	
+	# avoid warnings for classes without destructors 
+	no warnings 'once';
+	
+	my @dtors;
+	
+	my @hierarchy = ($class);
+	my %visited;
+	
+	while(my $subclass = shift @hierarchy) {
+		if(*{"${subclass}::DTOR"}{CODE}) {
+            push @dtors, *{"${subclass}::DTOR"}{CODE};
+		}
+		
+		push @hierarchy, @{"${subclass}::ISA"};
+	}
+	
+	if (@dtors) {
+	
+		return *{"${class}::callDTOR"} = sub {
+			my ($self) = @_; 
+			my $selfClass = ref $self;
+			if ($selfClass ne $class) {
+				goto &{$selfClass->_init_dtor()};
+			} else {
+	            map $_->($self), @dtors;			
+			}
+		}
+	
+	} else {
+		return *{"${class}::callDTOR"} = sub {
+            my $self = ref $_[0];
+            
+            goto &{$self->_init_dtor()} unless $self eq $class;
+		}
+	}
+}
+
+__PACKAGE__->_init_dtor();
+
+sub toString {
+    my $self = shift;
+    
+    return (ref $self || $self);
+}
+
+sub _typeof {
+    ref $_[0] || $_[0];
+}
+
+sub isDisposed {
+    0;
+}
+
+sub DESTROY {
+	shift->callDTOR();
+}
+
+sub END {
+    $Cleanup = 1;
+}
+
+sub _pass_through_mapper {
+    @_;
+}
+
+sub PassArgs {
+    \&_pass_through_mapper;
+}
+
+sub PassThroughArgs {
+    my $class = shift;
+    $class = ref $class || $class;
+    no strict 'refs';
+    no warnings 'once';
+    ${"${class}::CTOR"}{$_} = \&_pass_through_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,9;
+    no strict 'refs';
+    $sub = $_->can($methodName) and $sub->(@_) foreach @{caller().'::ISA'};
+}
+
+1;
+
+__END__
+
+=pod
+=head1 SYNOPSIS
+
+package MyBaseObject;
+use parent qw(IMPL::Object::Abstract);
+
+sub new {
+    # own implementation of the new opeator
+}
+
+sub surrogate {
+    # own implementation of the surrogate operator
+}
+
+=head1 DESCRIPTION
+
+Реализация механизма вызова конструкторов и других вспомогательных вещей, кроме операторов
+создания экземпляров.
+
+=cut