view release on metacpan or  search on metacpan

inc/Module/Install/XSUtil.pm  view on Meta::CPAN

sub _xs_debugging{
    return $ENV{XS_DEBUG} || scalar( grep{ $_ eq '-g' } @ARGV );
}

sub _xs_initialize{
    my($self) = @_;

    unless($self->{xsu_initialized}){
        $self->{xsu_initialized} = 1;

        if(!$self->cc_available()){
            warn "This distribution requires a C compiler, but it's not available, stopped.\n";
            exit;
        }

        $self->configure_requires(%ConfigureRequires);
        $self->build_requires(%BuildRequires);
        $self->requires(%Requires);

        $self->makemaker_args->{OBJECT} = '$(O_FILES)';
        $self->clean_files('$(O_FILES)');
        $self->clean_files('*.stackdump') if $^O eq 'cygwin';

        if($self->_xs_debugging()){
            # override $Config{optimize}
            if(_is_msvc()){
                $self->makemaker_args->{OPTIMIZE} = '-Zi';
            }
            else{
                $self->makemaker_args->{OPTIMIZE} = '-g -ggdb -g3';
            }
            $self->cc_define('-DXS_ASSERT');
        }
    }
    return;
}

# GNU C Compiler
sub _is_gcc{
    return $Config{gccversion};
}

# Microsoft Visual C++ Compiler (cl.exe)
sub _is_msvc{
    return $Config{cc} =~ /\A cl \b /xmsi;
}

{
    my $cc_available;

    sub cc_available {
        return defined $cc_available ?
            $cc_available :
            ($cc_available = shift->can_cc())
        ;
    }

    # cf. https://github.com/sjn/toolchain-site/blob/219db464af9b2f19b04fec05547ac10180a469f3/lancaster-consensus.md
    my $want_xs;
    sub want_xs {
        my($self, $default) = @_;
        return $want_xs if defined $want_xs;

        # you're using this module, you must want XS by default
        # unless PERL_ONLY is true.
        $default = !$ENV{PERL_ONLY} if not defined $default;

        foreach my $arg(@ARGV){

            my ($k, $v) = split '=', $arg; # MM-style named args
            if ($k eq 'PUREPERL_ONLY' && defined $v) {
                return $want_xs = !$v;
            }
            elsif($arg eq '--pp'){ # old-style
                return $want_xs = 0;
            }
            elsif($arg eq '--xs'){
                return $want_xs = 1;
            }
        }

        if ($ENV{PERL_MM_OPT}) {
            my($v) = $ENV{PERL_MM_OPT} =~ /\b PUREPERL_ONLY = (\S+) /xms;
            if (defined $v) {
                return $want_xs = !$v;
            }
        }

        return $want_xs = $default;
    }
}

sub use_ppport{
    my($self, $dppp_version) = @_;
    return if $self->{_ppport_ok}++;

    $self->_xs_initialize();

    my $filename = 'ppport.h';

    $dppp_version ||= 3.19; # the more, the better
    $self->configure_requires('Devel::PPPort' => $dppp_version);
    $self->build_requires('Devel::PPPort' => $dppp_version);

    print "Writing $filename\n";

    my $e = do{
        local $@;
        eval qq{
            use Devel::PPPort;
            Devel::PPPort::WriteFile(q{$filename});
        };
        $@;
    };
    if($e){
         print "Cannot create $filename because: $@\n";
    }

    if(-e $filename){
        $self->clean_files($filename);
        $self->cc_define('-DUSE_PPPORT');
        $self->cc_append_to_inc('.');
    }
    return;
}

sub use_xshelper {
    my($self, $opt) = @_;
    $self->_xs_initialize();
    $self->use_ppport();

    my $file = 'xshelper.h';
    open my $fh, '>', $file or die "Cannot open $file for writing: $!";
    print $fh $self->_xshelper_h();
    close $fh or die "Cannot close $file: $!";
    if(defined $opt) {
        if($opt eq '-clean') {
            $self->clean_files($file);
        }
        else {
            $self->realclean_files($file);
        }
    }
    return;
}

sub _gccversion {
    my $res = `$Config{cc} --version`;
    my ($version) = $res =~ /\(GCC\) ([0-9.]+)/;