view release on metacpan or  search on metacpan

inc/Inline/C.pm  view on Meta::CPAN

use strict; use warnings;
package Inline::C;
our $VERSION = '0.68';

use Inline 0.56;
use Config;
use Data::Dumper;
use Carp;
use Cwd qw(cwd abs_path);
use File::Spec;
use Fcntl ':flock';

our @ISA = qw(Inline);

#==============================================================================
# Register this module as an Inline language support module
#==============================================================================
sub register {
    return {
        language => 'C',
        # XXX Breaking this on purpose; let's see who screams
        # aliases => ['c'],
        type => 'compiled',
        suffix => $Config{dlext},
    };
}

#==============================================================================
# Validate the C config options
#==============================================================================
sub usage_validate {
    my $key = shift;
    return <<END;
The value of config option '$key' must be a string or an array ref

END
}

sub validate {
    my $o = shift;

    print STDERR "validate Stage\n" if $o->{CONFIG}{BUILD_NOISY};
    $o->{ILSM} ||= {};
    $o->{ILSM}{XS} ||= {};
    $o->{ILSM}{MAKEFILE} ||= {};
    if (not $o->UNTAINT) {
        require FindBin;
        $o->{ILSM}{MAKEFILE}{INC} = "-I\"$FindBin::Bin\""
            if not defined $o->{ILSM}{MAKEFILE}{INC};
    }
    $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;
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "INLINE.h"
END
    $o->{ILSM}{FILTERS} ||= [];
    $o->{STRUCT} ||= {
        '.macros' => '',
        '.xs' => '',
        '.any' => 0,
        '.all' => 0,
    };

    while (@_) {
        my ($key, $value) = (shift, shift);
        if ($key eq 'PRE_HEAD') {
            unless( -f $value) {
                $o->{ILSM}{AUTO_INCLUDE} = $value . "\n" .
                $o->{ILSM}{AUTO_INCLUDE};
            }
            else {
                my $insert;
                open RD, '<', $value
                    or die "Couldn't open $value for reading: $!";
                while (<RD>) {$insert .= $_}
                close RD
                    or die "Couldn't close $value after reading: $!";
                $o->{ILSM}{AUTO_INCLUDE} =
                    $insert . "\n" . $o->{ILSM}{AUTO_INCLUDE};
            }
            next;
        }
        if ($key eq 'MAKE' or
            $key eq 'AUTOWRAP' or
            $key eq 'XSMODE'
        ) {
            $o->{ILSM}{$key} = $value;
            next;
        }
        if ($key eq 'CC' or
            $key eq 'LD'
        ) {
            $o->{ILSM}{MAKEFILE}{$key} = $value;
            next;
        }
        if ($key eq 'LIBS') {
            $o->add_list($o->{ILSM}{MAKEFILE}, $key, $value, []);
            next;
        }

inc/Inline/C.pm  view on Meta::CPAN

        if ($key eq 'STRUCTS') {
            # A list of struct names
            if (ref($value) eq 'ARRAY') {
                for my $val (@$value) {
                    croak "Invalid value for 'STRUCTS' option"
                        unless ($val =~ /^[_a-z][_0-9a-z]*$/i);
                    $o->{STRUCT}{$val}++;
                }
            }
            # Enable or disable
            elsif ($value =~ /^\d+$/) {
                $o->{STRUCT}{'.any'} = $value;
            }
            # A single struct name
            else {
                croak "Invalid value for 'STRUCTS' option"
                    unless ($value =~ /^[_a-z][_0-9a-z]*$/i);
                $o->{STRUCT}{$value}++;
            }
            eval { require Inline::Struct };
            croak "'STRUCTS' option requires Inline::Struct to be installed."
                if $@;
            $o->{STRUCT}{'.any'} = 1;
            next;
        }
        if ($key eq 'PROTOTYPES') {
            $o->{CONFIG}{PROTOTYPES} = $value;
            next if $value eq 'ENABLE';
            next if $value eq 'DISABLE';
            die "PROTOTYPES can be only either 'ENABLE' or 'DISABLE' - not $value";
        }
        if ($key eq 'PROTOTYPE') {
            die "PROTOTYPE configure arg must specify a hash reference"
                unless ref($value) eq 'HASH';
            $o->{CONFIG}{PROTOTYPE} = $value;
            next;
        }
        my $class = ref $o; # handles subclasses correctly.
        croak "'$key' is not a valid config option for $class\n";
    }
}

sub add_list {
    my $o = shift;
    my ($ref, $key, $value, $default) = @_;
    $value = [$value] unless ref $value eq 'ARRAY';
    for (@$value) {
        if (defined $_) {
            push @{$ref->{$key}}, $_;
        }
        else {
            $ref->{$key} = $default;
        }
    }
}

sub add_string {
    my $o = shift;
    my ($ref, $key, $value, $default) = @_;
    $value = [$value] unless ref $value;
    croak usage_validate($key) unless ref($value) eq 'ARRAY';
    for (@$value) {
        if (defined $_) {
            $ref->{$key} .= ' ' . $_;
        }
        else {
            $ref->{$key} = $default;
        }
    }
}

sub add_text {
    my $o = shift;
    my ($ref, $key, $value, $default) = @_;
    $value = [$value] unless ref $value;
    croak usage_validate($key) unless ref($value) eq 'ARRAY';
    for (@$value) {
        if (defined $_) {
            chomp;
            $ref->{$key} .= $_ . "\n";
        }
        else {
            $ref->{$key} = $default;
        }
    }
}

#==============================================================================
# Return a small report about the C code..
#==============================================================================
sub info {
    my $o = shift;
    return <<END if $o->{ILSM}{XSMODE};
No information is currently generated when using XSMODE.

END
    my $text = '';
    $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;
}

sub config {
    my $o = shift;
}

#==============================================================================
# Parse and compile C code
#==============================================================================
my $total_build_time;
sub build {
    my $o = shift;

    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();
    }
    my $file = File::Spec->catfile($o->{API}{directory},'.lock');
    open my $lockfh, '>', $file or die "lockfile $file: $!";