Acme-MITHALDU-XSGrabBag
view release on metacpan or search on metacpan
inc/Inline/Module.pm view on Meta::CPAN
use strict; use warnings;
package Inline::Module;
our $VERSION = '0.34';
our $API_VERSION = 'v2';
use Carp 'croak';
use Config();
use File::Find();
use File::Path();
use File::Spec();
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" }}
#------------------------------------------------------------------------------
# This import serves multiple roles:
# - ::Inline module's proxy to Inline.pm
# - Makefile.PL postamble
# - Makefile rule support
#------------------------------------------------------------------------------
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';
# TODO: Deprecated 12/26/2014. Remove this in a month.
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
...
# XXX 'exit' is used to get a cleaner error msg.
# Try to redo this without 'exit'.
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;
require File::Path;
File::Path::mkpath($inline_build_path)
unless -d $inline_build_path;
require Inline;
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(@_);
};
}
#------------------------------------------------------------------------------
# The postamble method:
#------------------------------------------------------------------------------
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;
}
#------------------------------------------------------------------------------
# The handle methods.
#------------------------------------------------------------------------------
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'";
}
}
( run in 0.576 second using v1.01-cache-2.11-cpan-ceb78f64989 )