Alt-Acme-Math-XS-ModuleInstall
view release on metacpan or search on metacpan
inc/Inline.pm view on Meta::CPAN
use strict; use warnings;
package Inline;
our $VERSION = '0.78';
use Inline::denter;
use Config;
use Carp;
use Cwd qw(abs_path cwd);
use File::Spec;
use File::Spec::Unix;
use Fcntl qw(LOCK_EX LOCK_UN);
my %CONFIG = ();
my @DATA_OBJS = ();
my $INIT = 0;
my $version_requested = 0;
my $version_printed = 0;
my $untaint = 0;
my $safemode = 0;
our $languages = undef;
our $did = '_Inline'; # Default Inline Directory
# This is the config file written by create_config_file().
our $configuration_file = 'config-' . $Config::Config{'archname'} . '-' . $];
my %shortcuts =
(
NOCLEAN => [CLEAN_AFTER_BUILD => 0],
CLEAN => [CLEAN_BUILD_AREA => 1],
FORCE => [FORCE_BUILD => 1],
INFO => [PRINT_INFO => 1],
VERSION => [PRINT_VERSION => 1],
REPORTBUG => [REPORTBUG => 1],
UNTAINT => [UNTAINT => 1],
SAFE => [SAFEMODE => 1],
UNSAFE => [SAFEMODE => 0],
GLOBAL => [GLOBAL_LOAD => 1],
NOISY => [BUILD_NOISY => 1],
TIMERS => [BUILD_TIMERS => 1],
NOWARN => [WARNINGS => 0],
_INSTALL_ => [_INSTALL_ => 1],
SITE_INSTALL => undef, # No longer supported.
);
my $default_config =
{
NAME => '',
AUTONAME => -1,
VERSION => '',
DIRECTORY => '',
WITH => [],
USING => [],
CLEAN_AFTER_BUILD => 1,
CLEAN_BUILD_AREA => 0,
FORCE_BUILD => 0,
PRINT_INFO => 0,
PRINT_VERSION => 0,
REPORTBUG => 0,
UNTAINT => 0,
NO_UNTAINT_WARN => 0,
REWRITE_CONFIG_FILE => 0,
SAFEMODE => -1,
GLOBAL_LOAD => 0,
BUILD_NOISY => 0,
BUILD_TIMERS => 0,
WARNINGS => 1,
_INSTALL_ => 0,
inc/Inline.pm view on Meta::CPAN
sub UNTAINT {$untaint}
sub SAFEMODE {$safemode}
#==============================================================================
# This is where everything starts.
#==============================================================================
sub import {
my $class = shift;
$class->import_heavy(@_);
}
sub import_heavy {
local ($/, $") = ("\n", ' '); local ($\, $,);
my $o;
my ($pkg, $script) = caller(1);
# Not sure what this is for. Let's see what breaks.
# $pkg =~ s/^.*[\/\\]//;
my $class = shift;
if ($class ne 'Inline') {
croak M01_usage_use($class) if $class =~ /^Inline::/;
croak M02_usage();
}
$CONFIG{$pkg}{template} ||= $default_config;
return unless @_;
&create_config_file(), return 1 if $_[0] eq '_CONFIG_';
goto &maker_utils if $_[0] =~ /^(install|makedist|makeppd)$/i;
my $control = shift;
if (uc $control eq uc 'with') {
return handle_with($pkg, @_);
}
elsif (uc $control eq uc 'Config') {
return handle_global_config($pkg, @_);
}
elsif (exists $shortcuts{uc($control)}) {
handle_shortcuts($pkg, $control, @_);
$version_requested = $CONFIG{$pkg}{template}{PRINT_VERSION};
return;
}
elsif ($control =~ /^\S+$/ and $control !~ /\n/) {
my $language_id = $control;
my $option = shift || '';
my @config = @_;
my $next = 0;
for (@config) {
next if $next++ % 2;
croak M02_usage() if /[\s\n]/;
}
$o = bless {}, $class;
$o->{INLINE}{version} = $VERSION;
$o->{API}{pkg} = $pkg;
$o->{API}{script} = $script;
$o->{API}{language_id} = $language_id;
if ($option =~ /^(FILE|BELOW)$/i or
not $option and
defined $INC{File::Spec::Unix->catfile('Inline','Files.pm')} and
Inline::Files::get_filename($pkg)
) {
$o->read_inline_file;
$o->{CONFIG} = handle_language_config(@config);
}
elsif ($option eq 'DATA' or not $option) {
$o->{CONFIG} = handle_language_config(@config);
push @DATA_OBJS, $o;
return;
}
elsif (uc $option eq uc 'Config') {
$CONFIG{$pkg}{$language_id} = handle_language_config(@config);
return;
}
else {
$o->receive_code($option);
$o->{CONFIG} = handle_language_config(@config);
}
}
else {
croak M02_usage();
}
$o->glue;
}
#==============================================================================
# Run time version of import (public method)
#==============================================================================
sub bind {
local ($/, $") = ("\n", ' '); local ($\, $,);
my ($code, @config);
my $o;
my ($pkg, $script) = caller;
my $class = shift;
croak M03_usage_bind() unless $class eq 'Inline';
$CONFIG{$pkg}{template} ||= $default_config;
my $language_id = shift or croak M03_usage_bind();
croak M03_usage_bind()
unless ($language_id =~ /^\S+$/ and $language_id !~ /\n/);
$code = shift or croak M03_usage_bind();
@config = @_;
my $next = 0;
for (@config) {
next if $next++ % 2;
croak M03_usage_bind() if /[\s\n]/;
}
$o = bless {}, $class;
$o->{INLINE}{version} = $VERSION;
$o->{API}{pkg} = $pkg;
$o->{API}{script} = $script;
$o->{API}{language_id} = $language_id;
$o->receive_code($code);
$o->{CONFIG} = handle_language_config(@config);
$o->glue;
}
inc/Inline.pm view on Meta::CPAN
# The following small section of code seems, to me, to be unnecessary - which is the
# reason that I've commented it out. I've left it here (including its associated comments)
# in case it later becomes evident that there *is* good reason to include it. --sisyphus
#
## This bit tries to enable UNTAINT automatically if required when running the test suite.
# my $env_ha = $ENV{HARNESS_ACTIVE} || 0 ;
# my ($harness_active) = $env_ha =~ /(.*)/ ;
# if (($harness_active)&&(! $o->{CONFIG}{UNTAINT})){
# eval {
# require Scalar::Util;
# $o->{CONFIG}{UNTAINT} =
# (Scalar::Util::tainted(Cwd::cwd()) ? 1 : 0) ;
## Disable SAFEMODE in the test suite, we know what we are doing...
# $o->{CONFIG}{SAFEMODE} = 0 ;
# warn "\n-[tT] enabled for test suite.
#Automatically setting UNTAINT=1 and SAFEMODE=0.\n"
# unless $Inline::_TAINT_WARNING_ ;
# $Inline::_TAINT_WARNING_ = 1 ;
# } ;
# }
##
$untaint = $o->{CONFIG}{UNTAINT} || 0;
$safemode = (($o->{CONFIG}{SAFEMODE} == -1) ?
($untaint ? 1 : 0) :
$o->{CONFIG}{SAFEMODE}
);
if (UNTAINT and
SAFEMODE and
not $o->{CONFIG}{DIRECTORY}) {
croak M49_usage_unsafe(1) if ($< == 0 or $> == 0);
warn M49_usage_unsafe(0) if $^W;
}
if ($o->{CONFIG}{AUTONAME} == -1) {
$o->{CONFIG}{AUTONAME} = length($o->{CONFIG}{NAME}) ? 0 : 1;
}
$o->{API}{cleanup} =
($o->{CONFIG}{CLEAN_AFTER_BUILD} and not $o->{CONFIG}{REPORTBUG});
}
#==============================================================================
# Check if Inline extension is preinstalled
#==============================================================================
sub check_installed {
my $o = shift;
$o->{INLINE}{object_ready} = 0;
unless ($o->{API}{code} =~ /^[A-Fa-f0-9]{32}$/) {
require Digest::MD5;
$o->{INLINE}{md5} = Digest::MD5::md5_hex($o->{API}{code});
}
else {
$o->{INLINE}{md5} = $o->{API}{code};
}
return if $o->{CONFIG}{_INSTALL_};
return unless $o->{CONFIG}{VERSION};
croak M26_error_version_without_name()
unless $o->{CONFIG}{NAME};
my @pkgparts = split(/::/, $o->{API}{pkg});
my $realname = File::Spec->catfile(@pkgparts) . '.pm';
my $realname_unix = File::Spec::Unix->catfile(@pkgparts) . '.pm';
my $realpath = $INC{$realname_unix}
or croak M27_module_not_indexed($realname_unix);
my ($volume,$dir,$file) = File::Spec->splitpath($realpath);
my @dirparts = File::Spec->splitdir($dir);
pop @dirparts unless $dirparts[-1];
push @dirparts, $file;
my @endparts = splice(@dirparts, 0 - @pkgparts);
$dirparts[-1] = 'arch'
if $dirparts[-2] eq 'blib' && $dirparts[-1] eq 'lib';
File::Spec->catfile(@endparts) eq $realname
or croak M28_error_grokking_path($realpath);
$realpath =
File::Spec->catpath($volume,File::Spec->catdir(@dirparts),"");
$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);
my $suffix = $Config{dlext};
my $obj = File::Spec->catfile($realpath,'auto',$o->{API}{modpname},
"$o->{API}{modfname}.$suffix");
croak M30_error_no_obj($o->{CONFIG}{NAME}, $o->{API}{pkg},
$realpath) unless -f $obj;
@{$o->{CONFIG}}{qw( PRINT_INFO
REPORTBUG
FORCE_BUILD
_INSTALL_
)} = (0, 0, 0, 0);
$o->{install_lib} = $realpath;
$o->{INLINE}{ILSM_type} = 'compiled';
$o->{INLINE}{ILSM_module} = 'Inline::C';
$o->{INLINE}{ILSM_suffix} = $suffix;
$o->{INLINE}{object_ready} = 1;
}
#==============================================================================
# Dynamically load the object module
#==============================================================================
sub load {
my $o = shift;
return if $o->{CONFIG}{_INSTALL_};
my ($pkg, $module) = @{$o->{API}}{qw(pkg module)};
croak M42_usage_loader() unless $o->{INLINE}{ILSM_type} eq 'compiled';
require DynaLoader;
@Inline::ISA = qw(DynaLoader);
my $global = $o->{CONFIG}{GLOBAL_LOAD} ? '0x01' : '0x00';
my $version = $o->{API}{version} || '0.00';
eval <<END;
package $pkg;
push \@$ {pkg}::ISA, qw($module)
unless \$module eq "$pkg";
inc/Inline.pm view on Meta::CPAN
#==============================================================================
sub handle_with {
my $pkg = shift;
croak M45_usage_with() unless @_;
for (@_) {
croak M02_usage() unless /^[\w:]+$/;
eval "require $_;";
croak M46_usage_with_bad($_) . $@ if $@;
push @{$CONFIG{$pkg}{template}{WITH}}, $_;
}
}
#==============================================================================
# Perform cleanup duties
#==============================================================================
sub DESTROY {
my $o = shift;
$o->clean_build if $o->{CONFIG}{CLEAN_BUILD_AREA};
}
#==============================================================================
# Get the source code
#==============================================================================
sub receive_code {
my $o = shift;
my $code = shift;
croak M02_usage() unless (defined $code and $code);
if (ref $code eq 'CODE') {
$o->{API}{code} = &$code;
}
elsif (ref $code eq 'ARRAY') {
$o->{API}{code} = join '', @$code;
}
elsif ($code =~ m|[/\\:]| and
$code =~ m|^[/\\:\w.\-\ \$\[\]<>]+$|) {
if (-f $code) {
local ($/, *CODE);
open CODE, "< $code" or croak M06_code_file_failed_open($code);
$o->{API}{code} = <CODE>;
}
else {
croak M07_code_file_does_not_exist($code);
}
}
else {
$o->{API}{code} = $code;
}
}
#==============================================================================
# Get the source code from an Inline::Files filehandle
#==============================================================================
sub read_inline_file {
my $o = shift;
my ($lang, $pkg) = @{$o->{API}}{qw(language_id pkg)};
my $langfile = uc($lang);
croak M59_bad_inline_file($lang) unless $langfile =~ /^[A-Z]\w*$/;
croak M60_no_inline_files()
unless (defined $INC{File::Spec::Unix->catfile("Inline","Files.pm")} and
$Inline::Files::VERSION =~ /^\d\.\d\d$/ and
$Inline::Files::VERSION ge '0.51');
croak M61_not_parsed() unless $lang = Inline::Files::get_filename($pkg);
{
no strict 'refs';
local $/;
$Inline::FILE = \*{"${pkg}::$langfile"};
# open $Inline::FILE;
$o->{API}{code} = <$Inline::FILE>;
# close $Inline::FILE;
}
}
#==============================================================================
# Read the cached config file from the Inline directory. This will indicate
# whether the Language code is valid or not.
#==============================================================================
sub check_config_file {
my ($DIRECTORY, %config);
my $o = shift;
croak M14_usage_Config() if $Inline::Config::VERSION;
croak M63_no_source($o->{API}{pkg})
if $o->{INLINE}{md5} eq $o->{API}{code};
# First make sure we have the DIRECTORY
if ($o->{CONFIG}{_INSTALL_}) {
croak M15_usage_install_directory()
if $o->{CONFIG}{DIRECTORY};
my $cwd = Cwd::cwd();
$DIRECTORY =
$o->{INLINE}{DIRECTORY} = File::Spec->catdir($cwd, $did);
if (not -d $DIRECTORY) {
_mkdir($DIRECTORY, 0777)
or croak M16_DIRECTORY_mkdir_failed($DIRECTORY);
}
}
else {
$DIRECTORY = $o->{INLINE}{DIRECTORY} =
$o->{CONFIG}{DIRECTORY} || $o->find_temp_dir;
}
if($o->{CONFIG}{REWRITE_CONFIG_FILE}) {
if(-e File::Spec->catfile($DIRECTORY, $configuration_file)) {
my $unlink = unlink(File::Spec->catfile($DIRECTORY, $configuration_file));
if(!$unlink) {warn "REWRITE_CONFIG_FILE is set, but removal of config file failed"}
else {warn "config file removal successful\n" if $o->{CONFIG}{_TESTING}}
}
}
my $load_cfg = sub {
$o->create_config_file($DIRECTORY)
if not -e File::Spec->catfile($DIRECTORY, $configuration_file);
open CONFIG, "< ".File::Spec->catfile($DIRECTORY,$configuration_file)
or croak M17_config_open_failed($DIRECTORY);
flock(CONFIG, LOCK_EX) if $^O !~ /^VMS|riscos|VOS$/;
my $config = join '', <CONFIG>;
flock(CONFIG, LOCK_UN) if $^O !~ /^VMS|riscos|VOS$/;
close CONFIG;
( run in 0.801 second using v1.01-cache-2.11-cpan-39bf76dae61 )