blob: 49a457a37835c6eb0fdac0a733774279f359efd3 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
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.23
=cut
$VERSION = '3.23';
=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;
|
