return 1;
}
+sub sanitize_prefix {
+ my $prefix = shift;
+
+ if (defined $prefix) {
+ if (length $prefix and $prefix !~ /_$/) {
+ $prefix .= '_';
+ }
+ } else {
+ $prefix = '';
+ }
+
+ return $prefix;
+}
+
my %default_exports = (
load_or_skip => \&load_or_skip,
load_or_skip_all => \&load_or_skip_all,
}
sub init_run_perl {
- my $prefix = shift;
-
- if (defined $prefix) {
- if (length $prefix and $prefix !~ /_$/) {
- $prefix .= '_';
- }
- } else {
- $prefix = '';
- }
-
- my $p = $prefix;
+ my $p = sanitize_prefix(shift);
return (
run_perl => \&run_perl,
Import :
- use VPIT::TestHelpers 'capture'
+ use VPIT::TestHelpers capture => [ $p ];
+
+where :
+
+=over 8
+
+=item -
+
+C<$p> is prefixed to the constants exported by this feature (defaults to C<''>).
+
+=back
=item *
=item -
+C<CAPTURE_FAILED $details> (possibly prefixed by C<$p>)
+
+=item -
+
C<capture_perl $code>
+=item -
+
+C<CAPTURE_PERL_FAILED $details> (possibly prefixed by C<$p>)
+
=back
=back
=cut
sub init_capture {
+ my $p = sanitize_prefix(shift);
+
skip_all 'Cannot capture output on VMS' if $^O eq 'VMS';
load_or_skip_all 'IO::Handle', '0', [ ];
}
return (
- capture => \&capture,
- capture_perl => \&capture_perl,
+ capture => \&capture,
+ "${p}CAPTURE_FAILED" => \&capture_failed_msg,
+ capture_perl => \&capture_perl,
+ "${p}CAPTURE_PERL_FAILED" => \&capture_perl_failed_msg,
);
}
}
}
+sub capture_failed_msg {
+ my $details = shift;
+
+ my $msg = 'Could not capture command output';
+ $msg .= " ($details)" if defined $details;
+
+ return $msg;
+}
+
sub capture_perl {
my $code = shift;
};
}
+sub capture_perl_failed_msg {
+ my $details = shift;
+
+ my $msg = 'Could not capture perl output';
+ $msg .= " ($details)" if defined $details;
+
+ return $msg;
+}
+
=head2 C<threads>
=over 4