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