inc/Module/Install/Can.pm

   1 #line 1
   2 package Module::Install::Can;
   3
   4 use strict;
   5 use Config                ();
   6 use ExtUtils::MakeMaker   ();
   7 use Module::Install::Base ();
   8
   9 use vars qw{$VERSION @ISA $ISCORE};
  10 BEGIN {
  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
  18 sub 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
  32 sub 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
  49 sub 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
  86 int main(int argc, char **argv) {
  87     return 0;
  88 }
  89
  90 int boot_sanexs() {
  91     return 1;
  92 }
  93
  94 END_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
 122 sub 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();
 135 if ( $^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
 150 1;
 151
 152 __END__
 153
 154 #line 236