git.maemo.org Git - pkg-perl/blob - deb-src/libtest-harness-perl/libtest-harness-perl-3.12/lib/TAP/Parser/Utils.pm

   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
  16 Version 3.12
  17
  18 =cut
  19
  20 $VERSION = '3.12';
  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;