1 files changed, 72 insertions, 0 deletions
diff --git a/cpan/Test-Harness/lib/TAP/Parser/Utils.pm b/cpan/Test-Harness/lib/TAP/Parser/Utils.pm
new file mode 100644
index 0000000000..a3d2dd1ea9
--- /dev/null
+++ b/cpan/Test-Harness/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.17
+
+=cut
+
+$VERSION = '3.17';
+
+=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;