our
$VERSION
=
'0.34'
;
our
$API_VERSION
=
'v2'
;
my
$inline_build_path
=
'.inline'
;
use
constant
DEBUG_ON
=>
$ENV
{PERL_INLINE_MODULE_DEBUG} ? 1 : 0;
sub
DEBUG {
if
(DEBUG_ON) {
print
"DEBUG >>> "
,
sprintf
(
shift
,
@_
),
"\n"
}}
sub
import
{
my
$class
=
shift
;
DEBUG_ON && DEBUG
"$class->import(@_)"
;
my
(
$stub_module
,
$program
) =
caller
;
$program
=~ s!.*[\\\/]!!;
if
(
$program
eq
"Makefile.PL"
and not -e
'INLINE.h'
) {
$class
->check_inc_inc(
$program
);
no
warnings
'once'
;
*MY::postamble
= \
&postamble
;
return
;
}
elsif
(
$program
eq
'Build.PL'
) {
$class
->check_inc_inc(
$program
);
return
;
}
return
unless
@_
;
my
$cmd
=
shift
;
return
$class
->handle_stub(
$stub_module
,
@_
)
if
$cmd
eq
'stub'
;
return
$class
->handle_makestub(
@_
)
if
$cmd
eq
'makestub'
;
return
$class
->handle_distdir(
@ARGV
)
if
$cmd
eq
'distdir'
;
return
$class
->handle_fixblib()
if
$cmd
eq
'fixblib'
;
die
"Inline::Module 'autostub' no longer supported. "
.
"Remove this option from PERL5OPT."
if
$cmd
eq
'autostub'
;
die
"Unknown Inline::Module::import argument '$cmd'"
}
sub
check_api_version {
my
(
$class
,
$stub_module
,
$api_version
) =
@_
;
if
(
$api_version
ne
$API_VERSION
) {
warn
<<"...";
It seems that '$stub_module' is out of date.
It is using Inline::Module API version '$api_version'.
You have Inline::Module API version '$API_VERSION' installed.
Make sure you have the latest version of Inline::Module installed, then run:
perl -MInline::Module=makestub,$stub_module
...
exit
1;
}
}
sub
check_inc_inc {
my
(
$class
,
$program
) =
@_
;
my
$first
=
$INC
[0] or
die
;
if
(
$first
!~ /^(\.[\/\\])?inc[\/\\]?$/) {
die
<<"...";
First element of \@INC should be 'inc'.
It's '$first'.
Add this line to the top of your '$program':
use lib 'inc';
...
}
}
sub
importer {
my
(
$class
,
$stub_module
) =
@_
;
return
sub
{
my
(
$class
,
$lang
) =
@_
;
return
unless
defined
$lang
;
File::Path::mkpath(
$inline_build_path
)
unless
-d
$inline_build_path
;
Inline->
import
(
Config
=>
directory
=>
$inline_build_path
,
(
$lang
eq
'C'
) ? (
using
=>
'Inline::C::Parser::RegExp'
) : (),
name
=>
$stub_module
,
CLEAN_AFTER_BUILD
=> 0,
);
shift
(
@_
);
DEBUG_ON && DEBUG
"Inline::Module::importer proxy to Inline::%s"
,
@_
;
Inline->import_heavy(
@_
);
};
}
sub
postamble {
my
(
$makemaker
,
%args
) =
@_
;
DEBUG_ON && DEBUG
"Inline::Module::postamble(${\join', ',@_})"
;
my
$meta
=
$args
{inline}
or croak
"'postamble' section requires 'inline' key in Makefile.PL"
;
croak
"postamble 'inline' section requires 'module' key in Makefile.PL"
unless
$meta
->{module};
my
$class
= __PACKAGE__;
$class
->default_meta(
$meta
);
my
$code_modules
=
$meta
->{module};
my
$stub_modules
=
$meta
->{stub};
my
$included_modules
=
$class
->included_modules(
$meta
);
if
(
$meta
->{makestub} and not -e
'inc'
and not -e
'INLINE.h'
) {
$class
->make_stub_modules(@{
$meta
->{stub}});
}
my
$section
=
<<"...";
clean ::
\t- \$(RM_RF) $inline_build_path
distdir : distdir_inline
distdir_inline : create_distdir
\t\$(NOECHO) \$(ABSPERLRUN) -MInline::Module=distdir -e 1 -- \$(DISTVNAME) @$stub_modules -- @$included_modules
pure_all ::
...
for
my
$module
(
@$code_modules
) {
$section
.=
"\t\$(NOECHO) \$(ABSPERLRUN) -Iinc -Ilib -M$module -e 1 --\n"
;
}
$section
.=
"\t\$(NOECHO) \$(ABSPERLRUN) -Iinc -MInline::Module=fixblib -e 1 --\n"
;
return
$section
;
}
sub
handle_stub {
my
(
$class
,
$stub_module
,
$api_version
) =
@_
;
DEBUG_ON && DEBUG
"$class->handle_stub($stub_module, $api_version)"
;
$class
->check_api_version(
$stub_module
,
$api_version
);
no
strict
'refs'
;
*{
"${stub_module}::import"
} =
$class
->importer(
$stub_module
);
return
;
}
sub
handle_makestub {
my
(
$class
,
@args
) =
@_
;
DEBUG_ON && DEBUG
"$class->handle_makestub(${\join', ',@args})"
;
my
@modules
;
for
my
$arg
(
@args
) {
if
(
$arg
=~ /::/) {
push
@modules
,
$arg
;
}
else
{
croak
"Unknown 'makestub' argument: '$arg'"
;
}
}
$class
->make_stub_modules(
@modules
);
exit
0;
}
sub
handle_distdir {
my
(
$class
,
$distdir
,
@args
) =
@_
;
DEBUG_ON && DEBUG
"$class->handle_distdir($distdir, ${\join', ',@args})"
;
my
$stub_modules
= [];
my
$included_modules
= [];
while
(
@args
and (
$_
=
shift
(
@args
)) ne
'--'
) {
push
@$stub_modules
,
$_
;
}
while
(
@args
and (
$_
=
shift
(
@args
)) ne
'--'
) {
push
@$included_modules
,
$_
;
}
$class
->add_to_distdir(
$distdir
,
$stub_modules
,
$included_modules
);
}
sub
handle_fixblib {
my
(
$class
) =
@_
;
DEBUG_ON && DEBUG
"$class->handle_fixblib()"
;
my
$ext
=
$Config::Config
{dlext};
-d
'blib'
or
die
"Inline::Module::fixblib expected to find 'blib' directory"
;
File::Find::find({
wanted
=>
sub
{
-f or
return
;
if
(m!^(
$inline_build_path
/lib/auto/.*)\.
$ext
$!) {
my
$blib_ext
=
$_
;
$blib_ext
=~ s!^
$inline_build_path
/lib!blib/arch! or
die
;
my
$blib_ext_dir
=
$blib_ext
;
$blib_ext_dir
=~ s!(.*)/.*!$1! or
die
;
File::Path::mkpath
$blib_ext_dir
;
link
$_
,
$blib_ext
;
}
},
no_chdir
=> 1,
},
$inline_build_path
);
}
sub
default_meta {
my
(
$class
,
$meta
) =
@_
;
defined
$meta
->{module}
or
die
"Meta 'module' not defined"
;
$meta
->{module} = [
$meta
->{module} ]
unless
ref
$meta
->{module};
$meta
->{stub} ||= [
map
"${_}::Inline"
, @{
$meta
->{module}} ];
$meta
->{stub} = [
$meta
->{stub} ]
unless
ref
$meta
->{stub};
$meta
->{ilsm} ||=
'Inline::C'
;
$meta
->{ilsm} = [
$meta
->{ilsm} ]
unless
ref
$meta
->{ilsm};
$meta
->{bundle} = 1
unless
defined
$meta
->{bundle};
}
sub
included_modules {
my
(
$class
,
$meta
) =
@_
;
DEBUG_ON && DEBUG
"$class->included_modules($meta)"
;
return
[]
if
not
$meta
->{bundle};
my
$ilsm
=
$meta
->{ilsm};
my
$include
= [
'Inline'
,
'Inline::denter'
,
'Inline::Module'
,
@$ilsm
,
];
if
(
caller
eq
'Module::Build::InlineModule'
) {
push
@$include
,
'Module::Build::InlineModule'
;
}
if
(
grep
/:C$/,
@$ilsm
) {
push
@$include
,
'Inline::C::Parser::RegExp'
;
}
if
(
grep
/:CPP$/,
@$ilsm
) {
push
@$include
, (
'Inline::C'
,
'Inline::CPP::Config'
,
'Inline::CPP::Parser::RecDescent'
,
'Parse::RecDescent'
,
'ExtUtils::CppGuess'
,
'Capture::Tiny'
,
);
}
return
$include
;
}
sub
add_to_distdir {
my
(
$class
,
$distdir
,
$stub_modules
,
$included_modules
) =
@_
;
DEBUG_ON && DEBUG
"$class->add_to_distdir($distdir) [@$stub_modules] [@$included_modules]"
;
my
$manifest
= [];
for
my
$module
(
@$stub_modules
) {
my
$code
=
$class
->dyna_module(
$module
);
$class
->write_module(
"$distdir/lib"
,
$module
,
$code
);
$code
=
$class
->proxy_module(
$module
);
$class
->write_module(
"$distdir/inc"
,
$module
,
$code
);
$module
=~ s!::!/!g;
push
@$manifest
,
"lib/$module.pm"
unless
-e
"lib/$module.pm"
;
push
@$manifest
,
"inc/$module.pm"
;
}
for
my
$module
(
@$included_modules
) {
my
$code
=
$module
eq
'Inline::CPP::Config'
?
$class
->read_share_cpp_config
:
$class
->read_local_module(
$module
);
$class
->write_module(
"$distdir/inc"
,
$module
,
$code
);
$module
=~ s!::!/!g;
push
@$manifest
,
"inc/$module.pm"
;
}
$class
->add_to_manifest(
$distdir
,
@$manifest
);
return
$manifest
;
}
sub
make_stub_modules {
my
(
$class
,
@modules
) =
@_
;
DEBUG_ON && DEBUG
"$class->make_stub_modules(@modules)"
;
for
my
$module
(
@modules
) {
my
$code
=
$class
->proxy_module(
$module
);
my
$path
=
$class
->write_module(
'lib'
,
$module
,
$code
,
'onchange'
);
if
(
$path
) {
print
"Created stub module '$path' (Inline::Module $VERSION)\n"
;
}
}
}
sub
read_local_module {
my
(
$class
,
$module
) =
@_
;
eval
"require $module; 1"
or
die
$@;
my
$file
=
$module
;
$file
=~ s!::!/!g;
$class
->read_file(
$INC
{
"$file.pm"
});
}
sub
read_share_cpp_config {
my
(
$class
) =
@_
;
my
$dir
= File::Share::dist_dir(
'Inline-Module'
);
my
$path
= File::Spec->catfile(
$dir
,
'CPPConfig.pm'
);
$class
->read_file(
$path
);
}
sub
proxy_module {
my
(
$class
,
$module
) =
@_
;
DEBUG_ON && DEBUG
"$class->proxy_module($module)"
;
return
<<"...";
# DO NOT EDIT. GENERATED BY: Inline::Module
#
# This module is for author-side development only. When this module is shipped
# to CPAN, it will be automagically replaced with content that does not
# require any Inline framework modules (or any other non-core modules).
#
# To regenerate this stub module, run this command:
#
# perl -MInline::Module=makestub,$module
use strict; use warnings;
package $module;
use Inline::Module stub => '$API_VERSION';
1;
...
}
sub
dyna_module {
my
(
$class
,
$module
) =
@_
;
DEBUG_ON && DEBUG
"$class->dyna_module($module)"
;
return
<<"...";
# DO NOT EDIT. GENERATED BY: Inline::Module $Inline::Module::VERSION
use strict; use warnings;
package $module;
use base 'DynaLoader';
bootstrap $module;
1;
...
}
sub
read_file {
my
(
$class
,
$filepath
) =
@_
;
DEBUG_ON && DEBUG
"$class->read_file($filepath)"
;
open
IN,
'<'
,
$filepath
or
die
"Can't open '$filepath' for input:\n$!"
;
my
$code
=
do
{
local
$/; <IN>};
close
IN;
return
$code
;
}
sub
write_module {
my
$class
=
shift
;
my
(
$dest
,
$module
,
$code
,
$onchange
) =
@_
;
DEBUG_ON && DEBUG
"$class->write_module($dest, $module, ..., $onchange)"
;
$onchange
||= 0;
$code
=~ s/\n+__END__\n.*//s;
my
$filepath
=
$module
;
$filepath
=~ s!::!/!g;
$filepath
=
"$dest/$filepath.pm"
;
my
$dirpath
=
$filepath
;
$dirpath
=~ s!(.*)/.*!$1!;
File::Path::mkpath(
$dirpath
);
return
if
$onchange
and
-e
$filepath
and
$class
->read_file(
$filepath
) eq
$code
;
unlink
$filepath
;
open
OUT,
'>'
,
$filepath
or
die
"Can't open '$filepath' for output:\n$!"
;
print
OUT
$code
;
close
OUT;
return
$filepath
;
}
sub
add_to_manifest {
my
(
$class
,
$distdir
,
@files
) =
@_
;
DEBUG_ON && DEBUG
"$class->add_to_manifest($distdir) (@files)"
;
my
$manifest
=
"$distdir/MANIFEST"
;
if
(-w
$manifest
) {
open
my
$out
,
'>>'
,
$manifest
or
die
"Can't open '$manifest' for append:\n$!"
;
for
my
$file
(
@files
) {
print
$out
"$file\n"
;
}
close
$out
;
}
}
sub
smoke_system_info_dump {
my
(
$class
,
@msg
) =
@_
;
my
$msg
=
sprintf
(
@msg
);
chomp
$msg
;
local
$Data::Dumper::Sortkeys
= 1;
local
$Data::Dumper::Terse
= 1;
local
$Data::Dumper::Indent
= 1;
my
@path_files
;
File::Find::find({
wanted
=>
sub
{
push
@path_files
,
$File::Find::name
if
-f;
},
}, File::Spec->path());
my
$dump
= Data::Dumper::Dumper(
{
'ENV'
=> \
%ENV
,
'Config'
=> \
%Config::Config
,
'Path Files'
=> \
@path_files
,
},
);
Carp::confess
<<"..."
Error: $msg
System Data:
$dump
Error: $msg
...
}
1;