Acme-MITHALDU-XSGrabBag
view release on metacpan or search on metacpan
inc/Inline.pm view on Meta::CPAN
if (! defined $config{languages}->{$o->{API}{language_id}}){
my $unlink = unlink(File::Spec->catfile($DIRECTORY, $configuration_file));
if(!$unlink) {warn "Failed to remove config file"}
else {warn "config file removed\n" if $o->{CONFIG}{_TESTING}}
$load_cfg->() ;
}
$Inline::languages = $config{languages};
{
no warnings ('numeric'); # These warnings were a pain with devel releases.
# If there's a problem with the version number, the
# error message will output $config{version} anyway.
croak M18_error_old_version($config{version}, $DIRECTORY)
unless (defined $config{version} and
$config{version} =~ /TRIAL/ or
$config{version} >= 0.40);
} # numeric warnings re-enabled.
croak M19_usage_language($o->{API}{language_id}, $DIRECTORY)
unless defined $config{languages}->{$o->{API}{language_id}};
$o->{API}{language} = $config{languages}->{$o->{API}{language_id}};
if ($o->{API}{language} ne $o->{API}{language_id}) {
if (defined $o->{$o->{API}{language_id}}) {
$o->{$o->{API}{language}} = $o->{$o->{API}{language_id}};
delete $o->{$o->{API}{language_id}};
}
}
$o->{INLINE}{ILSM_type} = $config{types}->{$o->{API}{language}};
$o->{INLINE}{ILSM_module} = $config{modules}->{$o->{API}{language}};
$o->{INLINE}{ILSM_suffix} = $config{suffixes}->{$o->{API}{language}};
}
#==============================================================================
# Auto-detect installed Inline language support modules
#==============================================================================
sub create_config_file {
my ($o, $dir) = @_;
# This subroutine actually fires off another instance of perl.
# with arguments that make this routine get called again.
# That way the queried modules don't stay loaded.
if (defined $o) {
($dir) = $dir =~ /(.*)/s if UNTAINT;
my $perl = $Config{perlpath};
$perl = $^X unless -f $perl;
($perl) = $perl =~ /(.*)/s if UNTAINT;
local $ENV{PERL5LIB} if defined $ENV{PERL5LIB};
local $ENV{PERL5OPT} if defined $ENV{PERL5OPT};
my $inline = $INC{'Inline.pm'};
$inline ||= File::Spec->curdir();
my($v,$d,$f) = File::Spec->splitpath($inline);
$f = "" if $f eq 'Inline.pm';
$inline = File::Spec->catpath($v,$d,$f);
# P::RD may be in a different PERL5LIB dir to Inline (as happens with cpan smokers).
# Therefore we need to grep for it - otherwise, if P::RD *is* in a different PERL5LIB
# directory the ensuing rebuilt @INC will not include that directory and attempts to use
# Inline::CPP (and perhaps other Inline modules) will fail because P::RD isn't found.
my @_inc = map { "-I$_" }
($inline,
grep {(-d File::Spec->catdir($_,"Inline") or -d File::Spec->catdir($_,"auto","Inline") or -e File::Spec->catdir($_,"Parse/RecDescent.pm"))} @INC);
system $perl, @_inc, "-MInline=_CONFIG_", "-e1", "$dir"
and croak M20_config_creation_failed($dir);
return;
}
my ($lib, $mod, $register, %checked,
%languages, %types, %modules, %suffixes);
LIB:
for my $lib (@INC) {
next unless -d File::Spec->catdir($lib,"Inline");
opendir LIB, File::Spec->catdir($lib,"Inline")
or warn(M21_opendir_failed(File::Spec->catdir($lib,"Inline"))), next;
while ($mod = readdir(LIB)) {
next unless $mod =~ /\.pm$/;
$mod =~ s/\.pm$//;
next LIB if ($checked{$mod}++);
if ($mod eq 'Config') { # Skip Inline::Config
warn M14_usage_Config();
next;
}
next if $mod =~ /^(MakeMaker|denter|messages)$/;
# @INC is made safe by -T disallowing PERL5LIB et al
($mod) = $mod =~ /(.*)/;
eval "require Inline::$mod;";
warn($@), next if $@;
eval "\$register=&Inline::${mod}::register";
next if $@;
my $language = ($register->{language})
or warn(M22_usage_register($mod)), next;
for (@{$register->{aliases}}) {
warn(M23_usage_alias_used($mod, $_, $languages{$_})), next
if defined $languages{$_};
$languages{$_} = $language;
}
$languages{$language} = $language;
$types{$language} = $register->{type};
$modules{$language} = "Inline::$mod";
$suffixes{$language} = $register->{suffix};
}
closedir LIB;
}
my $file = File::Spec->catfile($ARGV[0], $configuration_file);
open CONFIG, "> $file" or croak M24_open_for_output_failed($file);
flock(CONFIG, LOCK_EX) if $^O !~ /^VMS|riscos|VOS$/;
print CONFIG Inline::denter->new()
->indent(*version => $Inline::VERSION,
*languages => \%languages,
*types => \%types,
*modules => \%modules,
*suffixes => \%suffixes,
);
flock(CONFIG, LOCK_UN) if $^O !~ /^VMS|riscos|VOS$/;
close CONFIG;
exit 0;
}
#==============================================================================
inc/Inline.pm view on Meta::CPAN
croak M36_usage_install_main()
if ($o->{API}{pkg} eq 'main');
croak M37_usage_install_auto()
if $o->{CONFIG}{AUTONAME};
croak M38_usage_install_name()
unless $o->{CONFIG}{NAME};
croak M39_usage_install_version()
unless $o->{CONFIG}{VERSION};
croak M40_usage_install_badname($o->{CONFIG}{NAME}, $o->{API}{pkg})
unless $o->{CONFIG}{NAME} eq $o->{API}{pkg};
# $o->{CONFIG}{NAME} =~ /^$o->{API}{pkg}::\w(\w|::)+$/
# );
my ($mod_name, $mod_ver, $ext_name, $ext_ver) =
($o->{API}{pkg}, $ARGV[0], @{$o->{CONFIG}}{qw(NAME VERSION)});
croak M41_usage_install_version_mismatch($mod_name, $mod_ver,
$ext_name, $ext_ver)
unless ($mod_ver eq $ext_ver);
$o->{INLINE}{INST_ARCHLIB} = $ARGV[1];
$o->{API}{version} = $o->{CONFIG}{VERSION};
$o->{API}{module} = $o->{CONFIG}{NAME};
my @modparts = split(/::/,$o->{API}{module});
$o->{API}{modfname} = $modparts[-1];
$o->{API}{modpname} = File::Spec->catdir(@modparts);
$o->{API}{modinlname} = join('-',@modparts).'.inl';
$o->{API}{suffix} = $o->{INLINE}{ILSM_suffix};
$o->{API}{build_dir} = File::Spec->catdir($o->{INLINE}{DIRECTORY},'build',
$o->{API}{modpname});
$o->{API}{directory} = $o->{INLINE}{DIRECTORY};
my $cwd = Cwd::cwd();
$o->{API}{install_lib} =
File::Spec->catdir($cwd,$o->{INLINE}{INST_ARCHLIB});
$o->{API}{location} =
File::Spec->catfile($o->{API}{install_lib},"auto",$o->{API}{modpname},
"$o->{API}{modfname}.$o->{INLINE}{ILSM_suffix}");
unshift @::INC, $o->{API}{install_lib};
$o->{INLINE}{object_ready} = 0;
}
#==============================================================================
# Create the .inl file for an object
#==============================================================================
sub write_inl_file {
my $o = shift;
my $inl =
File::Spec->catfile($o->{API}{install_lib},"auto",$o->{API}{modpname},
"$o->{API}{modfname}.inl");
open INL, "> $inl"
or croak "Can't create Inline validation file $inl: $!";
my $apiversion = $Config{apiversion} || $Config{xs_apiversion};
print INL Inline::denter->new()
->indent(*md5, $o->{INLINE}{md5},
*name, $o->{API}{module},
*version, $o->{CONFIG}{VERSION},
*language, $o->{API}{language},
*language_id, $o->{API}{language_id},
*installed, $o->{CONFIG}{_INSTALL_},
*date_compiled, scalar localtime,
*inline_version, $Inline::VERSION,
*ILSM, { map {($_, $o->{INLINE}{"ILSM_$_"})}
(qw( module suffix type ))
},
*Config, { (map {($_,$Config{$_})}
(qw( archname osname osvers
cc ccflags ld so version
))),
(apiversion => $apiversion),
},
);
close INL;
}
#==============================================================================
# Get config hints
#==============================================================================
sub with_configs {
my $o = shift;
my @configs;
for my $mod (@{$o->{CONFIG}{WITH}}) {
my $ref = eval { $mod->Inline($o->{API}{language}); };
croak M25_no_WITH_support($mod, $@) if $@;
croak M65_WITH_not_lang($mod, $o->{API}{language}) unless $ref;
push @configs, %$ref;
}
return @configs;
}
#==============================================================================
# Blindly untaint tainted fields in %ENV.
#==============================================================================
sub env_untaint {
my $o = shift;
warn "In Inline::env_untaint() : Blindly untainting tainted fields in %ENV.\n" unless $o->{CONFIG}{NO_UNTAINT_WARN};
{
no warnings ('uninitialized'); # In case $ENV{$_} is set to undef.
for (keys %ENV) {
($ENV{$_}) = $ENV{$_} =~ /(.*)/;
}
}
# only accept dirs that are absolute and not world-writable
$ENV{PATH} = $^O eq 'MSWin32' ?
join ';', grep {not /^\./ and -d $_
} split /;/, $ENV{PATH}
:
join ':', grep {/^\// and -d $_ and $< == $> ? 1 : not (-W $_ or -O $_)
} split /:/, $ENV{PATH};
map {($_) = /(.*)/} @INC;
# list cherry-picked from `perldoc perlrun`
delete @ENV{qw(PERL5OPT PERL5SHELL PERL_ROOT IFS CDPATH ENV BASH_ENV)};
$ENV{SHELL} = '/bin/sh' if -x '/bin/sh';
$< = $> if $< != $>; # so child processes retain euid - ignore failure
}
#==============================================================================
# Blindly untaint tainted fields in Inline object.
#==============================================================================
sub obj_untaint {
my $o = shift;
warn "In Inline::obj_untaint() : Blindly untainting tainted fields in Inline object.\n" unless $o->{CONFIG}{NO_UNTAINT_WARN};
($o->{INLINE}{ILSM_module}) = $o->{INLINE}{ILSM_module} =~ /(.*)/;
($o->{API}{directory}) = $o->{API}{directory} =~ /(.*)/;
($o->{API}{build_dir}) = $o->{API}{build_dir} =~ /(.*)/;
($o->{CONFIG}{DIRECTORY}) = $o->{CONFIG}{DIRECTORY} =~ /(.*)/;
($o->{API}{install_lib}) = $o->{API}{install_lib} =~ /(.*)/;
($o->{API}{modpname}) = $o->{API}{modpname} =~ /(.*)/;
($o->{API}{modfname}) = $o->{API}{modfname} =~ /(.*)/;
($o->{API}{language}) = $o->{API}{language} =~ /(.*)/;
($o->{API}{pkg}) = $o->{API}{pkg} =~ /(.*)/;
($o->{API}{module}) = $o->{API}{module} =~ /(.*)/;
}
#==============================================================================
# Clean the build directory from previous builds
#==============================================================================
sub clean_build {
use strict;
my ($prefix, $dir);
my $o = shift;
$prefix = $o->{INLINE}{DIRECTORY};
opendir(BUILD, $prefix)
or croak "Can't open build directory: $prefix for cleanup $!\n";
while ($dir = readdir(BUILD)) {
my $maybedir = File::Spec->catdir($prefix,$dir);
if (($maybedir and -d $maybedir) and ($dir =~ /\w{36,}/)) {
$o->rmpath($prefix,$dir);
}
}
close BUILD;
}
#==============================================================================
# Apply a list of filters to the source code
#==============================================================================
sub filter {
my $o = shift;
my $new_code = $o->{API}{code};
for (@_) {
croak M52_invalid_filter($_) unless ref;
if (ref eq 'CODE') {
$new_code = $_->($new_code);
}
else {
$new_code = $_->filter($o, $new_code);
}
}
return $new_code;
}
#==============================================================================
# User wants to report a bug
#==============================================================================
sub reportbug {
use strict;
my $o = shift;
return if $o->{INLINE}{reportbug_handled}++;
print STDERR <<END;
<-----------------------REPORTBUG Section------------------------------------->
REPORTBUG mode in effect.
Your Inline $o->{API}{language_id} code will be processed in the build directory:
$o->{API}{build_dir}
A perl-readable bug report including your perl configuration and run-time
diagnostics will also be generated in the build directory.
When the program finishes please bundle up the above build directory with:
tar czf Inline.REPORTBUG.tar.gz $o->{API}{build_dir}
and send "Inline.REPORTBUG.tar.gz" as an email attachment to the author
of the offending Inline::* module with the subject line:
REPORTBUG: Inline.pm
Include in the email, a description of the problem and anything else that
you think might be helpful. Patches are welcome! :-\)
<-----------------------End of REPORTBUG Section------------------------------>
END
my %versions;
{
no strict 'refs';
%versions = map {eval "use $_();"; ($_, $ {$_ . '::VERSION'})}
qw (Digest::MD5 Parse::RecDescent
ExtUtils::MakeMaker File::Path FindBin
Inline
);
}
$o->mkpath($o->{API}{build_dir});
open REPORTBUG, "> ".File::Spec->catfile($o->{API}{build_dir},"REPORTBUG")
or croak M24_open_for_output_failed
(File::Spec->catfile($o->{API}{build_dir},"REPORTBUG"));
%Inline::REPORTBUG_Inline_Object = ();
%Inline::REPORTBUG_Perl_Config = ();
%Inline::REPORTBUG_Module_Versions = ();
print REPORTBUG Inline::denter->new()
->indent(*REPORTBUG_Inline_Object, $o,
*REPORTBUG_Perl_Config, \%Config::Config,
*REPORTBUG_Module_Versions, \%versions,
);
close REPORTBUG;
}
#==============================================================================
# Print a small report if PRINT_INFO option is set.
#==============================================================================
sub print_info {
use strict;
my $o = shift;
print STDERR <<END;
<-----------------------Information Section----------------------------------->
Information about the processing of your Inline $o->{API}{language_id} code:
END
print STDERR <<END if ($o->{INLINE}{object_ready});
Your module is already compiled. It is located at:
$o->{API}{location}
END
print STDERR <<END if ($o->{INLINE}{object_ready} and $o->{CONFIG}{FORCE_BUILD});
But the FORCE_BUILD option is set, so your code will be recompiled.
I\'ll use this build directory:
$o->{API}{build_dir}
and I\'ll install the executable as:
$o->{API}{location}
END
print STDERR <<END if (not $o->{INLINE}{object_ready});
Your source code needs to be compiled. I\'ll use this build directory:
$o->{API}{build_dir}
and I\'ll install the executable as:
$o->{API}{location}
END
eval {
( run in 0.964 second using v1.01-cache-2.11-cpan-5b529ec07f3 )