Commit | Line | Data |
bd3ac2f1 |
1 | package TAP::Parser::Utils; |
2 | |
3 | use strict; |
4 | use Exporter; |
5 | use vars qw($VERSION @ISA @EXPORT_OK); |
6 | |
7 | @ISA = qw( Exporter ); |
8 | @EXPORT_OK = qw( split_shell ); |
9 | |
10 | =head1 NAME |
11 | |
12 | TAP::Parser::Utils - Internal TAP::Parser utilities |
13 | |
14 | =head1 VERSION |
15 | |
f7c69158 |
16 | Version 3.13 |
bd3ac2f1 |
17 | |
18 | =cut |
19 | |
f7c69158 |
20 | $VERSION = '3.13'; |
bd3ac2f1 |
21 | |
22 | =head1 SYNOPSIS |
23 | |
24 | use TAP::Parser::Utils qw( split_shell ) |
25 | my @switches = split_shell( $arg ); |
26 | |
27 | =head1 DESCRIPTION |
28 | |
29 | B<FOR INTERNAL USE ONLY!> |
30 | |
31 | =head2 INTERFACE |
32 | |
33 | =head3 C<split_shell> |
34 | |
35 | Shell style argument parsing. Handles backslash escaping, single and |
36 | double quoted strings but not shell substitutions. |
37 | |
38 | Pass one or more strings containing shell escaped arguments. The return |
39 | value is an array of arguments parsed from the input strings according |
40 | to (approximate) shell parsing rules. It's legal to pass C<undef> in |
41 | which case an empty array will be returned. That makes it possible to |
42 | |
43 | my @args = split_shell( $ENV{SOME_ENV_VAR} ); |
44 | |
45 | without worrying about whether the environment variable exists. |
46 | |
47 | This is used to split HARNESS_PERL_ARGS into individual switches. |
48 | |
49 | =cut |
50 | |
51 | sub split_shell { |
52 | my @parts = (); |
53 | |
54 | for my $switch ( grep defined && length, @_ ) { |
55 | push @parts, $1 while $switch =~ / |
56 | ( |
57 | (?: [^\\"'\s]+ |
58 | | \\. |
59 | | " (?: \\. | [^"] )* " |
60 | | ' (?: \\. | [^'] )* ' |
61 | )+ |
62 | ) /xg; |
63 | } |
64 | |
65 | for (@parts) { |
66 | s/ \\(.) | ['"] /defined $1 ? $1 : ''/exg; |
67 | } |
68 | |
69 | return @parts; |
70 | } |
71 | |
72 | 1; |