File Coverage

blib/lib/DDC/Utils.pm
Criterion Covered Total %
statement 21 35 60.0
branch 1 2 50.0
condition n/a
subroutine 4 6 66.6
pod 4 4 100.0
total 30 47 63.8


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__