Acme-MITHALDU-XSGrabBag
view release on metacpan or search on metacpan
inc/Inline.pm view on Meta::CPAN
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:
inc/Inline.pm view on Meta::CPAN
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;
}
#==============================================================================
inc/Inline.pm view on Meta::CPAN
}
# 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.
#==============================================================================
inc/Inline.pm view on Meta::CPAN
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"));
inc/Inline/C.pm view on Meta::CPAN
$o->preprocess;
$o->parse;
if (defined $o->{ILSM}{parser}{data}{functions}) {
$text .= "The following Inline $o->{API}{language} function(s) have been successfully bound to Perl:\n";
my $parser = $o->{ILSM}{parser};
my $data = $parser->{data};
for my $function (sort @{$data->{functions}}) {
my $return_type = $data->{function}{$function}{return_type};
my @arg_names = @{$data->{function}{$function}{arg_names}};
my @arg_types = @{$data->{function}{$function}{arg_types}};
my @args = map {$_ . ' ' . shift @arg_names} @arg_types;
$text .= "\t$return_type $function(" . join(', ', @args) . ")\n";
}
}
else {
$text .= "No $o->{API}{language} functions have been successfully bound to Perl.\n\n";
}
$text .= Inline::Struct::info($o) if $o->{STRUCT}{'.any'};
return $text;
}
inc/Inline/C.pm view on Meta::CPAN
if $o->{CONFIG}{BUILD_TIMERS};
print STDERR "\n" if $o->{CONFIG}{BUILD_NOISY};
}
#==============================================================================
# Apply any
#==============================================================================
sub preprocess {
my $o = shift;
return if $o->{ILSM}{parser};
$o->get_maps;
$o->get_types;
$o->{ILSM}{code} = $o->filter(@{$o->{ILSM}{FILTERS}});
}
#==============================================================================
# Parse the function definition information out of the C code
#==============================================================================
sub parse {
my $o = shift;
return if $o->{ILSM}{parser};
inc/Inline/C.pm view on Meta::CPAN
# Create and initialize a parser
sub get_parser {
my $o = shift;
Inline::C::_parser_test($o->{CONFIG}{DIRECTORY}, "Inline::C::get_parser called\n")
if $o->{CONFIG}{_TESTING};
require Inline::C::Parser::RecDescent;
Inline::C::Parser::RecDescent::get_parser($o);
}
#==============================================================================
# Gather the path names of all applicable typemap files.
#==============================================================================
sub get_maps {
my $o = shift;
print STDERR "get_maps Stage\n" if $o->{CONFIG}{BUILD_NOISY};
my $typemap = '';
my $file;
$file = File::Spec->catfile(
$Config::Config{installprivlib},
"ExtUtils",
"typemap",
);
$typemap = $file if -f $file;
$file = File::Spec->catfile(
$Config::Config{privlibexp}
,"ExtUtils","typemap"
);
$typemap = $file
if (not $typemap and -f $file);
warn "Can't find the default system typemap file"
if (not $typemap and $^W);
unshift(@{$o->{ILSM}{MAKEFILE}{TYPEMAPS}}, $typemap) if $typemap;
if (not $o->UNTAINT) {
require FindBin;
$file = File::Spec->catfile($FindBin::Bin,"typemap");
if ( -f $file ) {
push(@{$o->{ILSM}{MAKEFILE}{TYPEMAPS}}, $file);
}
}
}
#==============================================================================
# This routine parses XS typemap files to get a list of valid types to create
# bindings to. This code is mostly hacked out of Larry Wall's xsubpp program.
#==============================================================================
sub get_types {
my (%type_kind, %proto_letter, %input_expr, %output_expr);
my $o = shift;
local $_;
croak "No typemaps specified for Inline C code"
unless @{$o->{ILSM}{MAKEFILE}{TYPEMAPS}};
my $proto_re = "[" . quotemeta('\$%&*@;') . "]";
foreach my $typemap (@{$o->{ILSM}{MAKEFILE}{TYPEMAPS}}) {
next unless -e $typemap;
# skip directories, binary files etc.
warn("Warning: ignoring non-text typemap file '$typemap'\n"), next
unless -T $typemap;
open(TYPEMAP, $typemap)
or warn ("Warning: could not open typemap file '$typemap': $!\n"),
next;
my $mode = 'Typemap';
my $junk = "";
my $current = \$junk;
while (<TYPEMAP>) {
next if /^\s*\#/;
my $line_no = $. + 1;
if (/^INPUT\s*$/) {$mode = 'Input'; $current = \$junk; next}
if (/^OUTPUT\s*$/) {$mode = 'Output'; $current = \$junk; next}
if (/^TYPEMAP\s*$/) {$mode = 'Typemap'; $current = \$junk; next}
if ($mode eq 'Typemap') {
chomp;
my $line = $_;
TrimWhitespace($_);
# skip blank lines and comment lines
next if /^$/ or /^\#/;
my ($type,$kind, $proto) =
/^\s*(.*?\S)\s+(\S+)\s*($proto_re*)\s*$/ or
warn("Warning: File '$typemap' Line $. '$line' TYPEMAP entry needs 2 or 3 columns\n"), next;
$type = TidyType($type);
$type_kind{$type} = $kind;
# prototype defaults to '$'
$proto = "\$" unless $proto;
warn("Warning: File '$typemap' Line $. '$line' Invalid prototype '$proto'\n")
unless ValidProtoString($proto);
$proto_letter{$type} = C_string($proto);
}
elsif (/^\s/) {
$$current .= $_;
}
elsif ($mode eq 'Input') {
s/\s+$//;
$input_expr{$_} = '';
$current = \$input_expr{$_};
}
else {
s/\s+$//;
$output_expr{$_} = '';
$current = \$output_expr{$_};
}
}
close(TYPEMAP);
}
my %valid_types = map {($_, 1)} grep {
defined $input_expr{$type_kind{$_}}
} keys %type_kind;
my %valid_rtypes = map {($_, 1)} (
grep {
defined $output_expr{$type_kind{$_}}
} keys %type_kind
), 'void';
$o->{ILSM}{typeconv}{type_kind} = \%type_kind;
$o->{ILSM}{typeconv}{input_expr} = \%input_expr;
$o->{ILSM}{typeconv}{output_expr} = \%output_expr;
$o->{ILSM}{typeconv}{valid_types} = \%valid_types;
$o->{ILSM}{typeconv}{valid_rtypes} = \%valid_rtypes;
inc/Inline/C.pm view on Meta::CPAN
}
#==============================================================================
# Generate the Makefile.PL
#==============================================================================
sub write_Makefile_PL {
my $o = shift;
$o->{ILSM}{xsubppargs} = '';
my $i = 0;
for (@{$o->{ILSM}{MAKEFILE}{TYPEMAPS}}) {
$o->{ILSM}{xsubppargs} .= "-typemap \"$_\" ";
}
my %options = (
VERSION => $o->{API}{version} || '0.00',
%{$o->{ILSM}{MAKEFILE}},
NAME => $o->{API}{module},
);
open MF, "> ".File::Spec->catfile($o->{API}{build_dir},"Makefile.PL")
or croak;
inc/Inline/C.pm view on Meta::CPAN
sub cleanup {
my ($o) = @_;
my ($modpname, $modfname, $install_lib) =
@{$o->{API}}{qw(modpname modfname install_lib)};
if ($o->{API}{cleanup}) {
$o->rmpath(
File::Spec->catdir($o->{API}{directory},'build'),
$modpname
);
my $autodir = File::Spec->catdir($install_lib,'auto',$modpname);
my @files = ( ".packlist", map "$modfname.$_", qw( bs exp lib ) );
my @paths = grep { -e } map { File::Spec->catfile($autodir,$_) } @files;
unlink($_) || die "Can't delete file $_: $!" for @paths;
}
}
sub system_call {
my ($o, $cmd, $output_file) = @_;
my $build_noisy = defined $ENV{PERL_INLINE_BUILD_NOISY}
? $ENV{PERL_INLINE_BUILD_NOISY}
: $o->{CONFIG}{BUILD_NOISY};
# test this functionality with:
inc/Inline/C/Parser/RegExp.pm view on Meta::CPAN
# The order of these _does_ matter.
$code =~ s/$RE_comment_C/ /go;
$code =~ s/$RE_comment_Cpp/ /go;
$code =~ s/^\#.*(\\\n.*)*//mgo;
#$code =~ s/$RE_quoted/\"\"/go; # Buggy, if included.
$code =~ s/$RE_balanced_brackets/{ }/go;
$self->{_the_code_most_recently_parsed} = $code; # Simplifies debugging.
my $normalize_type = sub {
# Normalize a type for lookup in a typemap.
my($type) = @_;
# Remove "extern".
# But keep "static", "inline", "typedef", etc,
# to cause desirable typemap misses.
$type =~ s/\bextern\b//g;
# Whitespace: only single spaces, none leading or trailing.
$type =~ s/\s+/ /g;
$type =~ s/^\s//; $type =~ s/\s$//;
# Adjacent "derivative characters" are not separated by whitespace,
# but _are_ separated from the adjoining text.
# [ Is really only * (and not ()[]) needed??? ]
$type =~ s/\*\s\*/\*\*/g;
inc/Inline/Module.pm view on Meta::CPAN
}
#------------------------------------------------------------------------------
# Worker methods.
#------------------------------------------------------------------------------
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};
( run in 0.621 second using v1.01-cache-2.11-cpan-49f99fa48dc )