package IMPL::Object::Abstract;
use strict;
use warnings;

use base qw(IMPL::Class::Meta);

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_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 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 superCTOR {
    my $this = shift;

    warn "The mehod is deprecated, at " . caller;
}

sub toString {
    my $self = shift;
    
    return (ref $self || $self);
}

sub type {
	ref $_[0] || $_[0];
}

sub isDisposed {
    0;
}

#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;
}

sub _pass_throgh_mapper {
    @_;
}

sub PassArgs {
    \&_pass_throgh_mapper;
}

sub PassThroughArgs {
    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,6};
}

package supercall;

our $AUTOLOAD;
sub AUTOLOAD {
    my $sub;
    my $methodName = substr $AUTOLOAD,11;
    no strict 'refs';
    $sub = $_->can($methodName) and $sub->(@_) foreach @{caller().'::ISA'};
}

1;

__END__

=pod
=head1 SYNOPSIS

package MyBaseObject;
use base qw(IMPL::Object::Abstract);

sub new {
    # own implementation of the new opeator
}

sub surrogate {
    # own implementation of the surrogate operator
}

=head1 DESCRIPTION

Реализация механизма вызова конструкторов и других вспомогательных вещей, кроме операторов
создания экземпляров.
=cut