use
vars
qw{$VERSION $ISCORE}
;
BEGIN {
$VERSION
=
'0.88'
;
$ISCORE
= 1;
*inc::Module::Install::DSL::VERSION
=
*VERSION
;
@inc::Module::Install::DSL::ISA
= __PACKAGE__;
}
sub
import
{
open
0 or
die
"Couldn't open $0: $!"
;
my
$dsl
;
SCOPE: {
local
$/ =
undef
;
$dsl
=
join
""
, <0>;
}
$dsl
=~ s/.*?^\s
*use
\s+(?:inc::)?Module::Install::DSL(\b[^;]*);\s*\n//sm;
SCOPE: {
inc::Module::Install->
import
;
}
my
$admin
=
$Module::Install::MAIN
->{admin};
if
(
$admin
) {
my
$from
=
$INC
{
"$admin->{path}/DSL.pm"
};
my
$to
=
"$admin->{base}/$admin->{prefix}/$admin->{path}/DSL.pm"
;
$admin
->copy(
$from
=>
$to
);
}
my
$code
=
"package main;\n\n"
. dsl2code(
$dsl
)
.
"\n\nWriteAll();\n"
;
eval
$code
;
print
STDERR
"Failed to execute the generated code"
if
$@;
exit
(0);
}
sub
dsl2code {
my
$dsl
=
shift
;
my
@lines
=
grep
{ /\S/ }
split
/[\012\015]+/,
$dsl
;
my
@code
= ();
foreach
my
$line
(
@lines
) {
my
@tokens
=
split
/\s+/,
$line
;
my
$command
=
shift
@tokens
;
my
@params
= ();
my
@suffix
= ();
while
(
@tokens
) {
my
$token
=
shift
@tokens
;
if
(
$token
eq
'if'
or
$token
eq
'unless'
) {
push
@suffix
,
$token
;
push
@suffix
,
@tokens
;
last
;
}
else
{
$token
=~ s/([\\\'])/\\$1/g;
push
@params
,
"'$token'"
;
}
};
@tokens
= (
$command
,
@params
?
join
(
', '
,
@params
) : (),
@suffix
);
push
@code
,
join
(
' '
,
@tokens
) .
";\n"
;
}
return
join
(
''
,
@code
);
}
1;