use
warnings
qw(FATAL all NONFATAL misc)
;
our
@EXPORT
=
qw/import _import_as_base/
;
our
@EXPORT_OK
=
@EXPORT
;
use
constant
DEBUG_IMPORT
=>
$ENV
{DEBUG_YATT_IMPORT} // 0;
sub
import
{
Carp::carp(
scalar
caller
,
" calls $_[0]->import()"
)
if
DEBUG_IMPORT;
parse_args(\
@_
,
scalar
caller
);
goto
&Exporter::import
;
}
sub
parse_args ($$) {
my
(
$arglist
,
$callpack
) =
@_
;
return
unless
$arglist
and
@$arglist
and
defined
(
my
$target
=
$arglist
->[0]);
$callpack
//=
caller
(1);
while
(
$arglist
and
@$arglist
>= 2
and
defined
$arglist
->[1]
and
$arglist
->[1] =~ /^-(.+)/) {
splice
@$arglist
, 1, 1;
my
$sub
=
$target
->can(
'_import_'
. $1)
or carp
"Unknown flag $1 for target class $target"
;
$sub
->(
$target
,
$callpack
);
}
}
sub
_import_as_base {
my
(
$myPack
,
$callpack
) =
@_
;
{
my
$sym
= globref(
$callpack
,
'ISA'
);
my
$isa
;
unless
(
$isa
= *{
$sym
}{ARRAY}) {
*$sym
=
$isa
= [];
}
mro::set_mro(
$callpack
,
'c3'
);
unless
(
grep
{
$_
eq
$myPack
}
@$isa
) {
unshift
@$isa
,
$myPack
;
}
}
YATT::Lite::MFields->define_fields(
$callpack
);
my
$sym
= globref(
$callpack
,
'MY'
);
YATT::Lite::Util::define_const(
$sym
,
$callpack
)
unless
*{
$sym
}{CODE};
}
1;