This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
f86c8c29911661718e1c44f2c4c50beb1a4b5459
[perl5.git] / lib / Text / ParseWords.pm
1 package Text::ParseWords;
2
3 require 5.000;
4 require Exporter;
5 require AutoLoader;
6 use Carp;
7
8 @ISA = qw(Exporter AutoLoader);
9 @EXPORT = qw(shellwords quotewords);
10 @EXPORT_OK = qw(old_shellwords);
11
12 =head1 NAME
13
14 Text::ParseWords - parse text into an array of tokens
15
16 =head1 SYNOPSIS
17
18   use Text::ParseWords;
19   @words = &quotewords($delim, $keep, @lines);
20   @words = &shellwords(@lines);
21   @words = &old_shellwords(@lines);
22
23 =head1 DESCRIPTION
24
25 &quotewords() accepts a delimiter (which can be a regular expression)
26 and a list of lines and then breaks those lines up into a list of
27 words ignoring delimiters that appear inside quotes.
28
29 The $keep argument is a boolean flag.  If true, the quotes are kept
30 with each word, otherwise quotes are stripped in the splitting process.
31 $keep also defines whether unprotected backslashes are retained.
32
33 A &shellwords() replacement is included to demonstrate the new package.
34 This version differs from the original in that it will _NOT_ default
35 to using $_ if no arguments are given.  I personally find the old behavior
36 to be a mis-feature.
37
38
39 &quotewords() works by simply jamming all of @lines into a single
40 string in $_ and then pulling off words a bit at a time until $_
41 is exhausted.
42
43 =head1 AUTHORS
44
45 Hal Pomeranz (pomeranz@netcom.com), 23 March 1994
46
47 Basically an update and generalization of the old shellwords.pl.
48 Much code shamelessly stolen from the old version (author unknown).
49
50 =cut
51
52 1;
53 __END__
54
55 sub shellwords {
56     local(@lines) = @_;
57     $lines[$#lines] =~ s/\s+$//;
58     &quotewords('\s+', 0, @lines);
59 }
60
61
62
63 sub quotewords {
64
65 # The inner "for" loop builds up each word (or $field) one $snippet
66 # at a time.  A $snippet is a quoted string, a backslashed character,
67 # or an unquoted string.  We fall out of the "for" loop when we reach
68 # the end of $_ or when we hit a delimiter.  Falling out of the "for"
69 # loop, we push the $field we've been building up onto the list of
70 # @words we'll be returning, and then loop back and pull another word
71 # off of $_.
72 #
73 # The first two cases inside the "for" loop deal with quoted strings.
74 # The first case matches a double quoted string, removes it from $_,
75 # and assigns the double quoted string to $snippet in the body of the
76 # conditional.  The second case handles single quoted strings.  In
77 # the third case we've found a quote at the current beginning of $_,
78 # but it didn't match the quoted string regexps in the first two cases,
79 # so it must be an unbalanced quote and we croak with an error (which can
80 # be caught by eval()).
81 #
82 # The next case handles backslashed characters, and the next case is the
83 # exit case on reaching the end of the string or finding a delimiter.
84 #
85 # Otherwise, we've found an unquoted thing and we pull of characters one
86 # at a time until we reach something that could start another $snippet--
87 # a quote of some sort, a backslash, or the delimiter.  This one character
88 # at a time behavior was necessary if the delimiter was going to be a
89 # regexp (love to hear it if you can figure out a better way).
90
91     local($delim, $keep, @lines) = @_;
92     local(@words,$snippet,$field,$_);
93
94     $_ = join('', @lines);
95     while (length($_)) {
96         $field = '';
97         for (;;) {
98             $snippet = '';
99             if (s/^"(([^"\\]|\\[\\"])*)"//) {
100                 $snippet = $1;
101                 $snippet = "\"$snippet\"" if ($keep);
102             }
103             elsif (s/^'(([^'\\]|\\[\\'])*)'//) {
104                 $snippet = $1;
105                 $snippet = "'$snippet'" if ($keep);
106             }
107             elsif (/^["']/) {
108                 croak "Unmatched quote";
109             }
110             elsif (s/^\\(.)//) {
111                 $snippet = $1;
112                 $snippet = "\\$snippet" if ($keep);
113             }
114             elsif (!length($_) || s/^$delim//) {
115                last;
116             }
117             else {
118                 while ($_ ne '' && !(/^$delim/ || /^['"\\]/)) {
119                    $snippet .=  substr($_, 0, 1);
120                    substr($_, 0, 1) = '';
121                 }
122             }
123             $field .= $snippet;
124         }
125         push(@words, $field);
126     }
127     @words;
128 }
129
130
131 sub old_shellwords {
132
133     # Usage:
134     #   use ParseWords;
135     #   @words = old_shellwords($line);
136     #   or
137     #   @words = old_shellwords(@lines);
138
139     local($_) = join('', @_);
140     my(@words,$snippet,$field);
141
142     s/^\s+//;
143     while ($_ ne '') {
144         $field = '';
145         for (;;) {
146             if (s/^"(([^"\\]|\\.)*)"//) {
147                 ($snippet = $1) =~ s#\\(.)#$1#g;
148             }
149             elsif (/^"/) {
150                 croak "Unmatched double quote: $_";
151             }
152             elsif (s/^'(([^'\\]|\\.)*)'//) {
153                 ($snippet = $1) =~ s#\\(.)#$1#g;
154             }
155             elsif (/^'/) {
156                 croak "Unmatched single quote: $_";
157             }
158             elsif (s/^\\(.)//) {
159                 $snippet = $1;
160             }
161             elsif (s/^([^\s\\'"]+)//) {
162                 $snippet = $1;
163             }
164             else {
165                 s/^\s+//;
166                 last;
167             }
168             $field .= $snippet;
169         }
170         push(@words, $field);
171     }
172     @words;
173 }