1#line 1 2package Module::Install::Can; 3 4use strict; 5use Config (); 6use ExtUtils::MakeMaker (); 7use Module::Install::Base (); 8 9use vars qw{$VERSION @ISA $ISCORE}; 10BEGIN { 11 $VERSION = '1.06'; 12 @ISA = 'Module::Install::Base'; 13 $ISCORE = 1; 14} 15 16# check if we can load some module 17### Upgrade this to not have to load the module if possible 18sub can_use { 19 my ($self, $mod, $ver) = @_; 20 $mod =~ s{::|\\}{/}g; 21 $mod .= '.pm' unless $mod =~ /\.pm$/i; 22 23 my $pkg = $mod; 24 $pkg =~ s{/}{::}g; 25 $pkg =~ s{\.pm$}{}i; 26 27 local $@; 28 eval { require $mod; $pkg->VERSION($ver || 0); 1 }; 29} 30 31# Check if we can run some command 32sub can_run { 33 my ($self, $cmd) = @_; 34 35 my $_cmd = $cmd; 36 return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); 37 38 for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { 39 next if $dir eq ''; 40 require File::Spec; 41 my $abs = File::Spec->catfile($dir, $cmd); 42 return $abs if (-x $abs or $abs = MM->maybe_command($abs)); 43 } 44 45 return; 46} 47 48# Can our C compiler environment build XS files 49sub can_xs { 50 my $self = shift; 51 52 # Ensure we have the CBuilder module 53 $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); 54 55 # Do we have the configure_requires checker? 56 local $@; 57 eval "require ExtUtils::CBuilder;"; 58 if ( $@ ) { 59 # They don't obey configure_requires, so it is 60 # someone old and delicate. Try to avoid hurting 61 # them by falling back to an older simpler test. 62 return $self->can_cc(); 63 } 64 65 # Do we have a working C compiler 66 my $builder = ExtUtils::CBuilder->new( 67 quiet => 1, 68 ); 69 unless ( $builder->have_compiler ) { 70 # No working C compiler 71 return 0; 72 } 73 74 # Write a C file representative of what XS becomes 75 require File::Temp; 76 my ( $FH, $tmpfile ) = File::Temp::tempfile( 77 "compilexs-XXXXX", 78 SUFFIX => '.c', 79 ); 80 binmode $FH; 81 print $FH <<'END_C'; 82#include "EXTERN.h" 83#include "perl.h" 84#include "XSUB.h" 85 86int main(int argc, char **argv) { 87 return 0; 88} 89 90int boot_sanexs() { 91 return 1; 92} 93 94END_C 95 close $FH; 96 97 # Can the C compiler access the same headers XS does 98 my @libs = (); 99 my $object = undef; 100 eval { 101 local $^W = 0; 102 $object = $builder->compile( 103 source => $tmpfile, 104 ); 105 @libs = $builder->link( 106 objects => $object, 107 module_name => 'sanexs', 108 ); 109 }; 110 my $result = $@ ? 0 : 1; 111 112 # Clean up all the build files 113 foreach ( $tmpfile, $object, @libs ) { 114 next unless defined $_; 115 1 while unlink; 116 } 117 118 return $result; 119} 120 121# Can we locate a (the) C compiler 122sub can_cc { 123 my $self = shift; 124 my @chunks = split(/ /, $Config::Config{cc}) or return; 125 126 # $Config{cc} may contain args; try to find out the program part 127 while (@chunks) { 128 return $self->can_run("@chunks") || (pop(@chunks), next); 129 } 130 131 return; 132} 133 134# Fix Cygwin bug on maybe_command(); 135if ( $^O eq 'cygwin' ) { 136 require ExtUtils::MM_Cygwin; 137 require ExtUtils::MM_Win32; 138 if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { 139 *ExtUtils::MM_Cygwin::maybe_command = sub { 140 my ($self, $file) = @_; 141 if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { 142 ExtUtils::MM_Win32->maybe_command($file); 143 } else { 144 ExtUtils::MM_Unix->maybe_command($file); 145 } 146 } 147 } 148} 149 1501; 151 152__END__ 153 154#line 236 155