| ExtUtils-InferConfig documentation | Contained in the ExtUtils-InferConfig distribution. |
ExtUtils::InferConfig - Infer Perl Configuration for non-running interpreters
use ExtUtils::InferConfig;
my $eic = ExtUtils::InferConfig->new(
perl => '/path/to/a/perl'
);
# Get that interpreters %Config as hash ref
my $Config = $eic->get_config;
# Get that interpreters @INC as array ref
my $INC = $eic->get_inc;
This module can determine the configuration and @INC of a perl
interpreter given its path and that it is runnable by the current
user.
It runs the interpreter with a one-liner and grabs the %Config
hash via STDOUT capturing. Getting the module load paths, @INC,
works the same way for @INC entries that are plain paths.
Requires one named parameter: perl, the path to the perl
interpreter to query for information.
Optional parameter: debug => 1 enables the debugging mode.
Returns a copy of the %Config::Config hash of the
intepreter which was specified as a parameter to the
constructor.
The first time this method (or the get_inc method below) is called, the perl binary is run. For subsequent calls of this method, the information is cached.
Returns a copy of the @INC array of the
intepreter which was specified as a parameter to the
constructor. Caveat: This skips any references
(subroutines, ARRAY refs, objects) in the @INC
array because they cannot be reliably stringified!
The first time this method (or the get_config method avove) is called, the perl binary is run. For subsequent calls of this method, the information is cached.
This module cannot get the non-plain (i.e. non-string) entries of
the @INC array!
You can use this module with ExtUtils::Installed to get information about perl installations that aren't currently running.
Steffen Mueller, <smueller@cpan.org>
Copyright (C) 2007-2010 by Steffen Mueller
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.6 or, at your option, any later version of Perl 5 you may have available.
| ExtUtils-InferConfig documentation | Contained in the ExtUtils-InferConfig distribution. |
package ExtUtils::InferConfig; use strict; use Config; use Carp qw/croak/; use IPC::Cmd qw//; use vars qw/$VERSION/; BEGIN { $VERSION = '1.04'; } #use constant ISWIN32 => ($^O =~ /win32/i ? 1 : 0);
sub new { my $class = shift; $class = ref($class) || $class; my %args = @_; my $self = { perl => undef, config => undef, inc => undef, ($args{debug} ? (debug => 1) : ()), }; bless $self => $class; # get interpreter, check that we have access my $perl = $args{perl} || $^X; $perl = $self->_perl_to_file($perl); if (not defined $perl) { croak( "Invalid perl interpreter specified. " ."It was either not found or it is not executable." ); } warn "Using perl '$perl'" if $self->{debug}; $self->{perl} = $perl; return $self; } sub _perl_to_file { # see perldoc perlvar about this. Look for $^X my $self = shift; my $perl = shift; return() if not defined $perl; return $perl if -f $perl and -x _; # Build up a set of file names (not command names). if ($^O ne 'VMS') { $perl .= $Config{_exe} unless $perl =~ m/\Q$Config{_exe}$/i; } return $perl if -f $perl and -x _; return(); }
sub get_config { my $self = shift; return $self->{config} if defined $self->{config}; $self->{config} = $self->_infer_config($self->{perl}); return $self->{config}; } sub _infer_config { my $self = shift; my $perl = shift; my $code = <<'HERE'; use Config; foreach my $k (keys %Config) { my $ek = $k; $ek =~ s/([\n\t\r%])/q{%}.ord($1).q{;}/ge; my $ev = $Config{$k}; if (defined $ev) { $ev =~ s/([\n\t\r%])/q{%}.ord($1).q{;}/ge; } else { $ev = q{%-1;}; } print qq{$ek\n$ev\n}; } HERE warn "Running the following code:\n---$code\n---" if $self->{debug}; $code =~ s/\s+$//; $code =~ s/\n/ /g; my @command = ( $perl, '-e', $code ); warn "Running the following command: '@command'" if $self->{debug}; my $old_use_run = $IPC::Cmd::USE_IPC_RUN; $IPC::Cmd::USE_IPC_RUN = 1; my ($success, $error_code, undef, $buffer, $error) = IPC::Cmd::run( command => \@command, ); $IPC::Cmd::USE_IPC_RUN = $old_use_run; warn "Returned buffer is:\n---\n".join("\n",@$buffer)."\n---" if $self->{debug}; warn "Returned error buffer is:\n---\n".join("\n",@$error)."\n---" if $self->{debug}; if (not $success) { croak( "Could not run the specified perl interpreter to determine \%Config. Error code (if any) was: $error_code. STDERR was (if any): ".join('', @$error) ); } my %Config; my @data = split /\n/, join '', @$buffer; while (@data) { my $key = shift(@data); chomp $key; my $value = shift(@data); $value = '' if !defined $value; #in case of last value chomp $value; $key =~ s/%(\d+);/chr($1)/eg; if ($value eq '%-1;') { $value = undef; } else { $value =~ s/%(\d+);/chr($1)/eg; } $Config{$key} = $value; } return \%Config; }
sub get_inc { my $self = shift; return $self->{config} if defined $self->{inc}; $self->{inc} = $self->_infer_inc($self->{perl}); return $self->{inc}; } sub _infer_inc { my $self = shift; my $perl = shift; my $code = <<'HERE'; foreach my $inc (@INC) { my $i = $inc; if (not ref($i)) { $i =~ s/([\n\t\r%])/q{%}.ord($1).q{;}/ge; } print qq{$i\n}; } HERE warn "Running the following code:\n---$code\n---" if $self->{debug}; $code =~ s/\s+$//; $code =~ s/\n/ /g; my @command = ( $perl, '-e', $code ); warn "Running the following command: '@command'" if $self->{debug}; my $old_use_run = $IPC::Cmd::USE_IPC_RUN; $IPC::Cmd::USE_IPC_RUN = 1; my ($success, $error_code, undef, $buffer, $error) = IPC::Cmd::run( command => \@command, ); $IPC::Cmd::USE_IPC_RUN = $old_use_run; warn "Returned buffer is:\n---\n".join("\n",@$buffer)."\n---" if $self->{debug}; warn "Returned error buffer is:\n---\n".join("\n",@$error)."\n---" if $self->{debug}; if (not $success) { croak( "Could not run the specified perl interpreter to determine \@INC. Error code (if any) was: $error_code. STDERR was (if any): ".join('', @$error) ); } my @inc; my @data = split /\n/, join '', @$buffer; foreach my $line (@data) { chomp $line; if ($line eq '%-1;') { $line = undef; } else { $line =~ s/%(\d+);/chr($1)/eg; } push @inc, $line; } return \@inc; } 1; __END__