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

use parent 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_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 toString {
    my $self = shift;
    
    return (ref $self || $self);
}

sub typeof {
    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_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,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 parent qw(IMPL::Object::Abstract);

sub new {
    # own implementation of the new opeator
}

sub surrogate {
    # own implementation of the surrogate operator
}

=head1 DESCRIPTION

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