"Fossies" - the Fresh Open Source Software Archive

Member "RT-Extension-Assets-1.05/inc/Module/Install/Can.pm" (6 May 2015, 3183 Bytes) of package /linux/misc/RT-Extension-Assets-1.05.tar.gz:

As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Can.pm" see the Fossies "Dox" file reference documentation and the last Fossies "Diffs" side-by-side code changes report: 1.02_vs_1.04.

    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.14';
   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