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   1532 use strict;
  1         2  
  1         29  
4 1     1   6 use Config ();
  1         1  
  1         13  
5 1     1   4 use ExtUtils::MakeMaker ();
  1         2  
  1         11  
6 1     1   4 use Module::Install::Base ();
  1         2  
  1         34  
7              
8 1     1   5 use vars qw{$VERSION @ISA $ISCORE};
  1         2  
  1         89  
9             BEGIN {
10 1     1   5 $VERSION = '1.21';
11 1         18 @ISA = 'Module::Install::Base';
12 1         951 $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__
161              
162             =pod
163              
164             =head1 NAME
165              
166             Module::Install::Can - Utility functions for capability detection
167              
168             =head1 DESCRIPTION
169              
170             C<Module::Install::Can> contains a number of functions for authors to use
171             when creating customised smarter installers. The functions simplify
172             standard tests so that you can express your dependencies and conditions
173             much more simply, and make your installer much easier to maintain.
174              
175             =head1 COMMANDS
176              
177             =head2 can_use
178              
179             can_use('Module::Name');
180             can_use('Module::Name', 1.23);
181              
182             The C<can_use> function tests the ability to load a specific named
183             module. Currently it will also actually load the module in the
184             process, although this may change in the future.
185              
186             Takes an optional second param of a version number. The currently
187             installed version of the module will be tested to make sure it is
188             equal to or greater than the specified version.
189              
190             Returns true if the module can be loaded, or false (in both scalar or
191             list context) if not.
192              
193             =head2 can_run
194              
195             can_run('cvs');
196              
197             The C<can_run> function tests the ability to run a named command or
198             program on the local system.
199              
200             Returns true if so, or false (both in scalar and list context) if not.
201              
202             =head2 can_cc
203              
204             can_cc();
205              
206             The C<can_cc> function tests the ability to locate a functioning C compiler
207             on the local system. Returns true if the C compiler can be found, or false
208             (both in scalar and list context) if not.
209              
210             =head2 can_xs
211              
212             can_xs();
213              
214             The C<can_xs> function tests for a functioning C compiler and the correct
215             headers to build XS modules against the current instance of Perl.
216              
217             =head1 TO DO
218              
219             Currently, the use of a C<can_foo> command in a single problem domain
220             (for example C<can_use>) results in the inclusion of additional
221             functionality from different problem domains (for example C<can_run>).
222              
223             This module should ultimately be broken up, and the individual
224             functions redistributed to different domain-specific extensions.
225              
226             =head1 AUTHORS
227              
228             Audrey Tang E<lt>autrijus@autrijus.orgE<gt>
229              
230             Adam Kennedy E<lt>adamk@cpan.orgE<gt>
231              
232             =head1 SEE ALSO
233              
234             L<Module::Install>, L<Class::Inspector>
235              
236             =head1 COPYRIGHT
237              
238             Copyright 2006 - 2012 Audrey Tang, Adam Kennedy.
239              
240             This program is free software; you can redistribute it and/or modify it
241             under the same terms as Perl itself.
242              
243             See L<http://www.perl.com/perl/misc/Artistic.html>
244              
245             =cut