line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
=head1 NAME |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
String::Escape - Backslash escapes, quoted phrase, word elision, etc. |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=cut |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
package String::Escape; |
8
|
|
|
|
|
|
|
|
9
|
6
|
|
|
6
|
|
140764
|
use strict; |
|
6
|
|
|
|
|
20
|
|
|
6
|
|
|
|
|
302
|
|
10
|
6
|
|
|
6
|
|
40
|
use warnings; |
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
198
|
|
11
|
6
|
|
|
6
|
|
34
|
use Carp; |
|
6
|
|
|
|
|
16
|
|
|
6
|
|
|
|
|
678
|
|
12
|
|
|
|
|
|
|
|
13
|
6
|
|
|
6
|
|
40
|
use vars qw( $VERSION ); |
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
598
|
|
14
|
|
|
|
|
|
|
$VERSION = 2010.002; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
######################################################################## |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 SYNOPSIS |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
This module provides a flexible calling interface to some frequently-performed string conversion functions, including applying and removing backslash escapes like \n and \t, wrapping and removing double-quotes, and truncating to fit within a desired length. |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
use String::Escape qw( printable unprintable ); |
23
|
|
|
|
|
|
|
# Convert control, high-bit chars to \n or \xxx escapes |
24
|
|
|
|
|
|
|
$output = printable($value); |
25
|
|
|
|
|
|
|
# Convert escape sequences back to original chars |
26
|
|
|
|
|
|
|
$value = unprintable($input); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
use String::Escape qw( elide ); |
29
|
|
|
|
|
|
|
# Shorten strings to fit, if necessary |
30
|
|
|
|
|
|
|
foreach (@_) { print elide( $_, 79 ) . "\n"; } |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
use String::Escape qw( string2list list2string ); |
33
|
|
|
|
|
|
|
# Pack and unpack simple lists by quoting each item |
34
|
|
|
|
|
|
|
$list = list2string( @list ); |
35
|
|
|
|
|
|
|
@list = string2list( $list ); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
use String::Escape qw( escape ); |
38
|
|
|
|
|
|
|
# Defer selection of escaping routines until runtime |
39
|
|
|
|
|
|
|
$escape_name = $use_quotes ? 'qprintable' : 'printable'; |
40
|
|
|
|
|
|
|
@escaped = escape($escape_name, @values); |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=cut |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
######################################################################## |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=head1 INTERFACE |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
All of the public functions described below are available as optional exports. |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
You can either import the specific functions you want, or import only the C<escape()> function and pass it the names of the functions to invoke. |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=cut |
54
|
|
|
|
|
|
|
|
55
|
6
|
|
|
6
|
|
33
|
use Exporter; |
|
6
|
|
|
|
|
116
|
|
|
6
|
|
|
|
|
253
|
|
56
|
|
|
|
|
|
|
|
57
|
6
|
|
|
6
|
|
33
|
use vars qw( @ISA @EXPORT_OK ); |
|
6
|
|
|
|
|
18
|
|
|
6
|
|
|
|
|
3648
|
|
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
push @ISA, qw( Exporter ); |
60
|
|
|
|
|
|
|
push @EXPORT_OK, qw( |
61
|
|
|
|
|
|
|
quote unquote quote_non_words singlequote unsinglequote |
62
|
|
|
|
|
|
|
backslash unbackslash qqbackslash unqqbackslash |
63
|
|
|
|
|
|
|
printable unprintable qprintable unqprintable |
64
|
|
|
|
|
|
|
unquotemeta |
65
|
|
|
|
|
|
|
elide |
66
|
|
|
|
|
|
|
escape |
67
|
|
|
|
|
|
|
string2list string2hash list2string list2hash hash2string hash2list |
68
|
|
|
|
|
|
|
); |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
######################################################################## |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=head2 Quoting |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
Each of these functions takes a single simple scalar argument and |
76
|
|
|
|
|
|
|
returns its escaped (or unescaped) equivalent. |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=over 4 |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=item quote($value) : $escaped |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
Add double quote characters to each end of the string. |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=item unquote($value) : $escaped |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
If the string both begins and ends with double quote characters, they are removed, otherwise the string is returned unchanged. |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=item quote_non_words($value) : $escaped |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
As above, but only quotes empty, punctuated, and multiword values; simple values consisting of alphanumerics without special characters are not quoted. |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=item singlequote($value) : $escaped |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
Add single quote characters to each end of the string. |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=item unsinglequote($value) : $escaped |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
If the string both begins and ends with single quote characters, they are removed, otherwise the string is returned unchanged. |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=back |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=cut |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
# $with_surrounding_quotes = quote( $string_value ); |
105
|
|
|
|
|
|
|
sub quote ($) { |
106
|
5
|
|
|
5
|
1
|
70
|
'"' . $_[0] . '"' |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
# $remove_surrounding_quotes = quote( $string_value ); |
110
|
|
|
|
|
|
|
sub unquote ($) { |
111
|
5
|
50
|
|
5
|
1
|
46
|
( $_[0] =~ m/ \A ["] (.*) ["] \Z /sx ) ? $1 : $_[0]; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
# $word_or_phrase_with_surrounding_quotes = quote( $string_value ); |
115
|
|
|
|
|
|
|
sub quote_non_words ($) { |
116
|
8
|
100
|
66
|
8
|
1
|
100
|
( ! length $_[0] or $_[0] =~ /[^\w\_\-\/\.\:\#]/ ) ? '"'.$_[0].'"' : $_[0] |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
# $with_surrounding_quotes = singlequote( $string_value ); |
120
|
|
|
|
|
|
|
sub singlequote ($) { |
121
|
0
|
|
|
0
|
1
|
0
|
'\'' . $_[0] . '\'' |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
# $remove_surrounding_quotes = singlequote( $string_value ); |
125
|
|
|
|
|
|
|
sub unsinglequote ($) { |
126
|
0
|
0
|
|
0
|
1
|
0
|
( $_[0] =~ m/ \A ['] (.*) ['] \Z /sx ) ? $1 : $_[0]; |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
######################################################################## |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=head2 Backslash Escaping Functions |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
Each of these functions takes a single simple scalar argument and |
135
|
|
|
|
|
|
|
returns its escaped (or unescaped) equivalent. |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
These functions recognize common whitespace sequences C<\r>, C<\n>, and C<\t>, as well as hex escapes C<\x4F> and ocatal C<\020>. |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
When escaping, alphanumeric characters and most punctuation is passed through unchanged; only the return, newline, tab, backslash, dollar, at sign and unprintable control and high-bit characters are escaped. |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=over 4 |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=item backslash($value) : $escaped |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
Converts special characters to their backslash-escaped equivalents. |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=item unbackslash($value) : $escaped |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
Converts backslash escape sequences in a string back to their original characters. |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=item qqbackslash($value) : $escaped |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
Converts special characters to their backslash-escaped equivalents and then wraps the results with double quotes. |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=item unqqbackslash($value) : $escaped |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
Strips surrounding double quotes then converts backslash escape sequences back to their original characters. |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
=back |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
Here are a few examples: |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=over 4 |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=item * |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
print backslash( "\tNow is the time\nfor all good folks\n" ); |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
\tNow is the time\nfor all good folks\n |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=item * |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
print unbackslash( '\\tNow is the time\\nfor all good folks\\n' ); |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
Now is the time |
176
|
|
|
|
|
|
|
for all good folks |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=back |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
=cut |
181
|
|
|
|
|
|
|
|
182
|
6
|
|
|
6
|
|
37
|
use vars qw( %Backslashed %Interpolated ); |
|
6
|
|
|
|
|
12
|
|
|
6
|
|
|
|
|
3972
|
|
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
# Earlier definitions are preferred to later ones, thus we output \n not \x0d |
185
|
|
|
|
|
|
|
_define_backslash_escapes( |
186
|
|
|
|
|
|
|
( map { $_ => $_ } ( '\\', '"', '$', '@' ) ), |
187
|
|
|
|
|
|
|
( 'r' => "\r", 'n' => "\n", 't' => "\t" ), |
188
|
|
|
|
|
|
|
( map { 'x' . unpack('H2', chr($_)) => chr($_) } (0..255) ), |
189
|
|
|
|
|
|
|
( map { sprintf('%03o', $_) => chr($_) } (0..255) ), |
190
|
|
|
|
|
|
|
); |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
sub _define_backslash_escapes { |
193
|
6
|
|
|
6
|
|
2816
|
%Interpolated = @_; |
194
|
6
|
|
|
|
|
2509
|
%Backslashed = reverse @_; |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
# $special_characters_escaped = backslash( $source_string ); |
198
|
|
|
|
|
|
|
sub backslash ($) { |
199
|
9
|
100
|
|
9
|
1
|
1375
|
local $_ = ( defined $_[0] ? $_[0] : '' ); |
200
|
|
|
|
|
|
|
# Preserve only printable ASCII characters other than \, ", $, and @ |
201
|
9
|
|
|
|
|
107
|
s/([^\x20\x21\x24\x25-\x39\x41-\x5b\x5d-\x7e])/\\$Backslashed{$1}/gs; |
202
|
9
|
|
|
|
|
39
|
return $_; |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
# $original_string = unbackslash( $special_characters_escaped ); |
206
|
|
|
|
|
|
|
sub unbackslash ($) { |
207
|
8
|
100
|
|
8
|
1
|
23
|
local $_ = ( defined $_[0] ? $_[0] : '' ); |
208
|
8
|
|
|
|
|
40
|
s/ (\A|\G|[^\\]) [\\] ( [0]\d\d | [x][\da-fA-F]{2} | . ) / $1 . ( $Interpolated{lc($2) }) /gsxe; |
|
27
|
|
|
|
|
309
|
|
209
|
8
|
|
|
|
|
58
|
return $_; |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
# quoted_and_escaped = qqbackslash( $source_string ); |
213
|
5
|
|
|
5
|
1
|
4042
|
sub qqbackslash ($) { quote backslash $_[0] } |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
# $original_string = unqqbackslash( quoted_and_escaped ); |
216
|
4
|
|
|
4
|
1
|
235
|
sub unqqbackslash ($) { unbackslash unquote $_[0] } |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
######################################################################## |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=head2 Legacy Backslash Functions |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
In addition to the four functions listed above, there is a corresponding set which use a slightly different set of escape sequences. |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
These functions do not support as many escape sequences and use a non-standard |
226
|
|
|
|
|
|
|
format for hex escapes. In general, the above C<backslash()> functions are |
227
|
|
|
|
|
|
|
recommended, while these functions are retained for legacy compatibility |
228
|
|
|
|
|
|
|
purposes. |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=over 4 |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=item printable($value) : $escaped |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
Converts return, newline, tab, backslash and unprintable |
235
|
|
|
|
|
|
|
characters to their backslash-escaped equivalents. |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
=item unprintable($value) : $escaped |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
Converts backslash escape sequences in a string back to their original value. |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
=item qprintable($value) : $escaped |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
Converts special characters to their backslash-escaped equivalents and then wraps the results with double quotes. |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
(Note that this is I<not> MIME quoted-printable encoding.) |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
=item unqprintable($value) : $escaped |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
Strips surrounding double quotes then converts backslash escape sequences back to their original value. |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
=back |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
=cut |
254
|
|
|
|
|
|
|
|
255
|
6
|
|
|
6
|
|
52
|
use vars qw( %Printable %Unprintable ); |
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
4171
|
|
256
|
|
|
|
|
|
|
%Printable = ( |
257
|
|
|
|
|
|
|
( map { chr($_), unpack('H2', chr($_)) } (0..255) ), |
258
|
|
|
|
|
|
|
( "\\"=>'\\', "\r"=>'r', "\n"=>'n', "\t"=>'t', ), |
259
|
|
|
|
|
|
|
( map { $_ => $_ } ( '"' ) ) |
260
|
|
|
|
|
|
|
); |
261
|
|
|
|
|
|
|
%Unprintable = ( reverse %Printable ); |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
# $special_characters_escaped = printable( $source_string ); |
264
|
|
|
|
|
|
|
sub printable ($) { |
265
|
12
|
100
|
|
12
|
1
|
1526
|
local $_ = ( defined $_[0] ? $_[0] : '' ); |
266
|
12
|
|
|
|
|
36
|
s/([\r\n\t\"\\\x00-\x1f\x7F-\xFF])/ '\\' . $Printable{$1} /gsxe; |
|
18
|
|
|
|
|
71
|
|
267
|
12
|
|
|
|
|
47
|
return $_; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
# $original_string = unprintable( $special_characters_escaped ); |
271
|
|
|
|
|
|
|
sub unprintable ($) { |
272
|
12
|
100
|
|
12
|
1
|
38
|
local $_ = ( defined $_[0] ? $_[0] : '' ); |
273
|
12
|
|
|
|
|
39
|
s/((?:\A|\G|[^\\]))\\([rRnNtT\"\\]|[x]?[\da-fA-F]{2})/ $1 . $Unprintable{lc($2)} /gsxe; |
|
17
|
|
|
|
|
111
|
|
274
|
12
|
|
|
|
|
39
|
return $_; |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
# quoted_and_escaped = qprintable( $source_string ); |
278
|
8
|
|
|
8
|
1
|
509
|
sub qprintable ($) { quote_non_words printable $_[0] } |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
# $original_string = unqprintable( quoted_and_escaped ); |
281
|
1
|
|
|
1
|
1
|
6
|
sub unqprintable ($) { unprintable unquote $_[0] } |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
######################################################################## |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
=head2 Other Backslash Functions |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
In addition to the functions listed above, there is also one function that mirrors the behavior of Perl's built-in C<quotemeta()> function. |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
=over 4 |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
=item unquotemeta($value) : $escaped |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
Strips out backslashes before any character. |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
=back |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
=cut |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
sub unquotemeta ($) { |
301
|
0
|
0
|
|
0
|
1
|
0
|
local $_ = ( defined $_[0] ? $_[0] : '' ); |
302
|
0
|
|
|
|
|
0
|
s/ (\A|\G|[^\\]) [\\] (.) / $1 . $2 /gsex; |
|
0
|
|
|
|
|
0
|
|
303
|
0
|
|
|
|
|
0
|
return $_; |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
######################################################################## |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
=head2 Elision Function |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
This function extracts the leading portion of a provided string and appends ellipsis if it's longer than the desired maximum excerpt length. |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
=over 4 |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
=item elide($string) : $elided_string |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
=item elide($string, $length) : $elided_string |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
=item elide($string, $length, $word_boundary_strictness) : $elided_string |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
=item elide($string, $length, $word_boundary_strictness, $elipses) : $elided_string |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
Return a single-quoted, shortened version of the string, with ellipsis. |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
If the original string is shorter than $length, it is returned unchanged. At most $length characters are returned; if called with a single argument, $length defaults to $DefaultLength. |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
Up to $word_boundary_strictness additional characters may be ommited in order to make the elided portion end on a word boundary; you can pass 0 to ignore word boundaries. If not provided, $word_boundary_strictness defaults to $DefaultStrictness. |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
=item $Elipses |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
The string of characters used to indicate the end of the excerpt. Initialized to '...'. |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
=item $DefaultLength |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
The default target excerpt length, used when the elide function is called with a single argument. Initialized to 60. |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
=item $DefaultStrictness |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
The default word-boundary flexibility, used when the elide function is called without the third argument. Initialized to 10. |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
=back |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
Here are a few examples: |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
=over 4 |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
=item * |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
$string = 'foo bar baz this that the other'; |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
print elide( $string, 12 ); |
352
|
|
|
|
|
|
|
# foo bar... |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
print elide( $string, 12, 0 ); |
355
|
|
|
|
|
|
|
# foo bar b... |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
print elide( $string, 100 ); |
358
|
|
|
|
|
|
|
# foo bar baz this that the other |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
=back |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
=cut |
363
|
|
|
|
|
|
|
|
364
|
6
|
|
|
6
|
|
49
|
use vars qw( $Elipses $DefaultLength $DefaultStrictness ); |
|
6
|
|
|
|
|
12
|
|
|
6
|
|
|
|
|
2294
|
|
365
|
|
|
|
|
|
|
$Elipses = '...'; |
366
|
|
|
|
|
|
|
$DefaultLength = 60; |
367
|
|
|
|
|
|
|
$DefaultStrictness = 10; |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
# $elided_string = elide($string); |
370
|
|
|
|
|
|
|
# $elided_string = elide($string, $length); |
371
|
|
|
|
|
|
|
# $elided_string = elide($string, $length, $word_boundary_strictness); |
372
|
|
|
|
|
|
|
# $elided_string = elide($string, $length, $word_boundary_strictness, $elipses); |
373
|
|
|
|
|
|
|
sub elide ($;$$) { |
374
|
4
|
|
|
4
|
1
|
18
|
my $source = shift; |
375
|
4
|
50
|
|
|
|
14
|
my $length = scalar(@_) ? shift() : $DefaultLength; |
376
|
4
|
100
|
|
|
|
10
|
my $word_limit = scalar(@_) ? shift() : $DefaultStrictness; |
377
|
4
|
50
|
|
|
|
9
|
my $elipses = scalar(@_) ? shift() : $Elipses; |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
# If the source is already short, we don't need to do anything |
380
|
4
|
50
|
|
|
|
12
|
return $source if (length($source) < $length); |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
# Leave room for the elipses and make sure we include at least one character. |
383
|
4
|
|
|
|
|
6
|
$length -= length( $elipses ); |
384
|
4
|
50
|
|
|
|
11
|
$length = 1 if ( $length < 1 ); |
385
|
|
|
|
|
|
|
|
386
|
4
|
|
|
|
|
27
|
my $excerpt; |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
# Try matching $length characters or less at a word boundary. |
389
|
4
|
100
|
|
|
|
67
|
$excerpt = ( $source =~ /^(.{0,$length})(?:\s|\Z)/ )[0] if ( $word_limit ); |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
# If that fails or returns much less than we wanted, ignore boundaries |
392
|
4
|
100
|
33
|
|
|
41
|
$excerpt = substr($source, 0, $length) if ( |
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
393
|
|
|
|
|
|
|
! defined $excerpt or |
394
|
|
|
|
|
|
|
length($excerpt) < length($source) and |
395
|
|
|
|
|
|
|
! length($excerpt) || abs($length - length($excerpt)) > $word_limit |
396
|
|
|
|
|
|
|
); |
397
|
|
|
|
|
|
|
|
398
|
4
|
|
|
|
|
24
|
return $excerpt . $elipses; |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
######################################################################## |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
=head2 escape() |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
These functions provide for the registration of string-escape specification |
407
|
|
|
|
|
|
|
names and corresponding functions, and then allow the invocation of one or |
408
|
|
|
|
|
|
|
several of these functions on one or several source string values. |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
=over 4 |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
=item escape($escapes, $value) : $escaped_value |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
=item escape($escapes, @values) : @escaped_values |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
Returns an altered copy of the provided values by looking up the escapes string in a registry of string-modification functions. |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
If called in a scalar context, operates on the single value passed in; if |
419
|
|
|
|
|
|
|
called in a list contact, operates identically on each of the provided values. |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
Space-separated compound specifications like 'quoted uppercase' are expanded to a list of functions to be applied in order. |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
Valid escape specifications are: |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
=over 4 |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
=item one of the keys defined in %Escapes |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
The coresponding specification will be looked up and used. |
430
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
=item a sequence of names separated by whitespace, |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
Each name will be looked up, and each of the associated functions will be applied successively, from left to right. |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
=item a reference to a function |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
The provided function will be called on with each value in turn. |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
=item a reference to an array |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
Each item in the array will be expanded as provided above. |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
=back |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
A fatal error will be generated if you pass an unsupported escape specification, or if the function is called with multiple values in a scalar context. |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
=item String::Escape::names() : @defined_escapes |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
Returns a list of defined escape specification strings. |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
=item String::Escape::add( $escape_name, \&escape_function ); |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
Add a new escape specification and corresponding function. |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
=back |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
By default, all of the public functions described below are available as named escape commands, as well as the following built-in functions: |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
=over 4 |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
=item * |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
none: Return the string unchanged. |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
=item * |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
uppercase: Calls the built-in uc function. |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
=item * |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
lowercase: Calls the built-in lc function. |
472
|
|
|
|
|
|
|
|
473
|
|
|
|
|
|
|
=item * |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
initialcase: Calls the built-in lc and ucfirst functions. |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
=back |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
Here are a few examples: |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
=over 4 |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
=item * |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
C<print escape('qprintable', "\tNow is the time\nfor all good folks\n" );> |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
"\tNow is the time\nfor all good folks\n" |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
=item * |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
C<print escape('uppercase qprintable', "\tNow is the time\nfor all good folks\n" );> |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
"\tNOW IS THE TIME\nFOR ALL GOOD FOLKS\n" |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
=item * |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
C<print join '--', escape('printable', "\tNow is the time\n", "for all good folks\n" );> |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
\tNow is the time\n--for all good folks\n |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
=item * |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
You can add more escaping functions to the supported set by calling add(). |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
C<String::Escape::add( 'html', \&HTML::Entities::encode_entities );> |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
C<print escape('html', "AT&T" );> |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
AT&T |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
=back |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
=cut |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
# %Escapes - escaper function references by name |
516
|
6
|
|
|
6
|
|
96
|
use vars qw( %Escapes ); |
|
6
|
|
|
|
|
11
|
|
|
6
|
|
|
|
|
9289
|
|
517
|
|
|
|
|
|
|
|
518
|
|
|
|
|
|
|
# String::Escape::add( $name, $subroutine ); |
519
|
|
|
|
|
|
|
sub add { |
520
|
6
|
|
|
6
|
1
|
38
|
while ( @_ ) { |
521
|
120
|
|
|
|
|
223
|
my ( $name, $func ) = ( shift, shift ); |
522
|
120
|
|
|
|
|
328
|
$Escapes{ $name } = $func |
523
|
|
|
|
|
|
|
} |
524
|
|
|
|
|
|
|
} |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
# @defined_names = String::Escape::names(); |
527
|
|
|
|
|
|
|
sub names { |
528
|
1
|
|
|
1
|
1
|
263
|
keys(%Escapes) |
529
|
|
|
|
|
|
|
} |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
# $escaped = escape($escape_spec, $value); |
532
|
|
|
|
|
|
|
# @escaped = escape($escape_spec, @values); |
533
|
|
|
|
|
|
|
sub escape { |
534
|
3
|
|
|
3
|
1
|
129
|
my ($escape_spec, @values) = @_; |
535
|
|
|
|
|
|
|
|
536
|
3
|
|
|
|
|
8
|
my @escapes = _expand_escape_spec($escape_spec); |
537
|
|
|
|
|
|
|
|
538
|
2
|
|
|
|
|
4
|
foreach my $value ( @values ) { |
539
|
5
|
|
|
|
|
13
|
foreach my $escaper ( @escapes ) { |
540
|
5
|
|
|
|
|
8
|
$value = &$escaper( $value ); |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
} |
543
|
|
|
|
|
|
|
|
544
|
2
|
100
|
|
|
|
10
|
if ( wantarray ) { |
|
|
50
|
|
|
|
|
|
545
|
|
|
|
|
|
|
@values |
546
|
1
|
|
|
|
|
4
|
} elsif ( @values > 1 ) { |
547
|
0
|
|
|
|
|
0
|
croak "escape called with multiple values but in scalar context" |
548
|
|
|
|
|
|
|
} else { |
549
|
1
|
|
|
|
|
8
|
$values[0] |
550
|
|
|
|
|
|
|
} |
551
|
|
|
|
|
|
|
} |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
# @escape_functions = _expand_escape_spec($escape_spec); |
554
|
|
|
|
|
|
|
sub _expand_escape_spec { |
555
|
4
|
|
|
4
|
|
5
|
my $escape_spec = shift; |
556
|
|
|
|
|
|
|
|
557
|
4
|
100
|
|
|
|
15
|
if ( ref($escape_spec) eq 'CODE' ) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
558
|
2
|
|
|
|
|
26
|
return $escape_spec; |
559
|
|
|
|
|
|
|
} elsif ( ref($escape_spec) eq 'ARRAY' ) { |
560
|
0
|
|
|
|
|
0
|
return map { _expand_escape_spec($_) } @$escape_spec; |
|
0
|
|
|
|
|
0
|
|
561
|
|
|
|
|
|
|
} elsif ( ! ref($escape_spec) ) { |
562
|
1
|
|
|
|
|
4
|
return map { |
563
|
2
|
100
|
|
|
|
13
|
_expand_escape_spec($_) |
564
|
|
|
|
|
|
|
} map { |
565
|
2
|
|
|
|
|
6
|
$Escapes{$_} or _unsupported_escape_spec( $_ ) |
566
|
|
|
|
|
|
|
} split(/\s+/, $escape_spec); |
567
|
|
|
|
|
|
|
} else { |
568
|
0
|
|
|
|
|
0
|
_unsupported_escape_spec( $escape_spec ); |
569
|
|
|
|
|
|
|
} |
570
|
|
|
|
|
|
|
} |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
# _unsupported_escape_spec($escape_spec); |
573
|
|
|
|
|
|
|
sub _unsupported_escape_spec { |
574
|
1
|
|
|
1
|
|
2
|
my $escape_spec = shift; |
575
|
|
|
|
|
|
|
|
576
|
1
|
50
|
|
|
|
8
|
croak( |
577
|
|
|
|
|
|
|
"unsupported escape specification " . |
578
|
|
|
|
|
|
|
( defined($escape_spec) ? "'$_'" : 'undef' ) . "; " . |
579
|
|
|
|
|
|
|
"should be one of " . join(', ', names()) |
580
|
|
|
|
|
|
|
) |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
add( |
584
|
|
|
|
|
|
|
'none' => sub ($) { $_[0]; }, |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
'uppercase' => sub ($) { uc $_[0] }, |
587
|
|
|
|
|
|
|
'lowercase' => sub ($) { lc $_[0] }, |
588
|
|
|
|
|
|
|
'initialcase' => sub ($) { ucfirst lc $_[0] }, |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
'quote' => \"e, |
591
|
|
|
|
|
|
|
'unquote' => \&unquote, |
592
|
|
|
|
|
|
|
'quote_non_words' => \"e_non_words, |
593
|
|
|
|
|
|
|
'singlequote' => \&singlequote, |
594
|
|
|
|
|
|
|
'unsinglequote' => \&unsinglequote, |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
'backslash' => \&backslash, |
597
|
|
|
|
|
|
|
'unbackslash' => \&unbackslash, |
598
|
|
|
|
|
|
|
'qqbackslash' => \&qqbackslash, #b |
599
|
|
|
|
|
|
|
'unqqbackslash' => \&unqqbackslash, |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
'printable' => \&printable, |
602
|
|
|
|
|
|
|
'unprintable' => \&unprintable, |
603
|
|
|
|
|
|
|
'qprintable' => \&qprintable, |
604
|
|
|
|
|
|
|
'unqprintable' => \&unqprintable, |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
'quotemeta' => sub ($) { quotemeta $_[0] }, |
607
|
|
|
|
|
|
|
'unquotemeta' => \&unquotemeta, |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
'elide' => \&elide, |
610
|
|
|
|
|
|
|
); |
611
|
|
|
|
|
|
|
|
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
######################################################################## |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
=head2 Space-separated Lists and Hashes |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
=over 4 |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
=item @words = string2list( $space_separated_phrases ); |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
Converts a space separated string of words and quoted phrases to an array; |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
=item $space_sparated_string = list2string( @words ); |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
Joins an array of strings into a space separated string of words and quoted phrases; |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
=item %hash = string2hash( $string ); |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
Converts a space separated string of equal-sign-associated key=value pairs into a simple hash. |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
=item $string = hash2string( %hash ); |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
Converts a simple hash into a space separated string of equal-sign-associated key=value pairs. |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
=item %hash = list2hash( @words ); |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
Converts an array of equal-sign-associated key=value strings into a simple hash. |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
=item @words = hash2list( %hash ); |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
Converts a hash to an array of equal-sign-associated key=value strings. |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
=back |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
Here are a few examples: |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
=over 4 |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
=item * |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
C<print list2string('hello', 'I move next march');> |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
hello "I move next march" |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
=item * |
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
C<@list = string2list('one "second item" 3 "four\nlines\nof\ntext"');> |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
C<print $list[1];> |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
second item |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
=item * |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
C<print hash2string( 'foo' =E<gt> 'Animal Cities', 'bar' =E<gt> 'Cheap' );> |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
foo="Animal Cities" bar=Cheap |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
=item * |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
C<%hash = string2hash('key=value "undefined key" words="the cat in the hat"');> |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
C<print $hash{'words'};> |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
the cat in the hat |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
C<print exists $hash{'undefined_key'} and ! defined $hash{'undefined_key'};> |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
1 |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
=back |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
=cut |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
# @words = string2list( $space_separated_phrases ); |
686
|
|
|
|
|
|
|
sub string2list { |
687
|
2
|
|
|
2
|
1
|
26
|
my $text = shift; |
688
|
|
|
|
|
|
|
|
689
|
2
|
50
|
|
|
|
9
|
carp "string2list called with a non-text argument, '$text'" if (ref $text); |
690
|
|
|
|
|
|
|
|
691
|
2
|
|
|
|
|
3
|
my @words; |
692
|
2
|
|
|
|
|
5
|
my $word = ''; |
693
|
|
|
|
|
|
|
|
694
|
2
|
|
|
|
|
7
|
while ( length $text ) { |
695
|
13
|
100
|
|
|
|
118
|
if ($text =~ s/\A(?: ([^\"\s\\]+) | \\(.) )//mx) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
696
|
4
|
|
|
|
|
14
|
$word .= $1; |
697
|
|
|
|
|
|
|
} elsif ($text =~ s/\A"((?:[^\"\\]|\\.)*)"//mx) { |
698
|
4
|
|
|
|
|
14
|
$word .= $1; |
699
|
|
|
|
|
|
|
} elsif ($text =~ s/\A\s+//m){ |
700
|
5
|
|
|
|
|
12
|
push(@words, unprintable($word)); |
701
|
5
|
|
|
|
|
13
|
$word = ''; |
702
|
|
|
|
|
|
|
} elsif ($text =~ s/\A"//) { |
703
|
0
|
|
|
|
|
0
|
carp "string2list found an unmatched quote at '$text'"; |
704
|
0
|
|
|
|
|
0
|
return; |
705
|
|
|
|
|
|
|
} else { |
706
|
0
|
|
|
|
|
0
|
carp "string2list parse exception at '$text'"; |
707
|
0
|
|
|
|
|
0
|
return; |
708
|
|
|
|
|
|
|
} |
709
|
|
|
|
|
|
|
} |
710
|
2
|
|
|
|
|
7
|
push(@words, unprintable($word)); |
711
|
|
|
|
|
|
|
|
712
|
2
|
|
|
|
|
13
|
return @words; |
713
|
|
|
|
|
|
|
} |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
# $space_sparated_string = list2string( @words ); |
716
|
|
|
|
|
|
|
sub list2string { |
717
|
1
|
|
|
1
|
1
|
12
|
join ( ' ', map qprintable($_), @_ ); |
718
|
|
|
|
|
|
|
} |
719
|
|
|
|
|
|
|
|
720
|
|
|
|
|
|
|
# %hash = list2hash( @words ); |
721
|
|
|
|
|
|
|
sub list2hash { |
722
|
1
|
|
|
1
|
1
|
2
|
my @pairs; |
723
|
1
|
|
|
|
|
3
|
foreach (@_) { |
724
|
3
|
|
|
|
|
18
|
my ($key, $val) = m/\A(.*?)(?:\=(.*))?\Z/s; |
725
|
3
|
|
|
|
|
9
|
push @pairs, $key, $val; |
726
|
|
|
|
|
|
|
} |
727
|
1
|
|
|
|
|
8
|
return @pairs; |
728
|
|
|
|
|
|
|
} |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
# @words = hash2list( %hash ); |
731
|
|
|
|
|
|
|
sub hash2list { |
732
|
1
|
|
|
1
|
1
|
1
|
my @words; |
733
|
1
|
|
|
|
|
6
|
while ( scalar @_ ) { |
734
|
2
|
|
|
|
|
4
|
my ($key, $value) = ( shift, shift ); |
735
|
2
|
|
|
|
|
5
|
push @words, qprintable($key) . '=' . qprintable($value) |
736
|
|
|
|
|
|
|
} |
737
|
1
|
|
|
|
|
7
|
return @words; |
738
|
|
|
|
|
|
|
} |
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
# %hash = string2hash( $string ); |
741
|
|
|
|
|
|
|
sub string2hash { |
742
|
1
|
|
|
1
|
1
|
4
|
return list2hash( string2list( shift ) ); |
743
|
|
|
|
|
|
|
} |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
# $string = hash2string( %hash ); |
746
|
|
|
|
|
|
|
sub hash2string { |
747
|
1
|
|
|
1
|
1
|
6
|
join ( ' ', hash2list( @_ ) ); |
748
|
|
|
|
|
|
|
} |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
######################################################################## |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
=head1 SEE ALSO |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
Numerous modules provide collections of string escaping functions for specific contexts. |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
The string2list function is similar to to the quotewords function in the standard distribution; see L<Text::ParseWords>. |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
Use other packages to stringify more complex data structures; see L<Storable>, L<Data::Dumper>, or other similar package. |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
=cut |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
######################################################################## |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
=head1 BUGS |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
The following issues or changes are under consideration for future releases: |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
=over 4 |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
=item * |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
Does this problem with the \r character only show up on Windows? (And is it, in fact, a feature rather than a bug?) |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
http://rt.cpan.org/Public/Bug/Display.html?id=19766 |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
=item * |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
Consider changes to word parsing in string2list: Perhaps use \b word-boundary test in elide's regular expression rather than \s|\Z? Perhaps quotes embedded in a word (eg: a@"!a) shouldn't cause phrase breaks? |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
=item * |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
Check for possible problems in the use of printable escaping functions and list2hash. For example, are the encoded strings for hashes with high-bit characters in their keys properly unquoted and unescaped? |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
=item * |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
We should allow escape specifications to contain = signs and optional arguments, so that users can request certain string lengths with C<escape("lowercase elide=20 quoted", @_>. |
790
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
=back |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
=head1 VERSION |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
This is version 2010.002. |
797
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
=head1 INSTALLATION |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
This package should run on any standard Perl 5 installation. |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
To install this package, download the distribution from a CPAN mirror, |
804
|
|
|
|
|
|
|
unpack the archive file, and execute the standard "perl Makefile.PL", |
805
|
|
|
|
|
|
|
"make test", "make install" sequence or your local equivalent. |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
=head1 SUPPORT |
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
Once installed, this module's documentation is available as a |
811
|
|
|
|
|
|
|
manual page via C<perldoc String::Escape> or on CPAN sites |
812
|
|
|
|
|
|
|
such as C<http://search.cpan.org/dist/String-Escape>. |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
If you have questions or feedback about this module, please feel free to |
815
|
|
|
|
|
|
|
contact the author at the address shown below. Although there is no formal |
816
|
|
|
|
|
|
|
support program, I do attempt to answer email promptly. Bug reports that |
817
|
|
|
|
|
|
|
contain a failing test case are greatly appreciated, and suggested patches |
818
|
|
|
|
|
|
|
will be promptly considered for inclusion in future releases. |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
You can report bugs and request features via the CPAN web tracking system |
821
|
|
|
|
|
|
|
at C<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=String-Escape> or by |
822
|
|
|
|
|
|
|
sending mail to C<bug-string-escape at rt.cpan.org>. |
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
If you've found this module useful or have feedback about your |
825
|
|
|
|
|
|
|
experience with it, consider sharing your opinion with other Perl users |
826
|
|
|
|
|
|
|
by posting your comment to CPAN's ratings system |
827
|
|
|
|
|
|
|
(C<http://cpanratings.perl.org/rate/?distribution=String-Escape>). |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
For more general discussion, you may wish to post a message on PerlMonks |
830
|
|
|
|
|
|
|
(C<http://perlmonks.org/?node=Seekers%20of%20Perl%20Wisdom>) or on the |
831
|
|
|
|
|
|
|
comp.lang.perl.misc newsgroup |
832
|
|
|
|
|
|
|
(C<http://groups.google.com/group/comp.lang.perl.misc/topics>). |
833
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
=head1 AUTHOR |
837
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
Matthew Simon Cavalletto, C<< <simonm at cavalletto.org> >> |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
Initial versions developed at Evolution Online Systems with Eleanor J. Evans and Jeremy G. Bishop. |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
=head1 LICENSE |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
Copyright 2010, 2002 Matthew Simon Cavalletto. |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
Portions copyright 1996, 1997, 1998, 2001 Evolution Online Systems, Inc. |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
You may use, modify, and distribute this software under the same terms as Perl. |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
See http://dev.perl.org/licenses/ for more information. |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
=cut |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
######################################################################## |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
1; # End of String::Escape |