← Index
NYTProf Performance Profile   « block view • line view • sub view »
For xt/tapper-mcp-scheduler-with-db-longrun.t
  Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:23:21 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/String/Escape.pm
StatementsExecuted 84 statements in 4.31ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111739µs739µsString::Escape::::_define_backslash_escapesString::Escape::_define_backslash_escapes
51221217µs217µsString::Escape::::CORE:unpackString::Escape::CORE:unpack (opcode)
11130µs30µsString::Escape::::addString::Escape::add
11123µs57µsString::Escape::::BEGIN@364String::Escape::BEGIN@364
11112µs14µsString::Escape::::BEGIN@9String::Escape::BEGIN@9
11110µs23µsString::Escape::::BEGIN@55String::Escape::BEGIN@55
1118µs30µsString::Escape::::BEGIN@13String::Escape::BEGIN@13
1118µs23µsString::Escape::::BEGIN@516String::Escape::BEGIN@516
1117µs36µsString::Escape::::BEGIN@11String::Escape::BEGIN@11
1117µs14µsString::Escape::::BEGIN@10String::Escape::BEGIN@10
1117µs33µsString::Escape::::BEGIN@182String::Escape::BEGIN@182
1116µs35µsString::Escape::::BEGIN@57String::Escape::BEGIN@57
1116µs32µsString::Escape::::BEGIN@255String::Escape::BEGIN@255
0000s0sString::Escape::::__ANON__[:584]String::Escape::__ANON__[:584]
0000s0sString::Escape::::__ANON__[:586]String::Escape::__ANON__[:586]
0000s0sString::Escape::::__ANON__[:587]String::Escape::__ANON__[:587]
0000s0sString::Escape::::__ANON__[:588]String::Escape::__ANON__[:588]
0000s0sString::Escape::::__ANON__[:606]String::Escape::__ANON__[:606]
0000s0sString::Escape::::_expand_escape_specString::Escape::_expand_escape_spec
0000s0sString::Escape::::_unsupported_escape_specString::Escape::_unsupported_escape_spec
0000s0sString::Escape::::backslashString::Escape::backslash
0000s0sString::Escape::::elideString::Escape::elide
0000s0sString::Escape::::escapeString::Escape::escape
0000s0sString::Escape::::hash2listString::Escape::hash2list
0000s0sString::Escape::::hash2stringString::Escape::hash2string
0000s0sString::Escape::::list2hashString::Escape::list2hash
0000s0sString::Escape::::list2stringString::Escape::list2string
0000s0sString::Escape::::namesString::Escape::names
0000s0sString::Escape::::printableString::Escape::printable
0000s0sString::Escape::::qprintableString::Escape::qprintable
0000s0sString::Escape::::qqbackslashString::Escape::qqbackslash
0000s0sString::Escape::::quoteString::Escape::quote
0000s0sString::Escape::::quote_non_wordsString::Escape::quote_non_words
0000s0sString::Escape::::singlequoteString::Escape::singlequote
0000s0sString::Escape::::string2hashString::Escape::string2hash
0000s0sString::Escape::::string2listString::Escape::string2list
0000s0sString::Escape::::unbackslashString::Escape::unbackslash
0000s0sString::Escape::::unprintableString::Escape::unprintable
0000s0sString::Escape::::unqprintableString::Escape::unqprintable
0000s0sString::Escape::::unqqbackslashString::Escape::unqqbackslash
0000s0sString::Escape::::unquoteString::Escape::unquote
0000s0sString::Escape::::unquotemetaString::Escape::unquotemeta
0000s0sString::Escape::::unsinglequoteString::Escape::unsinglequote
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1=head1 NAME
2
3String::Escape - Backslash escapes, quoted phrase, word elision, etc.
4
5=cut
6
7package String::Escape;
8
9317µs216µs
# spent 14µs (12+2) within String::Escape::BEGIN@9 which was called: # once (12µs+2µs) by Devel::Backtrace::Point::BEGIN@6 at line 9
use strict;
# spent 14µs making 1 call to String::Escape::BEGIN@9 # spent 2µs making 1 call to strict::import
10320µs222µs
# spent 14µs (7+7) within String::Escape::BEGIN@10 which was called: # once (7µs+7µs) by Devel::Backtrace::Point::BEGIN@6 at line 10
use warnings;
# spent 14µs making 1 call to String::Escape::BEGIN@10 # spent 7µs making 1 call to warnings::import
11321µs264µs
# spent 36µs (7+28) within String::Escape::BEGIN@11 which was called: # once (7µs+28µs) by Devel::Backtrace::Point::BEGIN@6 at line 11
use Carp;
# spent 36µs making 1 call to String::Escape::BEGIN@11 # spent 28µs making 1 call to Exporter::import
12
13343µs252µs
# spent 30µs (8+22) within String::Escape::BEGIN@13 which was called: # once (8µs+22µs) by Devel::Backtrace::Point::BEGIN@6 at line 13
use vars qw( $VERSION );
# spent 30µs making 1 call to String::Escape::BEGIN@13 # spent 22µs making 1 call to vars::import
141600ns$VERSION = 2010.002;
15
16########################################################################
17
18=head1 SYNOPSIS
19
20This 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
49All of the public functions described below are available as optional exports.
50
51You 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
55321µs236µs
# spent 23µs (10+13) within String::Escape::BEGIN@55 which was called: # once (10µs+13µs) by Devel::Backtrace::Point::BEGIN@6 at line 55
use Exporter;
# spent 23µs making 1 call to String::Escape::BEGIN@55 # spent 13µs making 1 call to Exporter::import
56
573218µs264µs
# spent 35µs (6+29) within String::Escape::BEGIN@57 which was called: # once (6µs+29µs) by Devel::Backtrace::Point::BEGIN@6 at line 57
use vars qw( @ISA @EXPORT_OK );
# spent 35µs making 1 call to String::Escape::BEGIN@57 # spent 29µs making 1 call to vars::import
58
59110µspush @ISA, qw( Exporter );
6016µspush @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
75Each of these functions takes a single simple scalar argument and
76returns its escaped (or unescaped) equivalent.
77
78=over 4
79
80=item quote($value) : $escaped
81
82Add double quote characters to each end of the string.
83
84=item unquote($value) : $escaped
85
86If 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
90As 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
94Add single quote characters to each end of the string.
95
96=item unsinglequote($value) : $escaped
97
98If 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 );
105sub quote ($) {
106 '"' . $_[0] . '"'
107}
108
109# $remove_surrounding_quotes = quote( $string_value );
110sub unquote ($) {
111 ( $_[0] =~ m/ \A ["] (.*) ["] \Z /sx ) ? $1 : $_[0];
112}
113
114# $word_or_phrase_with_surrounding_quotes = quote( $string_value );
115sub quote_non_words ($) {
116 ( ! length $_[0] or $_[0] =~ /[^\w\_\-\/\.\:\#]/ ) ? '"'.$_[0].'"' : $_[0]
117}
118
119# $with_surrounding_quotes = singlequote( $string_value );
120sub singlequote ($) {
121 '\'' . $_[0] . '\''
122}
123
124# $remove_surrounding_quotes = singlequote( $string_value );
125sub unsinglequote ($) {
126 ( $_[0] =~ m/ \A ['] (.*) ['] \Z /sx ) ? $1 : $_[0];
127}
128
129
130########################################################################
131
132=head2 Backslash Escaping Functions
133
134Each of these functions takes a single simple scalar argument and
135returns its escaped (or unescaped) equivalent.
136
137These functions recognize common whitespace sequences C<\r>, C<\n>, and C<\t>, as well as hex escapes C<\x4F> and ocatal C<\020>.
138
139When 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
145Converts special characters to their backslash-escaped equivalents.
146
147=item unbackslash($value) : $escaped
148
149Converts backslash escape sequences in a string back to their original characters.
150
151=item qqbackslash($value) : $escaped
152
153Converts special characters to their backslash-escaped equivalents and then wraps the results with double quotes.
154
155=item unqqbackslash($value) : $escaped
156
157Strips surrounding double quotes then converts backslash escape sequences back to their original characters.
158
159=back
160
161Here 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
1823322µs259µs
# spent 33µs (7+26) within String::Escape::BEGIN@182 which was called: # once (7µs+26µs) by Devel::Backtrace::Point::BEGIN@6 at line 182
use vars qw( %Backslashed %Interpolated );
# spent 33µs making 1 call to String::Escape::BEGIN@182 # spent 26µs making 1 call to vars::import
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) ),
1891829µs257874µs ( map { sprintf('%03o', $_) => chr($_) } (0..255) ),
# spent 739µs making 1 call to String::Escape::_define_backslash_escapes # spent 135µs making 256 calls to String::Escape::CORE:unpack, avg 526ns/call
190);
191
192
# spent 739µs within String::Escape::_define_backslash_escapes which was called: # once (739µs+0s) by Devel::Backtrace::Point::BEGIN@6 at line 189
sub _define_backslash_escapes {
1932734µs %Interpolated = @_;
194 %Backslashed = reverse @_;
195}
196
197# $special_characters_escaped = backslash( $source_string );
198sub backslash ($) {
199 local $_ = ( defined $_[0] ? $_[0] : '' );
200 # Preserve only printable ASCII characters other than \, ", $, and @
201 s/([^\x20\x21\x24\x25-\x39\x41-\x5b\x5d-\x7e])/\\$Backslashed{$1}/gs;
202 return $_;
203}
204
205# $original_string = unbackslash( $special_characters_escaped );
206sub unbackslash ($) {
207 local $_ = ( defined $_[0] ? $_[0] : '' );
208 s/ (\A|\G|[^\\]) [\\] ( [0]\d\d | [x][\da-fA-F]{2} | . ) / $1 . ( $Interpolated{lc($2) }) /gsxe;
209 return $_;
210}
211
212# quoted_and_escaped = qqbackslash( $source_string );
213sub qqbackslash ($) { quote backslash $_[0] }
214
215# $original_string = unqqbackslash( quoted_and_escaped );
216sub unqqbackslash ($) { unbackslash unquote $_[0] }
217
218
219########################################################################
220
221=head2 Legacy Backslash Functions
222
223In addition to the four functions listed above, there is a corresponding set which use a slightly different set of escape sequences.
224
225These functions do not support as many escape sequences and use a non-standard
226format for hex escapes. In general, the above C<backslash()> functions are
227recommended, while these functions are retained for legacy compatibility
228purposes.
229
230=over 4
231
232=item printable($value) : $escaped
233
234Converts return, newline, tab, backslash and unprintable
235characters to their backslash-escaped equivalents.
236
237=item unprintable($value) : $escaped
238
239Converts backslash escape sequences in a string back to their original value.
240
241=item qprintable($value) : $escaped
242
243Converts 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
249Strips surrounding double quotes then converts backslash escape sequences back to their original value.
250
251=back
252
253=cut
254
2553296µs257µs
# spent 32µs (6+25) within String::Escape::BEGIN@255 which was called: # once (6µs+25µs) by Devel::Backtrace::Point::BEGIN@6 at line 255
use vars qw( %Printable %Unprintable );
# spent 32µs making 1 call to String::Escape::BEGIN@255 # spent 25µs making 1 call to vars::import
256%Printable = (
257 ( map { chr($_), unpack('H2', chr($_)) } (0..255) ),
258 ( "\\"=>'\\', "\r"=>'r', "\n"=>'n', "\t"=>'t', ),
2591573µs25683µs ( map { $_ => $_ } ( '"' ) )
# spent 83µs making 256 calls to String::Escape::CORE:unpack, avg 323ns/call
260);
2611140µs%Unprintable = ( reverse %Printable );
262
263# $special_characters_escaped = printable( $source_string );
264sub printable ($) {
265 local $_ = ( defined $_[0] ? $_[0] : '' );
266 s/([\r\n\t\"\\\x00-\x1f\x7F-\xFF])/ '\\' . $Printable{$1} /gsxe;
267 return $_;
268}
269
270# $original_string = unprintable( $special_characters_escaped );
271sub unprintable ($) {
272 local $_ = ( defined $_[0] ? $_[0] : '' );
273 s/((?:\A|\G|[^\\]))\\([rRnNtT\"\\]|[x]?[\da-fA-F]{2})/ $1 . $Unprintable{lc($2)} /gsxe;
274 return $_;
275}
276
277# quoted_and_escaped = qprintable( $source_string );
278sub qprintable ($) { quote_non_words printable $_[0] }
279
280# $original_string = unqprintable( quoted_and_escaped );
281sub unqprintable ($) { unprintable unquote $_[0] }
282
283
284########################################################################
285
286=head2 Other Backslash Functions
287
288In 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
294Strips out backslashes before any character.
295
296=back
297
298=cut
299
300sub unquotemeta ($) {
301 local $_ = ( defined $_[0] ? $_[0] : '' );
302 s/ (\A|\G|[^\\]) [\\] (.) / $1 . $2 /gsex;
303 return $_;
304}
305
306
307########################################################################
308
309=head2 Elision Function
310
311This 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
323Return a single-quoted, shortened version of the string, with ellipsis.
324
325If 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
327Up 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
331The string of characters used to indicate the end of the excerpt. Initialized to '...'.
332
333=item $DefaultLength
334
335The default target excerpt length, used when the elide function is called with a single argument. Initialized to 60.
336
337=item $DefaultStrictness
338
339The default word-boundary flexibility, used when the elide function is called without the third argument. Initialized to 10.
340
341=back
342
343Here 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
3643178µs291µs
# spent 57µs (23+34) within String::Escape::BEGIN@364 which was called: # once (23µs+34µs) by Devel::Backtrace::Point::BEGIN@6 at line 364
use vars qw( $Elipses $DefaultLength $DefaultStrictness );
# spent 57µs making 1 call to String::Escape::BEGIN@364 # spent 34µs making 1 call to vars::import
3651700ns$Elipses = '...';
3661500ns$DefaultLength = 60;
3671500ns$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);
373sub elide ($;$$) {
374 my $source = shift;
375 my $length = scalar(@_) ? shift() : $DefaultLength;
376 my $word_limit = scalar(@_) ? shift() : $DefaultStrictness;
377 my $elipses = scalar(@_) ? shift() : $Elipses;
378
379 # If the source is already short, we don't need to do anything
380 return $source if (length($source) < $length);
381
382 # Leave room for the elipses and make sure we include at least one character.
383 $length -= length( $elipses );
384 $length = 1 if ( $length < 1 );
385
386 my $excerpt;
387
388 # Try matching $length characters or less at a word boundary.
389 $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 $excerpt = substr($source, 0, $length) if (
393 ! defined $excerpt or
394 length($excerpt) < length($source) and
395 ! length($excerpt) || abs($length - length($excerpt)) > $word_limit
396 );
397
398 return $excerpt . $elipses;
399}
400
401
402########################################################################
403
404=head2 escape()
405
406These functions provide for the registration of string-escape specification
407names and corresponding functions, and then allow the invocation of one or
408several 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
416Returns an altered copy of the provided values by looking up the escapes string in a registry of string-modification functions.
417
418If called in a scalar context, operates on the single value passed in; if
419called in a list contact, operates identically on each of the provided values.
420
421Space-separated compound specifications like 'quoted uppercase' are expanded to a list of functions to be applied in order.
422
423Valid escape specifications are:
424
425=over 4
426
427=item one of the keys defined in %Escapes
428
429The coresponding specification will be looked up and used.
430
431=item a sequence of names separated by whitespace,
432
433Each 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
437The provided function will be called on with each value in turn.
438
439=item a reference to an array
440
441Each item in the array will be expanded as provided above.
442
443=back
444
445A 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
449Returns a list of defined escape specification strings.
450
451=item String::Escape::add( $escape_name, \&escape_function );
452
453Add a new escape specification and corresponding function.
454
455=back
456
457By 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
463none: Return the string unchanged.
464
465=item *
466
467uppercase: Calls the built-in uc function.
468
469=item *
470
471lowercase: Calls the built-in lc function.
472
473=item *
474
475initialcase: Calls the built-in lc and ucfirst functions.
476
477=back
478
479Here are a few examples:
480
481=over 4
482
483=item *
484
485C<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
491C<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
497C<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
503You can add more escaping functions to the supported set by calling add().
504
505C<String::Escape::add( 'html', \&HTML::Entities::encode_entities );>
506
507C<print escape('html', "AT&T" );>
508
509 AT&amp;T
510
511=back
512
513=cut
514
515# %Escapes - escaper function references by name
5163786µs239µs
# spent 23µs (8+16) within String::Escape::BEGIN@516 which was called: # once (8µs+16µs) by Devel::Backtrace::Point::BEGIN@6 at line 516
use vars qw( %Escapes );
# spent 23µs making 1 call to String::Escape::BEGIN@516 # spent 16µs making 1 call to vars::import
517
518# String::Escape::add( $name, $subroutine );
519
# spent 30µs within String::Escape::add which was called: # once (30µs+0s) by Devel::Backtrace::Point::BEGIN@6 at line 607
sub add {
52014µs while ( @_ ) {
5214027µs my ( $name, $func ) = ( shift, shift );
522 $Escapes{ $name } = $func
523 }
524}
525
526# @defined_names = String::Escape::names();
527sub names {
528 keys(%Escapes)
529}
530
531# $escaped = escape($escape_spec, $value);
532# @escaped = escape($escape_spec, @values);
533sub escape {
534 my ($escape_spec, @values) = @_;
535
536 my @escapes = _expand_escape_spec($escape_spec);
537
538 foreach my $value ( @values ) {
539 foreach my $escaper ( @escapes ) {
540 $value = &$escaper( $value );
541 }
542 }
543
544 if ( wantarray ) {
545 @values
546 } elsif ( @values > 1 ) {
547 croak "escape called with multiple values but in scalar context"
548 } else {
549 $values[0]
550 }
551}
552
553# @escape_functions = _expand_escape_spec($escape_spec);
554sub _expand_escape_spec {
555 my $escape_spec = shift;
556
557 if ( ref($escape_spec) eq 'CODE' ) {
558 return $escape_spec;
559 } elsif ( ref($escape_spec) eq 'ARRAY' ) {
560 return map { _expand_escape_spec($_) } @$escape_spec;
561 } elsif ( ! ref($escape_spec) ) {
562 return map {
563 _expand_escape_spec($_)
564 } map {
565 $Escapes{$_} or _unsupported_escape_spec( $_ )
566 } split(/\s+/, $escape_spec);
567 } else {
568 _unsupported_escape_spec( $escape_spec );
569 }
570}
571
572# _unsupported_escape_spec($escape_spec);
573sub _unsupported_escape_spec {
574 my $escape_spec = shift;
575
576 croak(
577 "unsupported escape specification " .
578 ( defined($escape_spec) ? "'$_'" : 'undef' ) . "; " .
579 "should be one of " . join(', ', names())
580 )
581}
582
583add(
584 'none' => sub ($) { $_[0]; },
585
586 'uppercase' => sub ($) { uc $_[0] },
587 'lowercase' => sub ($) { lc $_[0] },
588 'initialcase' => sub ($) { ucfirst lc $_[0] },
589
590 'quote' => \&quote,
591 'unquote' => \&unquote,
592 'quote_non_words' => \&quote_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] },
607119µs130µs 'unquotemeta' => \&unquotemeta,
# spent 30µs making 1 call to String::Escape::add
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
621Converts a space separated string of words and quoted phrases to an array;
622
623=item $space_sparated_string = list2string( @words );
624
625Joins an array of strings into a space separated string of words and quoted phrases;
626
627=item %hash = string2hash( $string );
628
629Converts a space separated string of equal-sign-associated key=value pairs into a simple hash.
630
631=item $string = hash2string( %hash );
632
633Converts a simple hash into a space separated string of equal-sign-associated key=value pairs.
634
635=item %hash = list2hash( @words );
636
637Converts an array of equal-sign-associated key=value strings into a simple hash.
638
639=item @words = hash2list( %hash );
640
641Converts a hash to an array of equal-sign-associated key=value strings.
642
643=back
644
645Here are a few examples:
646
647=over 4
648
649=item *
650
651C<print list2string('hello', 'I move next march');>
652
653 hello "I move next march"
654
655=item *
656
657C<@list = string2list('one "second item" 3 "four\nlines\nof\ntext"');>
658
659C<print $list[1];>
660
661 second item
662
663=item *
664
665C<print hash2string( 'foo' =E<gt> 'Animal Cities', 'bar' =E<gt> 'Cheap' );>
666
667 foo="Animal Cities" bar=Cheap
668
669=item *
670
671C<%hash = string2hash('key=value "undefined key" words="the cat in the hat"');>
672
673C<print $hash{'words'};>
674
675 the cat in the hat
676
677C<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 );
686sub string2list {
687 my $text = shift;
688
689 carp "string2list called with a non-text argument, '$text'" if (ref $text);
690
691 my @words;
692 my $word = '';
693
694 while ( length $text ) {
695 if ($text =~ s/\A(?: ([^\"\s\\]+) | \\(.) )//mx) {
696 $word .= $1;
697 } elsif ($text =~ s/\A"((?:[^\"\\]|\\.)*)"//mx) {
698 $word .= $1;
699 } elsif ($text =~ s/\A\s+//m){
700 push(@words, unprintable($word));
701 $word = '';
702 } elsif ($text =~ s/\A"//) {
703 carp "string2list found an unmatched quote at '$text'";
704 return;
705 } else {
706 carp "string2list parse exception at '$text'";
707 return;
708 }
709 }
710 push(@words, unprintable($word));
711
712 return @words;
713}
714
715# $space_sparated_string = list2string( @words );
716sub list2string {
717 join ( ' ', map qprintable($_), @_ );
718}
719
720# %hash = list2hash( @words );
721sub list2hash {
722 my @pairs;
723 foreach (@_) {
724 my ($key, $val) = m/\A(.*?)(?:\=(.*))?\Z/s;
725 push @pairs, $key, $val;
726 }
727 return @pairs;
728}
729
730# @words = hash2list( %hash );
731sub hash2list {
732 my @words;
733 while ( scalar @_ ) {
734 my ($key, $value) = ( shift, shift );
735 push @words, qprintable($key) . '=' . qprintable($value)
736 }
737 return @words;
738}
739
740# %hash = string2hash( $string );
741sub string2hash {
742 return list2hash( string2list( shift ) );
743}
744
745# $string = hash2string( %hash );
746sub hash2string {
747 join ( ' ', hash2list( @_ ) );
748}
749
750
751########################################################################
752
753=head1 SEE ALSO
754
755Numerous modules provide collections of string escaping functions for specific contexts.
756
757The string2list function is similar to to the quotewords function in the standard distribution; see L<Text::ParseWords>.
758
759Use 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
769The following issues or changes are under consideration for future releases:
770
771=over 4
772
773=item *
774
775Does 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
781Consider 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
785Check 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
789We 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
796This is version 2010.002.
797
798
799=head1 INSTALLATION
800
801This package should run on any standard Perl 5 installation.
802
803To install this package, download the distribution from a CPAN mirror,
804unpack 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
810Once installed, this module's documentation is available as a
811manual page via C<perldoc String::Escape> or on CPAN sites
812such as C<http://search.cpan.org/dist/String-Escape>.
813
814If you have questions or feedback about this module, please feel free to
815contact the author at the address shown below. Although there is no formal
816support program, I do attempt to answer email promptly. Bug reports that
817contain a failing test case are greatly appreciated, and suggested patches
818will be promptly considered for inclusion in future releases.
819
820You can report bugs and request features via the CPAN web tracking system
821at C<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=String-Escape> or by
822sending mail to C<bug-string-escape at rt.cpan.org>.
823
824If you've found this module useful or have feedback about your
825experience with it, consider sharing your opinion with other Perl users
826by posting your comment to CPAN's ratings system
827(C<http://cpanratings.perl.org/rate/?distribution=String-Escape>).
828
829For 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
831comp.lang.perl.misc newsgroup
832(C<http://groups.google.com/group/comp.lang.perl.misc/topics>).
833
- -
836=head1 AUTHOR
837
838Matthew Simon Cavalletto, C<< <simonm at cavalletto.org> >>
839
840Initial versions developed at Evolution Online Systems with Eleanor J. Evans and Jeremy G. Bishop.
841
842
843=head1 LICENSE
844
845Copyright 2010, 2002 Matthew Simon Cavalletto.
846
847Portions copyright 1996, 1997, 1998, 2001 Evolution Online Systems, Inc.
848
849You may use, modify, and distribute this software under the same terms as Perl.
850
851See http://dev.perl.org/licenses/ for more information.
852
853
854=cut
855
856########################################################################
857
858144µs1; # End of String::Escape
 
# spent 217µs within String::Escape::CORE:unpack which was called 512 times, avg 425ns/call: # 256 times (135µs+0s) by Devel::Backtrace::Point::BEGIN@6 at line 189, avg 526ns/call # 256 times (83µs+0s) by Devel::Backtrace::Point::BEGIN@6 at line 259, avg 323ns/call
sub String::Escape::CORE:unpack; # opcode