my %default_exports = (
load_or_skip => \&load_or_skip,
load_or_skip_all => \&load_or_skip_all,
- run_perl => \&run_perl,
skip_all => \&skip_all,
);
my %features = (
- threads => \&init_threads,
- usleep => \&init_usleep,
- capture => \&init_capture,
+ threads => \&init_threads,
+ usleep => \&init_usleep,
+ run_perl => \&init_run_perl,
+ capture => \&init_capture,
);
sub import {
return $loaded;
}
-sub run_perl {
- my $code = shift;
-
- if ($code =~ /"/) {
- die 'Double quotes in evaluated code are not portable';
- }
+sub fresh_perl_env (&) {
+ my $handler = shift;
my ($SystemRoot, $PATH) = @ENV{qw<SystemRoot PATH>};
my $ld_name = $Config::Config{ldlibpthname};
}
}
- system { $perl } $perl, '-T', map("-I$_", @INC), '-e', $code;
+ return $handler->($perl, '-T', map("-I$_", @INC));
+}
+
+sub init_run_perl {
+ my $prefix = shift;
+
+ if (defined $prefix) {
+ if (length $prefix and $prefix !~ /_$/) {
+ $prefix .= '_';
+ }
+ } else {
+ $prefix = '';
+ }
+
+ my $p = $prefix;
+
+ return (
+ run_perl => \&run_perl,
+ "${p}RUN_PERL_FAILED" => sub () { 'Could not execute perl subprocess' },
+ );
+}
+
+sub run_perl {
+ my $code = shift;
+
+ if ($code =~ /"/) {
+ die 'Double quotes in evaluated code are not portable';
+ }
+
+ fresh_perl_env {
+ my ($perl, @perl_args) = @_;
+ system { $perl } $perl, @perl_args, '-e', $code;
+ };
}
sub init_capture {
load_or_skip_all 'Socket', '0', [ ];
}
- return capture => \&capture;
+ return (
+ capture => \&capture,
+ capture_perl => \&capture_perl,
+ );
}
# Inspired from IPC::Cmd
}
}
+sub capture_perl {
+ my $code = shift;
+
+ if ($code =~ /"/) {
+ die 'Double quotes in evaluated code are not portable';
+ }
+
+ fresh_perl_env {
+ my @perl = @_;
+ capture @perl, '-e', $code;
+ };
+}
+
sub init_threads {
my ($pkg, $threadsafe, $force_var) = @_;