Server : Apache/2.4.43 (Win64) OpenSSL/1.1.1g PHP/7.4.6 System : Windows NT USER-PC 6.1 build 7601 (Windows 7 Professional Edition Service Pack 1) AMD64 User : User ( 0) PHP Version : 7.4.6 Disable Function : NONE Directory : C:/xampp/perl/vendor/lib/Portable/ |
package Portable::Config; use 5.008; use strict; use warnings; use Carp (); use File::Spec 3.29 (); our $VERSION = '1.17'; ##################################################################### # Constructor sub new { my $class = shift; my $parent = shift; unless ( Portable::_HASH($parent->portable_config) ) { Carp::croak('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; } my $method = ($key eq 'perlpath') ? 'catfile' : 'catdir'; $self->{$key} = File::Spec->$method( $root, split /\//, $conf->{$key}, ); #join path to directory of portable perl with value from config file } 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/; next unless $Config::Config{$key} =~ /\b[a-z]\:/i; die "Failed to localize \$Config::Config{$key} ($Config::Config{$key})"; } return 1; } 1;