| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | ##-*- Mode: CPerl -*- | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | ## File: DDC::Utils.pm | 
| 4 |  |  |  |  |  |  | ## Author: Bryan Jurish | 
| 5 |  |  |  |  |  |  | ## Description: various utilities | 
| 6 |  |  |  |  |  |  | ##====================================================================== | 
| 7 |  |  |  |  |  |  |  | 
| 8 |  |  |  |  |  |  | package DDC::Utils; | 
| 9 | 26 |  |  | 26 |  | 186 | use Exporter; | 
|  | 26 |  |  |  |  | 49 |  | 
|  | 26 |  |  |  |  | 1111 |  | 
| 10 | 26 |  |  | 26 |  | 141 | use strict; | 
|  | 26 |  |  |  |  | 53 |  | 
|  | 26 |  |  |  |  | 18739 |  | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  | ##====================================================================== | 
| 13 |  |  |  |  |  |  | ## Globals etc. | 
| 14 |  |  |  |  |  |  | our @ISA = qw(Exporter); | 
| 15 |  |  |  |  |  |  | our @EXPORT = qw(); | 
| 16 |  |  |  |  |  |  | our %EXPORT_TAGS = | 
| 17 |  |  |  |  |  |  | ( | 
| 18 |  |  |  |  |  |  | 'escape' => [qw(unescape unescapeq escape escapeq)], | 
| 19 |  |  |  |  |  |  | ); | 
| 20 |  |  |  |  |  |  | $EXPORT_TAGS{all} = [map {@$_} values %EXPORT_TAGS]; | 
| 21 |  |  |  |  |  |  | our @EXPORT_OK = @{$EXPORT_TAGS{all}}; | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | ##====================================================================== | 
| 24 |  |  |  |  |  |  | ## escapes | 
| 25 |  |  |  |  |  |  |  | 
| 26 |  |  |  |  |  |  | ## $sym = unescape($escaped_symbol); | 
| 27 |  |  |  |  |  |  | sub unescape { | 
| 28 | 322 |  |  | 322 | 1 | 568 | my $s = shift; | 
| 29 | 322 |  |  |  |  | 460 | if (0) { | 
| 30 |  |  |  |  |  |  | ##-- unsafe but elegant | 
| 31 |  |  |  |  |  |  | return eval '"'.quotemeta($s).'"'; | 
| 32 |  |  |  |  |  |  | } | 
| 33 |  |  |  |  |  |  | ##-- safer but klutzy | 
| 34 | 322 |  |  |  |  | 728 | $s =~ s/\\([0-7]{1,3})/chr(oct($1))/eg; | 
|  | 0 |  |  |  |  | 0 |  | 
| 35 | 322 |  |  |  |  | 514 | $s =~ s/\\x([0-9A-Fa-f]{1,2})/chr(hex($1))/eg; | 
|  | 0 |  |  |  |  | 0 |  | 
| 36 | 322 |  |  |  |  | 464 | $s =~ s/\\u([0-9A-Fa-f]{1,4})/chr(hex($1))/eg; | 
|  | 0 |  |  |  |  | 0 |  | 
| 37 | 322 |  |  |  |  | 482 | $s =~ s/\\a/\a/g; | 
| 38 | 322 |  |  |  |  | 461 | $s =~ s/\\b/\b/g; | 
| 39 | 322 |  |  |  |  | 489 | $s =~ s/\\t/\t/g; | 
| 40 | 322 |  |  |  |  | 458 | $s =~ s/\\n/\n/g; | 
| 41 | 322 |  |  |  |  | 502 | $s =~ s/\\r/\r/g; | 
| 42 | 322 |  |  |  |  | 460 | $s =~ s/\\f/\f/g; | 
| 43 |  |  |  |  |  |  | #$s =~ s/\\v/\v/g; | 
| 44 | 322 |  |  |  |  | 543 | $s =~ s/\\(.)/$1/g; | 
| 45 | 322 |  |  |  |  | 771 | return $s; | 
| 46 |  |  |  |  |  |  | } | 
| 47 |  |  |  |  |  |  |  | 
| 48 |  |  |  |  |  |  | ## $sym = unescapeq($single_quoted_symbol); | 
| 49 |  |  |  |  |  |  | sub unescapeq { | 
| 50 | 0 |  |  | 0 | 1 | 0 | my $sym = shift; | 
| 51 | 0 |  |  |  |  | 0 | $sym =~ s/^\'//; | 
| 52 | 0 |  |  |  |  | 0 | $sym =~ s/\'\z//; | 
| 53 | 0 |  |  |  |  | 0 | return unescape($sym); | 
| 54 |  |  |  |  |  |  | } | 
| 55 |  |  |  |  |  |  |  | 
| 56 |  |  |  |  |  |  | ## $escaped_str = escape($str); | 
| 57 |  |  |  |  |  |  | sub escape { | 
| 58 | 0 |  |  | 0 | 1 | 0 | return quotemeta($_[0]); | 
| 59 |  |  |  |  |  |  | } | 
| 60 |  |  |  |  |  |  |  | 
| 61 |  |  |  |  |  |  | ## $sq_escaped_str = escapeq($str); | 
| 62 |  |  |  |  |  |  | sub escapeq { | 
| 63 | 52 |  |  | 52 | 1 | 95 | my $s = shift; | 
| 64 | 52 | 50 |  |  |  | 508 | return $s if ($s =~ /^[[:alpha:]\-][\w\-\~\$\@\/\?\+\.]*\z/); | 
| 65 | 0 |  |  |  |  |  | $s =~ s/\\/\\\\/g; | 
| 66 | 0 |  |  |  |  |  | $s =~ s/\'/\\\'/g; | 
| 67 | 0 |  |  |  |  |  | $s =~ s/\n/\\n/g; | 
| 68 | 0 |  |  |  |  |  | $s =~ s/\r/\\r/g; | 
| 69 | 0 |  |  |  |  |  | $s =~ s/\t/\\t/g; | 
| 70 | 0 |  |  |  |  |  | return "'$s'"; | 
| 71 |  |  |  |  |  |  | } | 
| 72 |  |  |  |  |  |  |  | 
| 73 |  |  |  |  |  |  | 1; ##-- be happy | 
| 74 |  |  |  |  |  |  |  | 
| 75 |  |  |  |  |  |  | __END__ |