#!/usr/bin/perl
use strict;
use v5.10;
use Carp;
use Time::HiRes qw(gettimeofday tv_interval);
use Scalar::Util qw(blessed refaddr);
use YAML::XS qw(Dump Load);
use Data::Dumper;
use URI;

#my $method = _get_ctor("Box", undef, '@_');

_invoke_ctor("main","x","y","z");
_invoke_ctor("main","x","y","z");

sub _invoke_ctor {
	my ($self) = @_;
	no strict 'refs';
	no warnings 'redefine';
	
	my $method = _get_ctor("Box", undef, '@_');
	
	*{"${self}::_invoke_ctor"} = $method;
	
	goto &$method;
}

sub _get_ctor {
	my ($class, $prev, $t) = @_;
	no strict 'refs';
	
	#say "_get_ctor($class, $prev, $t)";
	
	my $isolate = ((not defined($t)) or ($t ne '@_'));  
	
	my $ctor = $isolate ? *{"${class}::CTOR"}{CODE} : _chain_call(*{"${class}::CTOR"}{CODE}, $prev); 
	
	foreach my $base (@{"${class}::ISA"}) {
		$ctor = _get_ctor($base, $ctor, exists ${"${class}::ISA"}{$base} ? ${"${class}::ISA"}{$base} : '@_');
	}
	
	if ($isolate) {
		$ctor = _chain_call(_chain_params($ctor, $t), $prev);
	}
	
	return $ctor;
}

sub _chain_call {
	my ($method, $next) = @_;
	
	return $method unless $next;
	return $next unless $method;
	
	return sub { &$method(@_); goto &$next; }
}

sub _chain_params {
	my ($method, $prepare) = @_;
	
	return unless $method;
	
	if (not defined $prepare) {
		return sub { @_ = (shift); goto &$method };
	} elsif ($prepare eq '@_') {
		return $method;
	} elsif (ref $prepare eq 'CODE') {
		return sub {
			@_ = (shift, &$prepare(@_));
			goto &$method;
		}
	}
}

package Obj;

sub CTOR {
	say "Obj ", join (',', @_);
	say Carp::longmess();
}

package Foo;

BEGIN {
	our @ISA = qw(Obj);
	our %ISA = (
		Obj => sub { "hi" }
	);
}

sub CTOR {
	say "Foo ", join (',', @_);
}

package Bar;

BEGIN {
	our @ISA = qw(Foo);
	our %ISA = (
		Foo => undef
	);
}

sub CTOR {
	say "Bar ", join(',', @_);
}

package Baz;

sub CTOR {
	say "Baz ", join(',', @_);
}

package Box;

BEGIN {
	our @ISA = qw(Bar Baz);
	our %ISA = (
		Bar => sub { shift . "~Box->Bar", @_; },
		Baz => sub { shift . "~Box->Baz", @_; }
	);
}

sub CTOR {
	say "Box ", join(',', @_);
}

1;