diff options
author | Norbert Preining <preining@logic.at> | 2010-05-12 16:54:37 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2010-05-12 16:54:37 +0000 |
commit | 661c41a09e39a182865e0b51e34cc995a0dc96e8 (patch) | |
tree | 2f79bb1406e22fdcb2587be8ffda6c0c609d7932 /Master/tlpkg/tlperl/lib/TAP/Parser/Utils.pm | |
parent | b645030efc22e13c2498a1522083634ab91b2de1 (diff) |
move tlperl.straw to tlperl
git-svn-id: svn://tug.org/texlive/trunk@18210 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/TAP/Parser/Utils.pm')
-rwxr-xr-x | Master/tlpkg/tlperl/lib/TAP/Parser/Utils.pm | 72 |
1 files changed, 72 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Utils.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Utils.pm new file mode 100755 index 00000000000..21769b1a3f0 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Utils.pm @@ -0,0 +1,72 @@ +package TAP::Parser::Utils; + +use strict; +use Exporter; +use vars qw($VERSION @ISA @EXPORT_OK); + +@ISA = qw( Exporter ); +@EXPORT_OK = qw( split_shell ); + +=head1 NAME + +TAP::Parser::Utils - Internal TAP::Parser utilities + +=head1 VERSION + +Version 3.20 + +=cut + +$VERSION = '3.20'; + +=head1 SYNOPSIS + + use TAP::Parser::Utils qw( split_shell ) + my @switches = split_shell( $arg ); + +=head1 DESCRIPTION + +B<FOR INTERNAL USE ONLY!> + +=head2 INTERFACE + +=head3 C<split_shell> + +Shell style argument parsing. Handles backslash escaping, single and +double quoted strings but not shell substitutions. + +Pass one or more strings containing shell escaped arguments. The return +value is an array of arguments parsed from the input strings according +to (approximate) shell parsing rules. It's legal to pass C<undef> in +which case an empty array will be returned. That makes it possible to + + my @args = split_shell( $ENV{SOME_ENV_VAR} ); + +without worrying about whether the environment variable exists. + +This is used to split HARNESS_PERL_ARGS into individual switches. + +=cut + +sub split_shell { + my @parts = (); + + for my $switch ( grep defined && length, @_ ) { + push @parts, $1 while $switch =~ / + ( + (?: [^\\"'\s]+ + | \\. + | " (?: \\. | [^"] )* " + | ' (?: \\. | [^'] )* ' + )+ + ) /xg; + } + + for (@parts) { + s/ \\(.) | ['"] /defined $1 ? $1 : ''/exg; + } + + return @parts; +} + +1; |