no
warnings
'redefine'
;
sub
AUTOLOAD
{
my
(
$GBL
,
@args
) =
@_
;
push
(@{
$$GBL
{
'export'
}},
'AUTOLOAD'
);
$$GBL
{
'init'
} = 1;
*Object::InsideOut::AUTOLOAD
=
sub
{
my
$thing
=
$_
[0];
my
(
$class
,
$method
) =
our
$AUTOLOAD
=~ /(.*)::(.*)/;
my
$super
;
if
(
$class
=~ /::SUPER$/) {
$class
=~ s/::SUPER//;
$super
= 1;
}
my
$heritage
=
$$GBL
{
'heritage'
};
my
$automethods
=
$$GBL
{
'sub'
}{
'auto'
};
my
(
$code_type
,
$code_dir
,
%code_refs
);
foreach
my
$pkg
(@{
$$GBL
{
'tree'
}{
'bu'
}{
$class
}}) {
if
(
$super
&&
$class
eq
$pkg
) {
next
;
}
if
(
exists
(
$$heritage
{
$pkg
})) {
my
$objects
=
$$heritage
{
$pkg
}{
'obj'
};
my
$classes
=
$$heritage
{
$pkg
}{
'cl'
};
if
(Scalar::Util::blessed(
$thing
)) {
if
(
exists
(
$$objects
{
$$thing
})) {
foreach
my
$obj
(@{
$$objects
{
$$thing
}}) {
if
(
my
$code
=
$obj
->can(
$method
)) {
shift
;
unshift
(
@_
,
$obj
);
goto
$code
;
}
}
}
else
{
foreach
my
$pkg
(
keys
(%{
$classes
})) {
if
(
my
$code
=
$pkg
->can(
$method
)) {
@_
=
@_
;
goto
$code
;
}
}
}
}
else
{
foreach
my
$pkg
(
keys
(%{
$classes
})) {
if
(
my
$code
=
$pkg
->can(
$method
)) {
shift
;
unshift
(
@_
,
$pkg
);
goto
$code
;
}
}
}
}
if
(
my
$automethod
=
$$automethods
{
$pkg
}) {
local
$CALLER::_
=
$_
;
local
$_
=
$method
;
local
$SIG
{
'__DIE__'
} =
'OIO::trap'
;
if
(
my
(
$code
,
$ctype
) =
$automethod
->(
@_
)) {
if
(
ref
(
$code
) ne
'CODE'
) {
delete
(
$$automethods
{
$pkg
});
OIO::Code->
die
(
'message'
=>
':Automethod did not return a code ref'
,
'Info'
=>
"NOTICE: The defective :Automethod in package '$pkg' has been DELETED!"
,
'Code'
=>
":Automethod in package '$pkg' invoked for method '$method'"
);
}
if
(
defined
(
$ctype
)) {
my
(
$type
,
$dir
) =
$ctype
=~ /(\w+)(?:[(]\s*(.*)\s*[)])?/;
if
(
$type
&&
$type
=~ /CUM/i) {
if
(
$code_type
) {
$type
=
':Cumulative'
;
$dir
= (
$dir
&&
$dir
=~ /BOT/i) ?
'bottom up'
:
'top down'
;
if
(
$code_type
ne
$type
||
$code_dir
ne
$dir
) {
my
(
$pkg2
) =
keys
(
%code_refs
);
OIO::Code->
die
(
'message'
=>
'Inconsistent code types returned by :Automethods'
,
'Info'
=>
"Class '$pkg' returned type $type($dir), and class '$pkg2' returned type $code_type($code_dir)"
);
}
}
else
{
$code_type
=
':Cumulative'
;
$code_dir
= (
$dir
&&
$dir
=~ /BOT/i) ?
'bottom up'
:
'top down'
;
}
$code_refs
{
$pkg
} =
$code
;
next
;
}
if
(
$type
&&
$type
=~ /CHA/i) {
if
(
$code_type
) {
$type
=
':Chained'
;
$dir
= (
$dir
&&
$dir
=~ /BOT/i) ?
'bottom up'
:
'top down'
;
if
(
$code_type
ne
$type
||
$code_dir
ne
$dir
) {
my
(
$pkg2
) =
keys
(
%code_refs
);
OIO::Code->
die
(
'message'
=>
'Inconsistent code types returned by :Automethods'
,
'Info'
=>
"Class '$pkg' returned type $type($dir), and class '$pkg2' returned type $code_type($code_dir)"
);
}
}
else
{
$code_type
=
':Chained'
;
$code_dir
= (
$dir
&&
$dir
=~ /BOT/i) ?
'bottom up'
:
'top down'
;
}
$code_refs
{
$pkg
} =
$code
;
next
;
}
OIO::Code->
die
(
'message'
=>
"Unknown :Automethod code type: $ctype"
,
'Info'
=>
":Automethod in package '$pkg' invoked for method '$method'"
);
}
if
(
$code_type
) {
my
(
$pkg2
) =
keys
(
%code_refs
);
OIO::Code->
die
(
'message'
=>
'Inconsistent code types returned by :Automethods'
,
'Info'
=>
"Class '$pkg' returned an 'execute immediately' type, and class '$pkg2' returned type $code_type($code_dir)"
);
}
@_
=
@_
;
goto
$code
;
}
}
}
if
(
$code_type
) {
my
$tree
= (
$code_dir
eq
'bottom up'
) ?
$$GBL
{
'tree'
}{
'bu'
} :
$$GBL
{
'tree'
}{
'td'
};
my
$code
= (
$code_type
eq
':Cumulative'
)
? create_CUMULATIVE(
$method
,
$tree
, \
%code_refs
)
: create_CHAINED(
$method
,
$tree
, \
%code_refs
);
@_
=
@_
;
goto
$code
;
}
my
$type
=
ref
(
$thing
) ?
'object'
:
'class'
;
OIO::Method->
die
(
'message'
=>
qq/Can't locate $type method "$method" via package "$class"/
);
};
@_
=
@args
;
goto
&Object::InsideOut::AUTOLOAD
;
}
}
(
$Object::InsideOut::VERSION
== 3.34)
or
die
(
"Version mismatch\n"
);