view release on metacpan or  search on metacpan

inc/Devel/CheckLib.pm  view on Meta::CPAN

=item ccflags

Extra flags to pass to the compiler.

=item ldflags

Extra flags to pass to the linker.

=item analyze_binary

a callback function that will be invoked in order to perform custom
analysis of the generated binary. The callback arguments are the
library name and the path to the binary just compiled.

It is possible to use this callback, for instance, to inspect the
binary for further dependencies.

=back

=head2 check_lib_or_exit

This behaves exactly the same as C<assert_lib()> except that instead of
dieing, it warns (with exactly the same error message) and exits.
This is intended for use in Makefile.PL / Build.PL
when you might want to prompt the user for various paths and
things before checking that what they've told you is sane.

If any library or header is missing, it exits with an exit value of 0 to avoid
causing a CPAN Testers 'FAIL' report.  CPAN Testers should ignore this
result -- which is what you want if an external library dependency is not
available.

=head2 check_lib

This behaves exactly the same as C<assert_lib()> except that it is silent,
returning false instead of dieing, or true otherwise.

=cut

sub check_lib_or_exit {
    eval 'assert_lib(@_)';
    if($@) {
        warn $@;
        exit;
    }
}

sub check_lib {
    eval 'assert_lib(@_)';
    return $@ ? 0 : 1;
}

