summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl.straw/lib/TAP/Parser/Utils.pm
blob: 21769b1a3f0e2cc401795b582b8211b3ce80db87 (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.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;