ExtUtils::InferConfig - Infer Perl Configuration for non-running interpreters


ExtUtils-InferConfig documentation Contained in the ExtUtils-InferConfig distribution.

Index


Code Index:

NAME

Top

ExtUtils::InferConfig - Infer Perl Configuration for non-running interpreters

SYNOPSIS

Top

  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;

DESCRIPTION

Top

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.

METHODS

Top

new

Requires one named parameter: perl, the path to the perl interpreter to query for information.

Optional parameter: debug => 1 enables the debugging mode.

get_config

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.

get_inc

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.

CAVEATS

Top

This module cannot get the non-plain (i.e. non-string) entries of the @INC array!

SEE ALSO

Top

You can use this module with ExtUtils::Installed to get information about perl installations that aren't currently running.

AUTHOR

Top

Steffen Mueller, <smueller@cpan.org>

COPYRIGHT AND LICENSE

Top


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__