# borrowed from Text::ParseWords
sub _parse_line {
    my($delimiter, $keep, $line) = @_;
    my($word, @pieces);

    no warnings 'uninitialized';  # we will be testing undef strings

    while (length($line)) {
        # This pattern is optimised to be stack conservative on older perls.
        # Do not refactor without being careful and testing it on very long strings.
        # See Perl bug #42980 for an example of a stack busting input.
        $line =~ s/^
                    (?:
                        # double quoted string
                        (")                             # $quote
                        ((?>[^\\"]*(?:\\.[^\\"]*)*))"   # $quoted
        | # --OR--
                        # singe quoted string
                        (')                             # $quote
                        ((?>[^\\']*(?:\\.[^\\']*)*))'   # $quoted
                    |   # --OR--
                        # unquoted string
                        (                               # $unquoted
                            (?:\\.|[^\\"'])*?
                        )
                        # followed by
                        (                               # $delim
                            \Z(?!\n)                    # EOL
                        |   # --OR--
                            (?-x:$delimiter)            # delimiter
                        |   # --OR--
                            (?!^)(?=["'])               # a quote
                        )
        )//xs or return;    # extended layout
        my ($quote, $quoted, $unquoted, $delim) = (($1 ? ($1,$2) : ($3,$4)), $5, $6);

        return() unless( defined($quote) || length($unquoted) || length($delim));

        if ($keep) {
            $quoted = "$quote$quoted$quote";
        }
        else {
            $unquoted =~ s/\\(.)/$1/sg;
            if (defined $quote) {
                $quoted =~ s/\\(.)/$1/sg if ($quote eq '"');
            }
        }
        $word .= substr($line, 0, 0); # leave results tainted
        $word .= defined $quote ? $quoted : $unquoted;

        if (length($delim)) {
            push(@pieces, $word);
            push(@pieces, $delim) if ($keep eq 'delimiters');
            undef $word;
        }
        if (!length($line)) {
            push(@pieces, $word);
        }
    }
    return(@pieces);
}

sub assert_lib {
    my %args = @_;
    my (@libs, @libpaths, @headers, @incpaths);

    # FIXME: these four just SCREAM "refactor" at me
    @libs = (ref($args{lib}) ? @{$args{lib}} : $args{lib}) 
        if $args{lib};
    @libpaths = (ref($args{libpath}) ? @{$args{libpath}} : $args{libpath}) 
        if $args{libpath};
    @headers = (ref($args{header}) ? @{$args{header}} : $args{header}) 
        if $args{header};
    @incpaths = (ref($args{incpath}) ? @{$args{incpath}} : $args{incpath}) 
        if $args{incpath};
    my $analyze_binary = $args{analyze_binary};

    my @argv = @ARGV;
    push @argv, _parse_line('\s+', 0, $ENV{PERL_MM_OPT}||'');

    # work-a-like for Makefile.PL's LIBS and INC arguments
    # if given as command-line argument, append to %args
    for my $arg (@argv) {
        for my $mm_attr_key (qw(LIBS INC)) {
            if (my ($mm_attr_value) = $arg =~ /\A $mm_attr_key = (.*)/x) {
            # it is tempting to put some \s* into the expression, but the
            # MM command-line parser only accepts LIBS etc. followed by =,
            # so we should not be any more lenient with whitespace than that
                $args{$mm_attr_key} .= " $mm_attr_value";
            }
        }
    }

    # using special form of split to trim whitespace
    if(defined($args{LIBS})) {
        foreach my $arg (split(' ', $args{LIBS})) {
            die("LIBS argument badly-formed: $arg\n") unless($arg =~ /^-[lLR]/);
            push @{$arg =~ /^-l/ ? \@libs : \@libpaths}, substr($arg, 2);
        }
    }
    if(defined($args{INC})) {
        foreach my $arg (split(' ', $args{INC})) {
            die("INC argument badly-formed: $arg\n") unless($arg =~ /^-I/);
            push @incpaths, substr($arg, 2);
        }
    }

    my ($cc, $ld) = _findcc($args{debug}, $args{ccflags}, $args{ldflags});
    my @missing;
    my @wrongresult;
    my @wronganalysis;
    my @use_headers;

    # first figure out which headers we can't find ...
    for my $header (@headers) {
        push @use_headers, $header;

inc/Devel/CheckLib.pm  view on Meta::CPAN

            push @missing, $lib;
        }
        else {
            my $absexefile = File::Spec->rel2abs($exefile);
            $absexefile = '"'.$absexefile.'"' if $absexefile =~ m/\s/;
            if (system($absexefile) != 0) {
                push @wrongresult, $lib;
            }
            else {
                if ($analyze_binary) {
                    push @wronganalysis, $lib if !$analyze_binary->($lib, $exefile)
                }
            }
        }
        _cleanup_exe($exefile);
    } 
    unlink $cfile;

    my $miss_string = join( q{, }, map { qq{'$_'} } @missing );
    die("Can't link/include C library $miss_string, aborting.\n") if @missing;
    my $wrong_string = join( q{, }, map { qq{'$_'} } @wrongresult);
    die("wrong result: $wrong_string\n") if @wrongresult;
    my $analysis_string = join(q{, }, map { qq{'$_'} } @wronganalysis );
    die("wrong analysis: $analysis_string") if @wronganalysis;
}

sub _cleanup_exe {
    my ($exefile) = @_;
    my $ofile = $exefile;
    $ofile =~ s/$Config{_exe}$/$Config{_o}/;
    # List of files to remove
    my @rmfiles;
    push @rmfiles, $exefile, $ofile, "$exefile\.manifest";
    if ( $Config{cc} eq 'cl' ) {
        # MSVC also creates foo.ilk and foo.pdb
        my $ilkfile = $exefile;
        $ilkfile =~ s/$Config{_exe}$/.ilk/;
        my $pdbfile = $exefile;
        $pdbfile =~ s/$Config{_exe}$/.pdb/;
	push @rmfiles, $ilkfile, $pdbfile;
    }
    foreach (@rmfiles) {
	if ( -f $_ ) {
	    unlink $_ or warn "Could not remove $_: $!";
	}
    }
    return
}
    
# return ($cc, $ld)
# where $cc is an array ref of compiler name, compiler flags
# where $ld is an array ref of linker flags
sub _findcc {
    my ($debug, $user_ccflags, $user_ldflags) = @_;
    # Need to use $keep=1 to work with MSWin32 backslashes and quotes
    my $Config_ccflags =  $Config{ccflags};  # use copy so ASPerl will compile
    my @Config_ldflags = ();
    for my $config_val ( @Config{qw(ldflags)} ){
        push @Config_ldflags, $config_val if ( $config_val =~ /\S/ );
    }
    my @ccflags = grep { length } quotewords('\s+', 1, $Config_ccflags||'', $user_ccflags||'');
    my @ldflags = grep { length } quotewords('\s+', 1, @Config_ldflags, $user_ldflags||'');
    my @paths = split(/$Config{path_sep}/, $ENV{PATH});
    my @cc = split(/\s+/, $Config{cc});
    if (check_compiler ($cc[0], $debug)) {
	return ( [ @cc, @ccflags ], \@ldflags );
    }
    # Find the extension for executables.
    my $exe = $Config{_exe};
    if ($^O eq 'cygwin') {
	$exe = '';
    }
    foreach my $path (@paths) {
	# Look for "$path/$cc[0].exe"
        my $compiler = File::Spec->catfile($path, $cc[0]) . $exe;
	if (check_compiler ($compiler, $debug)) {
	    return ([ $compiler, @cc[1 .. $#cc], @ccflags ], \@ldflags)
	}
        next if ! $exe;
	# Look for "$path/$cc[0]" without the .exe, if necessary.
        $compiler = File::Spec->catfile($path, $cc[0]);
	if (check_compiler ($compiler, $debug)) {
	    return ([ $compiler, @cc[1 .. $#cc], @ccflags ], \@ldflags)
	}
    }
    die("Couldn't find your C compiler.\n");
}

sub check_compiler
{
    my ($compiler, $debug) = @_;
    if (-f $compiler && -x $compiler) {
	if ($debug) {
	    warn("# Compiler seems to be $compiler\n");
	}
	return 1;
    }
    return '';
}


# code substantially borrowed from IPC::Run3
sub _quiet_system {
    my (@cmd) = @_;

    # save handles
    local *STDOUT_SAVE;
    local *STDERR_SAVE;
    open STDOUT_SAVE, ">&STDOUT" or die "CheckLib: $! saving STDOUT";
    open STDERR_SAVE, ">&STDERR" or die "CheckLib: $! saving STDERR";
    
    # redirect to nowhere
    local *DEV_NULL;
    open DEV_NULL, ">" . File::Spec->devnull 
        or die "CheckLib: $! opening handle to null device";
    open STDOUT, ">&" . fileno DEV_NULL
        or die "CheckLib: $! redirecting STDOUT to null handle";
    open STDERR, ">&" . fileno DEV_NULL
        or die "CheckLib: $! redirecting STDERR to null handle";

    # run system command
    my $rv = system(@cmd);