use Cwd
qw(cwd abs_path);
@Inline::C
::ISA
= qw(Inline);
#==============================================================================
# Register this module as an Inline language support module
#==============================================================================
# XXX Breaking this on purpose; let's see who screams
suffix
=> $Config{dlext
},
#==============================================================================
# Validate the C config options
#==============================================================================
The value of config option '$key' must be a string or an array ref
$o->{ILSM
}{MAKEFILE
} ||= {};
$o->{ILSM
}{MAKEFILE
}{INC
} = "-I$FindBin::Bin";
$o->{ILSM
}{AUTOWRAP
} = 0 if not defined $o->{ILSM
}{AUTOWRAP
};
$o->{ILSM
}{XSMODE
} = 0 if not defined $o->{ILSM
}{XSMODE
};
$o->{ILSM
}{AUTO_INCLUDE
} ||= <<END;
$o->{ILSM
}{FILTERS
} ||= [];
my ($key, $value) = (shift, shift);
$o->{ILSM
}{$key} = $value;
$o->{ILSM
}{MAKEFILE
}{$key} = $value;
$o->add_list($o->{ILSM
}{MAKEFILE
}, $key, $value, []);
$o->add_string($o->{ILSM
}{MAKEFILE
}, $key, $value, '');
if ($key eq 'TYPEMAPS') {
croak
"TYPEMAPS file '$value' not found"
$value = File
::Spec
->rel2abs($value);
$o->add_list($o->{ILSM
}{MAKEFILE
}, $key, $value, []);
if ($key eq 'AUTO_INCLUDE') {
$o->add_text($o->{ILSM
}, $key, $value, '');
$o->add_text($o->{ILSM
}{XS
}, $key, $value, '');
croak
"Invalid value for 'PREFIX' option"
unless ($value =~ /^\w*$/ and
$o->{ILSM
}{XS
}{PREFIX
} = $value;
next if $value eq '1' or $value eq '0'; # ignore ENABLE, DISABLE
$value = [$value] unless ref($value) eq 'ARRAY';
if (ref($val) eq 'CODE') {
$o->add_list($o->{ILSM
}, $key, $val, []);
eval { require Inline
::Filters
};
croak
"'FILTERS' option requires Inline::Filters to be installed."
%filters = Inline
::Filters
::get_filters
($o->{API
}{language
})
if (defined $filters{$val}) {
my $filter = Inline
::Filters
->new($val,
$o->add_list($o->{ILSM
}, $key, $filter, []);
croak
"Invalid filter $val specified.";
if (ref($value) eq 'ARRAY') {
croak
"Invalid value for 'STRUCTS' option"
unless ($val =~ /^[_a-z][_0-9a-z]*$/i);
elsif ($value =~ /^\d+$/) {
$o->{STRUCT
}{'.any'} = $value;
croak
"Invalid value for 'STRUCTS' option"
unless ($value =~ /^[_a-z][_0-9a-z]*$/i);
eval { require Inline
::Struct
};
croak
"'STRUCTS' option requires Inline::Struct to be installed."
$o->{STRUCT
}{'.any'} = 1;
my $class = ref $o; # handles subclasses correctly.
croak
"'$key' is not a valid config option for $class\n";
my ($ref, $key, $value, $default) = @_;
$value = [$value] unless ref $value eq 'ARRAY';
push @
{$ref->{$key}}, $_;
my ($ref, $key, $value, $default) = @_;
$value = [$value] unless ref $value;
croak usage_validate
($key) unless ref($value) eq 'ARRAY';
$ref->{$key} .= ' ' . $_;
my ($ref, $key, $value, $default) = @_;
$value = [$value] unless ref $value;
croak usage_validate
($key) unless ref($value) eq 'ARRAY';
$ref->{$key} .= $_ . "\n";
#==============================================================================
# Return a small report about the C code..
#==============================================================================
return <<END if $o->{ILSM}{XSMODE};
No information is currently generated when using XSMODE.
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";
$text .= "No $o->{API}{language} functions have been successfully bound to Perl.\n\n";
$text .= Inline
::Struct
::info
($o) if $o->{STRUCT
}{'.any'};
#==============================================================================
# Parse and compile C code
#==============================================================================
if ($o->{CONFIG
}{BUILD_TIMERS
}) {
eval {require Time
::HiRes
};
croak
"You need Time::HiRes for BUILD_TIMERS option:\n$@" if $@
;
$total_build_time = Time
::HiRes
::time();
$o->call('preprocess', 'Build Prepocess');
$o->call('parse', 'Build Parse');
$o->call('write_XS', 'Build Glue 1');
$o->call('write_Inline_headers', 'Build Glue 2');
$o->call('write_Makefile_PL', 'Build Glue 3');
$o->call('compile', 'Build Compile');
if ($o->{CONFIG
}{BUILD_TIMERS
}) {
$total_build_time = Time
::HiRes
::time() - $total_build_time;
printf STDERR
"Total Build Time: %5.4f secs\n", $total_build_time;
my ($o, $method, $header, $indent) = (@_, 0);
print STDERR
"${i}Starting $header Stage\n" if $o->{CONFIG
}{BUILD_NOISY
};
$time = Time
::HiRes
::time()
if $o->{CONFIG
}{BUILD_TIMERS
};
$time = Time
::HiRes
::time() - $time
if $o->{CONFIG
}{BUILD_TIMERS
};
print STDERR
"${i}Finished $header Stage\n" if $o->{CONFIG
}{BUILD_NOISY
};
printf STDERR
"${i}Time for $header Stage: %5.4f secs\n", $time
if $o->{CONFIG
}{BUILD_TIMERS
};
print STDERR
"\n" if $o->{CONFIG
}{BUILD_NOISY
};
#==============================================================================
#==============================================================================
return if $o->{ILSM
}{parser
};
$o->{ILSM
}{code
} = $o->filter(@
{$o->{ILSM
}{FILTERS
}});
#==============================================================================
# Parse the function definition information out of the C code
#==============================================================================
return if $o->{ILSM
}{parser
};
return if $o->{ILSM
}{XSMODE
};
my $parser = $o->{ILSM
}{parser
} = $o->get_parser;
$parser->{data
}{typeconv
} = $o->{ILSM
}{typeconv
};
$parser->{data
}{AUTOWRAP
} = $o->{ILSM
}{AUTOWRAP
};
Inline
::Struct
::parse
($o) if $o->{STRUCT
}{'.any'};
$parser->code($o->{ILSM
}{code
})
Bad $o->{API}{language} code passed to Inline at @{[caller(2)]}
# Create and initialize a parser
require Inline
::C
::ParseRecDescent
;
Inline
::C
::ParseRecDescent
::get_parser
($o);
#==============================================================================
# Gather the path names of all applicable typemap files.
#==============================================================================
$file = File
::Spec
->catfile($Config::Config
{installprivlib
},"ExtUtils","typemap");
$typemap = $file if -f
$file;
$file = File
::Spec
->catfile($Config::Config
{privlibexp
} ,"ExtUtils","typemap");
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;
$file = File
::Spec
->catfile($FindBin::Bin
,"typemap");
push(@
{$o->{ILSM
}{MAKEFILE
}{TYPEMAPS
}}, $file) if -f
$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.
#==============================================================================
my (%type_kind, %proto_letter, %input_expr, %output_expr);
croak
"No typemaps specified for Inline C code"
unless @
{$o->{ILSM
}{MAKEFILE
}{TYPEMAPS
}};
my $proto_re = "[" . quotemeta('\$%&*@;') . "]";
foreach my $typemap (@
{$o->{ILSM
}{MAKEFILE
}{TYPEMAPS
}}) {
# skip directories, binary files etc.
warn("Warning: ignoring non-text typemap file '$typemap'\n"), next
or warn ("Warning: could not open typemap file '$typemap': $!\n"), next;
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') {
# skip blank lines and comment lines
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_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 ($mode eq 'Input') {
$current = \
$input_expr{$_};
$current = \
$output_expr{$_};
grep {defined $input_expr{$type_kind{$_}}}
(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;
sub ValidProtoString
($) {
my $proto_re = "[" . quotemeta('\$%&*@;') . "]";
return ($string =~ /^$proto_re+$/) ?
$string : 0;
$_[0] =~ s/^\s+|\s+$//go;
(my $string = shift) =~ s
|\\|\\\\|g
;
#==============================================================================
#==============================================================================
my $modfname = $o->{API
}{modfname
};
my $module = $o->{API
}{module
};
$o->mkpath($o->{API
}{build_dir
});
open XS
, "> ".File
::Spec
->catfile($o->{API
}{build_dir
},"$modfname.xs")
if ($o->{ILSM
}{XSMODE
}) {
warn <<END if $^W and $o->{ILSM}{code} !~ /MODULE\s*=\s*$module\b/;
While using Inline XSMODE, your XS code does not have a line with
You should use the Inline NAME config option, and it should match the
print XS
$o->xs_generate;
#==============================================================================
# Generate the XS glue code (piece together lots of snippets)
#==============================================================================
return join '', ($o->xs_includes,
return $o->{ILSM
}{AUTO_INCLUDE
};
return $o->{STRUCT
}{'.macros'};
return $o->{STRUCT
}{'.xs'};
if (defined $o->{ILSM
}{XS
}{BOOT
} and
my ($pkg, $module) = @
{$o->{API
}}{qw(pkg module)};
my $prefix = (($o->{ILSM
}{XS
}{PREFIX
}) ?
"PREFIX = $o->{ILSM}{XS}{PREFIX}" :
MODULE = $module PACKAGE = $pkg $prefix
my $parser = $o->{ILSM
}{parser
};
my $data = $parser->{data
};
warn("Warning. No Inline C functions bound to Perl\n" .
"Check your C function definition(s) for Inline compatibility\n\n")
if ((not defined$data->{functions
}) and ($^W
));
for my $function (@
{$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
}};
$XS .= join '', ("\n$return_type\n$function (",
join(', ', @arg_names), ")\n");
for my $arg_name (@arg_names) {
my $arg_type = shift @arg_types;
last if $arg_type eq '...';
$XS .= "\t$arg_type\t$arg_name\n";
$listargs = pop @arg_names if (@arg_names and
$arg_names[-1] eq '...');
my $arg_name_list = join(', ', @arg_names);
if ($return_type eq 'void') {
temp = PL_markstack_ptr++;
$function($arg_name_list);
if (PL_markstack_ptr != temp) {
/* truly void, because dXSARGS not invoked */
XSRETURN_EMPTY; /* return empty stack */
/* must have used dXSARGS; list context implied */
return; /* assume stack size is correct */
temp = PL_markstack_ptr++;
RETVAL = $function($arg_name_list);
#==============================================================================
# Generate the INLINE.h file.
#==============================================================================
sub write_Inline_headers
{
open HEADER
, "> ".File
::Spec
->catfile($o->{API
}{build_dir
},"INLINE.h")
#define Inline_Stack_Vars dXSARGS
#define Inline_Stack_Items items
#define Inline_Stack_Item(x) ST(x)
#define Inline_Stack_Reset sp = mark
#define Inline_Stack_Push(x) XPUSHs(x)
#define Inline_Stack_Done PUTBACK
#define Inline_Stack_Return(x) XSRETURN(x)
#define Inline_Stack_Void XSRETURN(0)
#define INLINE_STACK_VARS Inline_Stack_Vars
#define INLINE_STACK_ITEMS Inline_Stack_Items
#define INLINE_STACK_ITEM(x) Inline_Stack_Item(x)
#define INLINE_STACK_RESET Inline_Stack_Reset
#define INLINE_STACK_PUSH(x) Inline_Stack_Push(x)
#define INLINE_STACK_DONE Inline_Stack_Done
#define INLINE_STACK_RETURN(x) Inline_Stack_Return(x)
#define INLINE_STACK_VOID Inline_Stack_Void
#define inline_stack_vars Inline_Stack_Vars
#define inline_stack_items Inline_Stack_Items
#define inline_stack_item(x) Inline_Stack_Item(x)
#define inline_stack_reset Inline_Stack_Reset
#define inline_stack_push(x) Inline_Stack_Push(x)
#define inline_stack_done Inline_Stack_Done
#define inline_stack_return(x) Inline_Stack_Return(x)
#define inline_stack_void Inline_Stack_Void
#==============================================================================
# Generate the Makefile.PL
#==============================================================================
$o->{ILSM
}{xsubppargs
} = '';
for (@
{$o->{ILSM
}{MAKEFILE
}{TYPEMAPS
}}) {
$o->{ILSM
}{xsubppargs
} .= "-typemap $_ ";
VERSION
=> $o->{API
}{version
} || '0.00',
NAME
=> $o->{API
}{module
},
open MF
, "> ".File
::Spec
->catfile($o->{API
}{build_dir
},"Makefile.PL")
local $Data::Dumper
::Terse
= 1;
local $Data::Dumper
::Indent
= 1;
print MF Data
::Dumper
::Dumper
(\
%options);
WriteMakefile(\%options);
# Remove the Makefile dependency. Causes problems on a few systems.
#==============================================================================
#==============================================================================
my $build_dir = $o->{API
}{build_dir
};
($cwd) = $cwd =~ /(.*)/ if $o->UNTAINT;
$o->call('makefile_pl', '"perl Makefile.PL"', 2);
$o->call('make', '"make"', 2);
$o->call('make_install', '"make install"', 2);
$o->call('cleanup', 'Cleaning Up', 2);
-f
($perl = $Config::Config
{perlpath
})
or croak
"Can't locate your perl binary";
$o->system_call("$perl Makefile.PL", 'out.Makefile_PL');
my $make = $o->{ILSM
}{MAKE
} || $Config::Config
{make
}
or croak
"Can't locate your make binary";
$o->system_call("$make", 'out.make');
my $make = $o->{ILSM
}{MAKE
} || $Config::Config
{make
}
or croak
"Can't locate your make binary";
$o->system_call("$make pure_install", 'out.make_install');
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'),
my $autodir = File
::Spec
->catdir($install_lib,'auto',$modpname);
unlink (File
::Spec
->catfile($autodir,'.packlist'),
File
::Spec
->catfile($autodir,'$modfname.bs'),
File
::Spec
->catfile($autodir,'$modfname.exp'), #MSWin32
File
::Spec
->catfile($autodir,'$modfname.lib'), #MSWin32
my ($o, $cmd, $output_file) = @_;
defined $ENV{PERL_INLINE_BUILD_NOISY
}
?
$ENV{PERL_INLINE_BUILD_NOISY
}
: $o->{CONFIG
}{BUILD_NOISY
};
$cmd = "$cmd > $output_file 2>&1";
($cmd) = $cmd =~ /(.*)/ if $o->UNTAINT;
or croak
($o->build_error_message($cmd, $output_file, $build_noisy));
sub build_error_message
{
my ($o, $cmd, $output_file, $build_noisy) = @_;
my $build_dir = $o->{API
}{build_dir
};
open(OUTPUT
, $output_file)
A problem was encountered while attempting to compile and install your Inline
$o->{API}{language} code. The command that failed was:
To debug the problem, cd to the build directory, and inspect the output files.
#==============================================================================
# This routine fixes problems with the MakeMaker Makefile.
#==============================================================================
INSTALLSITEARCH
=> 'install_lib',
INSTALLDIRS
=> 'installdirs',
XSUBPPARGS
=> 'xsubppargs',
INSTALLSITELIB
=> 'install_lib',
$o->{ILSM
}{install_lib
} = $o->{API
}{install_lib
};
$o->{ILSM
}{installdirs
} = 'site';
open(MAKEFILE
, '< Makefile')
or croak
"Can't open Makefile for input: $!\n";
open(MAKEFILE
, '> Makefile')
or croak
"Can't open Makefile for output: $!\n";
if (/^(\w+)\s*=\s*\S+.*$/ and
print MAKEFILE
"$1 = $o->{ILSM}{$fix}\n"