| Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/String/Escape.pm |
| Statements | Executed 84 statements in 4.31ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 1 | 1 | 1 | 739µs | 739µs | String::Escape::_define_backslash_escapes |
| 512 | 2 | 1 | 217µs | 217µs | String::Escape::CORE:unpack (opcode) |
| 1 | 1 | 1 | 30µs | 30µs | String::Escape::add |
| 1 | 1 | 1 | 23µs | 57µs | String::Escape::BEGIN@364 |
| 1 | 1 | 1 | 12µs | 14µs | String::Escape::BEGIN@9 |
| 1 | 1 | 1 | 10µs | 23µs | String::Escape::BEGIN@55 |
| 1 | 1 | 1 | 8µs | 30µs | String::Escape::BEGIN@13 |
| 1 | 1 | 1 | 8µs | 23µs | String::Escape::BEGIN@516 |
| 1 | 1 | 1 | 7µs | 36µs | String::Escape::BEGIN@11 |
| 1 | 1 | 1 | 7µs | 14µs | String::Escape::BEGIN@10 |
| 1 | 1 | 1 | 7µs | 33µs | String::Escape::BEGIN@182 |
| 1 | 1 | 1 | 6µs | 35µs | String::Escape::BEGIN@57 |
| 1 | 1 | 1 | 6µs | 32µs | String::Escape::BEGIN@255 |
| 0 | 0 | 0 | 0s | 0s | String::Escape::__ANON__[:584] |
| 0 | 0 | 0 | 0s | 0s | String::Escape::__ANON__[:586] |
| 0 | 0 | 0 | 0s | 0s | String::Escape::__ANON__[:587] |
| 0 | 0 | 0 | 0s | 0s | String::Escape::__ANON__[:588] |
| 0 | 0 | 0 | 0s | 0s | String::Escape::__ANON__[:606] |
| 0 | 0 | 0 | 0s | 0s | String::Escape::_expand_escape_spec |
| 0 | 0 | 0 | 0s | 0s | String::Escape::_unsupported_escape_spec |
| 0 | 0 | 0 | 0s | 0s | String::Escape::backslash |
| 0 | 0 | 0 | 0s | 0s | String::Escape::elide |
| 0 | 0 | 0 | 0s | 0s | String::Escape::escape |
| 0 | 0 | 0 | 0s | 0s | String::Escape::hash2list |
| 0 | 0 | 0 | 0s | 0s | String::Escape::hash2string |
| 0 | 0 | 0 | 0s | 0s | String::Escape::list2hash |
| 0 | 0 | 0 | 0s | 0s | String::Escape::list2string |
| 0 | 0 | 0 | 0s | 0s | String::Escape::names |
| 0 | 0 | 0 | 0s | 0s | String::Escape::printable |
| 0 | 0 | 0 | 0s | 0s | String::Escape::qprintable |
| 0 | 0 | 0 | 0s | 0s | String::Escape::qqbackslash |
| 0 | 0 | 0 | 0s | 0s | String::Escape::quote |
| 0 | 0 | 0 | 0s | 0s | String::Escape::quote_non_words |
| 0 | 0 | 0 | 0s | 0s | String::Escape::singlequote |
| 0 | 0 | 0 | 0s | 0s | String::Escape::string2hash |
| 0 | 0 | 0 | 0s | 0s | String::Escape::string2list |
| 0 | 0 | 0 | 0s | 0s | String::Escape::unbackslash |
| 0 | 0 | 0 | 0s | 0s | String::Escape::unprintable |
| 0 | 0 | 0 | 0s | 0s | String::Escape::unqprintable |
| 0 | 0 | 0 | 0s | 0s | String::Escape::unqqbackslash |
| 0 | 0 | 0 | 0s | 0s | String::Escape::unquote |
| 0 | 0 | 0 | 0s | 0s | String::Escape::unquotemeta |
| 0 | 0 | 0 | 0s | 0s | String::Escape::unsinglequote |
| Line | State ments |
Time on line |
Calls | Time in subs |
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 | 3 | 17µs | 2 | 16µ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 # spent 14µs making 1 call to String::Escape::BEGIN@9
# spent 2µs making 1 call to strict::import |
| 10 | 3 | 20µs | 2 | 22µ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 # spent 14µs making 1 call to String::Escape::BEGIN@10
# spent 7µs making 1 call to warnings::import |
| 11 | 3 | 21µs | 2 | 64µ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 # spent 36µs making 1 call to String::Escape::BEGIN@11
# spent 28µs making 1 call to Exporter::import |
| 12 | |||||
| 13 | 3 | 43µs | 2 | 52µ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 # spent 30µs making 1 call to String::Escape::BEGIN@13
# spent 22µs making 1 call to vars::import |
| 14 | 1 | 600ns | $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 | 3 | 21µs | 2 | 36µ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 # spent 23µs making 1 call to String::Escape::BEGIN@55
# spent 13µs making 1 call to Exporter::import |
| 56 | |||||
| 57 | 3 | 218µs | 2 | 64µ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 # spent 35µs making 1 call to String::Escape::BEGIN@57
# spent 29µs making 1 call to vars::import |
| 58 | |||||
| 59 | 1 | 10µs | push @ISA, qw( Exporter ); | ||
| 60 | 1 | 6µs | 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 | '"' . $_[0] . '"' | ||||
| 107 | } | ||||
| 108 | |||||
| 109 | # $remove_surrounding_quotes = quote( $string_value ); | ||||
| 110 | sub unquote ($) { | ||||
| 111 | ( $_[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 | ( ! length $_[0] or $_[0] =~ /[^\w\_\-\/\.\:\#]/ ) ? '"'.$_[0].'"' : $_[0] | ||||
| 117 | } | ||||
| 118 | |||||
| 119 | # $with_surrounding_quotes = singlequote( $string_value ); | ||||
| 120 | sub singlequote ($) { | ||||
| 121 | '\'' . $_[0] . '\'' | ||||
| 122 | } | ||||
| 123 | |||||
| 124 | # $remove_surrounding_quotes = singlequote( $string_value ); | ||||
| 125 | sub unsinglequote ($) { | ||||
| 126 | ( $_[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 | 3 | 322µs | 2 | 59µ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 # 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) ), | ||||
| 189 | 1 | 829µs | 257 | 874µ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 | ||||
| 193 | 2 | 734µs | %Interpolated = @_; | ||
| 194 | %Backslashed = reverse @_; | ||||
| 195 | } | ||||
| 196 | |||||
| 197 | # $special_characters_escaped = backslash( $source_string ); | ||||
| 198 | sub 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 ); | ||||
| 206 | sub 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 ); | ||||
| 213 | sub qqbackslash ($) { quote backslash $_[0] } | ||||
| 214 | |||||
| 215 | # $original_string = unqqbackslash( quoted_and_escaped ); | ||||
| 216 | 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 | 3 | 296µs | 2 | 57µ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 # 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', ), | ||||
| 259 | 1 | 573µs | 256 | 83µs | ( map { $_ => $_ } ( '"' ) ) # spent 83µs making 256 calls to String::Escape::CORE:unpack, avg 323ns/call |
| 260 | ); | ||||
| 261 | 1 | 140µs | %Unprintable = ( reverse %Printable ); | ||
| 262 | |||||
| 263 | # $special_characters_escaped = printable( $source_string ); | ||||
| 264 | sub 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 ); | ||||
| 271 | sub 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 ); | ||||
| 278 | sub qprintable ($) { quote_non_words printable $_[0] } | ||||
| 279 | |||||
| 280 | # $original_string = unqprintable( quoted_and_escaped ); | ||||
| 281 | 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 | local $_ = ( defined $_[0] ? $_[0] : '' ); | ||||
| 302 | s/ (\A|\G|[^\\]) [\\] (.) / $1 . $2 /gsex; | ||||
| 303 | 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 | 3 | 178µs | 2 | 91µ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 # spent 57µs making 1 call to String::Escape::BEGIN@364
# spent 34µs making 1 call to vars::import |
| 365 | 1 | 700ns | $Elipses = '...'; | ||
| 366 | 1 | 500ns | $DefaultLength = 60; | ||
| 367 | 1 | 500ns | $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 | 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 | |||||
| 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 | 3 | 786µs | 2 | 39µ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 # 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 | ||||
| 520 | 41 | 32µs | while ( @_ ) { | ||
| 521 | my ( $name, $func ) = ( shift, shift ); | ||||
| 522 | $Escapes{ $name } = $func | ||||
| 523 | } | ||||
| 524 | } | ||||
| 525 | |||||
| 526 | # @defined_names = String::Escape::names(); | ||||
| 527 | sub names { | ||||
| 528 | keys(%Escapes) | ||||
| 529 | } | ||||
| 530 | |||||
| 531 | # $escaped = escape($escape_spec, $value); | ||||
| 532 | # @escaped = escape($escape_spec, @values); | ||||
| 533 | sub 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); | ||||
| 554 | sub _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); | ||||
| 573 | sub _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 | |||||
| 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 | 1 | 19µs | 1 | 30µ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 | |||||
| 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 | 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 ); | ||||
| 716 | sub list2string { | ||||
| 717 | join ( ' ', map qprintable($_), @_ ); | ||||
| 718 | } | ||||
| 719 | |||||
| 720 | # %hash = list2hash( @words ); | ||||
| 721 | sub 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 ); | ||||
| 731 | sub 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 ); | ||||
| 741 | sub string2hash { | ||||
| 742 | return list2hash( string2list( shift ) ); | ||||
| 743 | } | ||||
| 744 | |||||
| 745 | # $string = hash2string( %hash ); | ||||
| 746 | sub hash2string { | ||||
| 747 | 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 | |||||
| - - | |||||
| 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 | 44µs | 1; # End of String::Escape | ||
sub String::Escape::CORE:unpack; # opcode |