File Coverage

blib/lib/Module/Install/Can.pm
Criterion Covered Total %
statement 18 72 25.0
branch 0 20 0.0
condition 0 11 0.0
subroutine 6 10 60.0
pod 4 4 100.0
total 28 117 23.9


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