Gecko [ www.vortexaion.com ]

Name	Size	Permission	Date
CPAN.pm	2.04 KB	-rw-rw-rw-	2020-02-07 22:50
Config.pm	2.14 KB	-rw-rw-rw-	2020-02-07 22:50
FileSpec.pm	4.87 KB	-rw-rw-rw-	2020-02-07 22:50
HomeDir.pm	1.96 KB	-rw-rw-rw-	2020-02-07 22:51
LoadYaml.pm	12.84 KB	-rw-rw-rw-	2020-02-07 22:51
minicpan.pm	1.34 KB	-rw-rw-rw-	2020-02-07 22:51

Rename

package Portable::Config;

use 5.008;
use strict;
use warnings;
use Portable::FileSpec;

our $VERSION = '1.23';

#####################################################################
# Constructor

sub new {
	my $class  = shift;
	my $parent = shift;
	unless ( Portable::_HASH($parent->portable_config) ) {
		die('Missing or invalid config key in portable.perl');
	}

# Create the object
	my $self = bless { }, $class;
	my $conf = $parent->portable_config;
	my $root = $parent->dist_root;
	foreach my $key ( sort keys %$conf ) {
		unless (
			defined $conf->{$key}
			and
			length $conf->{$key}
			and not
			$key =~ /^ld|^libpth$/
		) {
			$self->{$key} = $conf->{$key};
			next;
		}
		#join path to directory of portable perl with value from config file
		if ($key eq 'perlpath') {
		  $self->{$key} = Portable::FileSpec::catfile($root, split /\//, $conf->{$key});
		}
		else {
		  $self->{$key} = Portable::FileSpec::catdir($root, split /\//, $conf->{$key});
		}
	}
	foreach my $key ( grep { /^ld|^libpth$/ } keys %$self ) { 
		#special handling of linker config variables and libpth
		next unless defined $self->{$key};
		$self->{$key} =~ s/\$(\w+)/$self->{$1}/g;
	}

return $self;
}

sub apply {
	my $self   = shift;
	my $parent = shift;

# Force all Config entries to load, so that
	# all Config_heavy.pl code has run, and none
	# of our values will be overwritten later.
	require Config;
	my $preload = { %Config::Config };

# Shift the tie STORE method out the way
	SCOPE: {
		no warnings;
		*Config::_TEMP = *Config::STORE;
		*Config::STORE = sub {
			$_[0]->{$_[1]} = $_[2];
		};
	}

# Write the values to the Config hash
	foreach my $key ( sort keys %$self ) {
		$Config::Config{$key} = $self->{$key};
	}

# Restore the STORE method
	SCOPE: {
		no warnings;
		*Config::STORE = delete $Config::{_TEMP};
	}
	
	# Confirm we got all the paths
	my $volume = quotemeta $parent->dist_volume;
	foreach my $key ( sort keys %Config::Config ) {
		next unless defined $Config::Config{$key};
		next if     $Config::Config{$key} =~ /$volume/i;
		next unless $Config::Config{$key} =~ /\b[a-z]\:/i;
		die "Failed to localize \$Config::Config{$key} ($Config::Config{$key})";
	}

return 1;
}