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

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 {
    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'};
}

=pod
=h1 SYNOPSIS

package Foo;
use base qw(IMPL::Object);

sub CTOR {
    my ($this,$arg) = @_;
    print "Foo: $arg\n";
}

package Bar;
use base qw(IMPL::Object);

sub CTOR {
    my ($this,$arg) = @_;
    print "Bar: $arg\n";
}

package Baz;
use base qw(Foo Bar);

our %CTOR = (
    Foo => sub { my %args = @_; $args{Mazzi}; },
    Bar => sub { my %args = @_; $args{Fugi}; }
);

package Composite;
use base qw(Baz Foo Bar);

our %CTOR = (
    Foo => undef,
    Bar => undef
);

sub CTOR {
    my ($this,%args) = @_;
    
    print "Composite: $args{Text}\n";
}

package main;

my $obj = new Composite(
    Text => 'Hello World!',
    Mazzi => 'Mazzi',
    Fugi => 'Fugi'
);

# will print
#
# Foo: Mazzi
# Bar: Fugi
# Foo:
# Bar:
# Composite: Hello World!

=h1 Description
Áàçîâûé êëàññ äëÿ îáúåêòîâ. Ðåàëèçóåò ìíîæåñòâåííîå íàñëåäîâàíèå


=h1 Members
=cut

1;