/usr/local/CPAN/Inline-CPR/Inline/CPR.pm
package Inline::CPR;
use strict;
require Inline;
use Data::Dumper;
use FindBin;
use Config;
use Carp;
use Cwd;
$Inline::CPR::VERSION = '0.12';
@Inline::CPR::ISA = qw(Inline);
#==============================================================================
# Register this module as an Inline language support module
#==============================================================================
sub register {
return {
language => 'CPR',
type => 'compiled',
suffix => $Config{so},
};
}
#==============================================================================
# Validate the CPR config options
#==============================================================================
sub validate {
my $o = shift;
while (@_) {
my ($key, $value) = (shift, shift);
if ($key eq 'LIBS') {
push(@{$o->{ILSM}{makefile}{LIBS}},
(ref $value) ? (@$value) : ($value));
next;
}
if ($key eq 'INC') {
$o->{ILSM}{makefile}{INC} = $value;
next;
}
if ($key eq 'MYEXTLIB') {
$o->{ILSM}{makefile}{MYEXTLIB} .= ' ' . $value;
next;
}
if ($key eq 'LDFROM') {
$o->{ILSM}{makefile}{LDFROM} = $value;
next;
}
if ($key eq 'TYPEMAPS') {
push(@{$o->{ILSM}{makefile}{TYPEMAPS}},
(ref $value) ? (@$value) : ($value));
next;
}
if ($key eq 'AUTO_INCLUDE') {
chomp($value);
$o->{ILSM}{AUTO_INCLUDE} .= $value . "\n";
next;
}
croak "$key is not a valid config option for CPR\n";
}
}
#==============================================================================
# Parse and compile CPR code
#==============================================================================
sub build {
my $o = shift;
$o->config;
$o->parse;
$o->write_XS;
$o->write_CPR_headers;
$o->write_Makefile_PL;
$o->compile;
}
#==============================================================================
# Return a small report about the CPR code..
#==============================================================================
sub info {
my $o = shift;
my $text = '';
$o->parse unless $o->{ILSM}{parser};
if (defined $o->{ILSM}{parser}{data}{functions}) {
}
else {
$text .= "No $o->{API}{language} functions have been successfully bound to Perl.\n\n";
}
return $text;
}
sub config {
my $o = shift;
$o->{ILSM}{auto_include} ||= <<END;
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "CPR.h"
END
}
#==============================================================================
# Parse the function definition information out of the CPR code
#==============================================================================
sub parse {
my $o = shift;
# return if $o->{ILSM}{parser};
$o->{API}{code} =~
s!int\s*main\s*\(\s*void\s*\)\s*\{!int cpr_main(void) {!ms;
}
#==============================================================================
# Generate the XS glue code
#==============================================================================
sub write_XS {
my $o = shift;
my ($pkg, $module, $modfname) = @{$o->{API}}{qw(pkg module modfname)};
$o->{ILSM}{AUTO_INCLUDE} ||= '';
$o->mkpath($o->{API}{build_dir});
open XS, "> $o->{API}{build_dir}/$modfname.xs"
or croak $!;
print XS <<END;
$o->{ILSM}{auto_include}
$o->{ILSM}{AUTO_INCLUDE}
$o->{API}{code}
MODULE = $module PACKAGE = $pkg
PROTOTYPES: DISABLE
int
cpr_main()
END
close XS;
}
#==============================================================================
# Generate the INLINE.h file.
#==============================================================================
sub write_CPR_headers {
my $o = shift;
open HEADER, "> $o->{API}{build_dir}/CPR.h"
or croak;
print HEADER <<'END';
#define CPR_eval(x) SvPVX(perl_eval_pv(x, 1))
END
close HEADER;
}
#==============================================================================
# Generate the Makefile.PL
#==============================================================================
sub write_Makefile_PL {
my $o = shift;
$o->{ILSM}{makefile} ||= {};
my %options = (
VERSION => '0.00',
%{$o->{ILSM}{makefile}},
NAME => $o->{API}{module},
);
open MF, "> $o->{API}{build_dir}/Makefile.PL"
or croak;
print MF <<END;
use ExtUtils::MakeMaker;
my %options = %\{
END
local $Data::Dumper::Terse = 1;
local $Data::Dumper::Indent = 1;
print MF Data::Dumper::Dumper(\ %options);
print MF <<END;
\};
WriteMakefile(\%options);
END
close MF;
}
#==============================================================================
# Run the build process.
#==============================================================================
sub compile {
my ($o, $perl, $make, $cmd, $cwd);
$o = shift;
my ($module, $modpname, $modfname, $build_dir, $install_lib) =
@{$o->{API}}{qw(module modpname modfname build_dir install_lib)};
-f ($perl = $Config::Config{perlpath})
or croak "Can't locate your perl binary";
($make = $Config::Config{make})
or croak "Can't locate your make binary";
$cwd = &cwd;
for $cmd ("$perl Makefile.PL > out.Makefile_PL 2>&1",
\ &fix_make, # Fix Makefile problems
"$make > out.make 2>&1",
"$make install > out.make_install 2>&1",
) {
if (ref $cmd) {
$o->$cmd();
}
else {
chdir $build_dir;
system($cmd) and do {
# $o->error_copy;
croak <<END;
A problem was encountered while attempting to compile and install your Inline
$o->{API}{language} code. The command that failed was:
$cmd
The build directory was:
$build_dir
To debug the problem, cd to the build directory, and inspect the output files.
END
};
chdir $cwd;
}
}
if ($o->{API}{cleanup}) {
$o->rmpath($o->{API}{directory} . '/build/', $modpname);
unlink "$install_lib/auto/$modpname/.packlist";
unlink "$install_lib/auto/$modpname/$modfname.bs";
unlink "$install_lib/auto/$modpname/$modfname.exp"; #MSWin32 VC++
unlink "$install_lib/auto/$modpname/$modfname.lib"; #MSWin32 VC++
}
}
#==============================================================================
# This routine fixes problems with the MakeMaker Makefile.
# Yes, it is a kludge, but it is a necessary one.
#
# ExtUtils::MakeMaker cannot be trusted. It has extremely flaky behaviour
# between releases and platforms. I have been burned several times.
#
# Doing this actually cleans up other code that was trying to guess what
# MM would do. This method will always work.
# And, at least this only needs to happen at build time, when we are taking
# a performance hit anyway!
#==============================================================================
my %fixes = (
INSTALLSITEARCH => 'install_lib',
INSTALLDIRS => 'installdirs',
);
sub fix_make {
use strict;
my (@lines, $fix);
my $o = shift;
$o->{ILSM}{install_lib} = $o->{API}{install_lib};
$o->{ILSM}{installdirs} = 'site';
open(MAKEFILE, "< $o->{API}{build_dir}/Makefile")
or croak "Can't open Makefile for input: $!\n";
@lines = <MAKEFILE>;
close MAKEFILE;
open(MAKEFILE, "> $o->{API}{build_dir}/Makefile")
or croak "Can't open Makefile for output: $!\n";
for (@lines) {
if (/^(\w+)\s*=\s*\S+.*$/ and
$fix = $fixes{$1}
) {
print MAKEFILE "$1 = $o->{ILSM}{$fix}\n"
}
else {
print MAKEFILE;
}
}
close MAKEFILE;
}
1;
__END__