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