Acme-MITHALDU-XSGrabBag
view release on metacpan or search on metacpan
inc/Inline.pm view on Meta::CPAN
unless ($DATA_read{$pkg}++) {
no strict 'refs';
*Inline::DATA = *{$pkg . '::DATA'};
local ($/);
my ($CR, $LF) = (&Socket::CR, &Socket::LF);
(my $data = <Inline::DATA>) =~ s/$CR?$LF/\n/g;
@{$DATA{$pkg}} = split /(?m)^[ \t]{0,}(__\S+?__\n)/, $data;
shift @{$DATA{$pkg}} unless ($ {$DATA{$pkg}}[0] || '') =~ /__\S+?__\n/;
}
($marker, $o->{API}{code}) = splice @{$DATA{$pkg}}, 0, 2;
croak M08_no_DATA_source_code($language_id)
unless defined $marker;
($marker_tag = $marker) =~ s/__(\S+?)__\n/$1/;
croak M09_marker_mismatch($marker, $language_id)
unless $marker_tag eq $language_id;
}
#==============================================================================
# Validate and store the non language-specific config options
#==============================================================================
sub check_config {
my $o = shift;
my @others;
while (@_) {
my ($key, $value) = (shift, shift);
if (defined $default_config->{$key}) {
if ($key =~ /^(WITH|USING)$/) {
croak M10_usage_WITH_USING()
if (ref $value and ref $value ne 'ARRAY');
$value = [$value] unless ref $value;
$o->{CONFIG}{$key} = $value;
next;
}
$o->{CONFIG}{$key} = $value, next if not $value;
if ($key eq 'DIRECTORY') {
croak M11_usage_DIRECTORY($value) unless (-d $value);
$value = abs_path($value);
}
elsif ($key eq 'NAME') {
croak M12_usage_NAME($value)
unless $value =~ /^[a-zA-Z_](\w|::)*$/;
}
elsif ($key eq 'VERSION') {
croak M13_usage_VERSION($value) unless $value =~ /^\d\.\d\d*$/;
}
$o->{CONFIG}{$key} = $value;
}
else {
push @others, $key, $value;
}
}
return (@others);
}
#==============================================================================
# Set option defaults based on current option settings.
#==============================================================================
sub fold_options {
my $o = shift;
# 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}
inc/Inline.pm view on Meta::CPAN
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";
local \$$ {module}::VERSION = '$version';
package $module;
push \@$ {module}::ISA, qw(Exporter DynaLoader);
sub dl_load_flags { $global }
${module}::->bootstrap;
END
croak M43_error_bootstrap($module, $@) if $@;
}
#==============================================================================
# Create file that satisfies the Makefile dependency for this object
#==============================================================================
sub satisfy_makefile_dep {
my $o = shift;
my $inline = $o->{API}{modinlname};
open INLINE, "> $inline"
or croak M24_open_for_output_failed($inline);
print INLINE "*** AUTOGENERATED by Inline.pm ***\n\n";
print INLINE "This file satisfies the make dependency for ";
print INLINE "$o->{API}{module}\n";
close INLINE;
return;
}
#==============================================================================
# Process the config options that apply to all Inline sections
#==============================================================================
sub handle_global_config {
my $pkg = shift;
while (@_) {
my ($key, $value) = (uc shift, shift);
croak M02_usage() if $key =~ /[\s\n]/;
if ($key =~ /^(ENABLE|DISABLE)$/) {
($key, $value) = (uc $value, $key eq 'ENABLE' ? 1 : 0);
}
croak M47_invalid_config_option($key)
unless defined $default_config->{$key};
$CONFIG{$pkg}{template}{$key} = $value;
}
}
#==============================================================================
# Process the config options that apply to a particular language
#==============================================================================
sub handle_language_config {
my @values;
while (@_) {
my ($key, $value) = (uc shift, shift);
croak M02_usage() if $key =~ /[\s\n]/;
if ($key eq 'ENABLE') {
push @values, uc $value, 1;
}
elsif ($key eq 'DISABLE') {
push @values, uc $value, 0;
}
else {
push @values, $key, $value;
}
}
return {@values};
}
#==============================================================================
# Validate and store shortcut config options
#==============================================================================
sub handle_shortcuts {
my $pkg = shift;
for my $option (@_) {
my $OPTION = uc($option);
if ($OPTION eq 'SITE_INSTALL') {
croak M58_site_install();
}
elsif ($shortcuts{$OPTION}) {
my ($method, $arg) = @{$shortcuts{$OPTION}};
$CONFIG{$pkg}{template}{$method} = $arg;
}
else {
croak M48_usage_shortcuts($option);
}
}
}
#==============================================================================
# Process the with command
#==============================================================================
inc/Inline.pm view on Meta::CPAN
END
return $usage;
}
sub M03_usage_bind {
my $usage = <<END;
Invalid usage of the Inline->bind() function. Valid usages are:
Inline->bind(language => "source-string", config-pair-list);
Inline->bind(language => "source-file", config-pair-list);
Inline->bind(language => [source-line-list], config-pair-list);
END
$usage .= <<END if defined $Inline::languages;
Supported languages:
${\ join(', ', sort keys %$Inline::languages)}
END
return $usage;
}
sub M04_error_nocode {
my ($language) = @_;
return <<END;
No $language source code found for Inline.
END
}
sub M05_error_eval {
my ($subroutine, $msg) = @_;
return <<END;
An eval() failed in Inline::$subroutine:
$msg
END
}
sub M06_code_file_failed_open {
my ($file) = @_;
return <<END;
Couldn't open Inline code file '$file':
$!
END
#'
}
sub M07_code_file_does_not_exist {
my ($file) = @_;
return <<END;
Inline assumes '$file' is a filename,
and that file does not exist.
END
}
sub M08_no_DATA_source_code {
my ($lang) = @_;
return <<END;
No source code in DATA section for Inline '$lang' section.
END
}
sub M09_marker_mismatch {
my ($marker, $lang) = @_;
return <<END;
Marker '$marker' does not match Inline '$lang' section.
END
}
sub M10_usage_WITH_USING {
return <<END;
Config option WITH or USING must be a module name or an array ref
of module names.
END
}
sub M11_usage_DIRECTORY {
my ($value) = @_;
return <<END;
Invalid value '$value' for config option DIRECTORY
END
}
sub M12_usage_NAME {
my ($name) = @_;
return <<END;
Invalid value for NAME config option: '$name'
END
}
sub M13_usage_VERSION {
my ($version) = @_;
return <<END;
Invalid value for VERSION config option: '$version'
Must be of the form '#.##'.
(Should also be specified as a string rather than a floating point number)
END
}
sub M14_usage_Config {
return <<END;
As of Inline v0.30, use of the Inline::Config module is no longer supported
or allowed. If Inline::Config exists on your system, it can be removed. See
the Inline documentation for information on how to configure Inline.
END
}
sub M15_usage_install_directory {
return <<END;
Can't use the DIRECTORY option when installing an Inline extension module.
END
#'
}
sub M16_DIRECTORY_mkdir_failed {
my ($dir) = @_;
return <<END;
Can't mkdir $dir to build Inline code.
inc/Inline.pm view on Meta::CPAN
}
sub M35_error_no_object_file {
my ($obj, $inl) = @_;
return <<END;
There is no object file:
$obj
For Inline validation file:
$inl
This module should be reinstalled.
END
}
sub M36_usage_install_main {
return <<END;
Can't install an Inline extension module from package 'main'.
END
#'
}
sub M37_usage_install_auto {
return <<END;
Can't install an Inline extension module with AUTONAME enabled.
END
#'
}
sub M38_usage_install_name {
return <<END;
An Inline extension module requires an explicit NAME.
END
}
sub M39_usage_install_version {
return <<END;
An Inline extension module requires an explicit VERSION.
END
}
sub M40_usage_install_badname {
my ($name, $pkg) = @_;
return <<END;
The NAME '$name' is illegal for this Inline extension.
The NAME must match the current package name:
$pkg
END
}
sub M41_usage_install_version_mismatch {
my ($mod_name, $mod_ver, $ext_name, $ext_ver) = @_;
<<END;
The version '$mod_ver' for module '$mod_name' doe not match
the version '$ext_ver' for Inline section '$ext_name'.
END
}
sub M42_usage_loader {
return <<END;
ERROR. The loader that was invoked is for compiled languages only.
END
}
sub M43_error_bootstrap {
my ($mod, $err) = @_;
return <<END;
Had problems bootstrapping Inline module '$mod'
$err
END
}
sub M45_usage_with {
return <<END;
Syntax error detected using 'use Inline with ...'.
Should be specified as:
use Inline with => 'module1', 'module2', ..., 'moduleN';
END
}
sub M46_usage_with_bad {
my $mod = shift;
return <<END;
Syntax error detected using 'use Inline with => "$mod";'.
'$mod' could not be found.
END
}
sub M47_invalid_config_option {
my ($option) = @_;
return <<END;
Invalid Config option '$option'
END
#'
}
sub M48_usage_shortcuts {
my ($shortcut) = @_;
return <<END;
Invalid shortcut '$shortcut' specified.
Valid shortcuts are:
VERSION, INFO, FORCE, NOCLEAN, CLEAN, UNTAINT, SAFE, UNSAFE,
GLOBAL, NOISY and REPORTBUG
END
}
sub M49_usage_unsafe {
my ($terminate) = @_;
return <<END .
You are using the Inline.pm module with the UNTAINT and SAFEMODE options,
but without specifying the DIRECTORY option. This is potentially unsafe.
Either use the DIRECTORY option or turn off SAFEMODE.
END
($terminate ? <<END : "");
Since you are running as a privileged user, Inline.pm is terminating.
END
}
sub M51_unused_DATA {
return <<END;
One or more DATA sections were not processed by Inline.
END
}
sub M52_invalid_filter {
my ($filter) = @_;
return <<END;
Invalid filter '$filter' is not a reference.
END
}
sub M53_mkdir_failed {
my ($dir) = @_;
return <<END;
Couldn't make directory path '$dir'.
END
#'
}
sub M54_rmdir_failed {
my ($dir) = @_;
return <<END;
Can't remove directory '$dir':
$!
END
#'
}
sub M55_unlink_failed {
my ($file) = @_;
return <<END;
Can't unlink file '$file':
$!
END
#'
}
sub M56_no_DIRECTORY_found {
return <<END;
Couldn't find an appropriate DIRECTORY for Inline to use.
END
#'
}
sub M57_wrong_architecture {
my ($ext, $arch, $thisarch) = @_;
return <<END;
The extension '$ext'
is built for perl on the '$arch' platform.
This is the '$thisarch' platform.
END
}
( run in 1.217 second using v1.01-cache-2.11-cpan-63c85eba8c4 )