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
|
|
216
|
use Exporter; |
|
26
|
|
|
|
|
56
|
|
|
26
|
|
|
|
|
1234
|
|
10
|
26
|
|
|
26
|
|
161
|
use strict; |
|
26
|
|
|
|
|
106
|
|
|
26
|
|
|
|
|
18519
|
|
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
|
348
|
|
|
348
|
1
|
610
|
my $s = shift; |
29
|
348
|
|
|
|
|
480
|
if (0) { |
30
|
|
|
|
|
|
|
##-- unsafe but elegant |
31
|
|
|
|
|
|
|
return eval '"'.quotemeta($s).'"'; |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
##-- safer but klutzy |
34
|
348
|
|
|
|
|
785
|
$s =~ s/\\([0-7]{1,3})/chr(oct($1))/eg; |
|
0
|
|
|
|
|
0
|
|
35
|
348
|
|
|
|
|
569
|
$s =~ s/\\x([0-9A-Fa-f]{1,2})/chr(hex($1))/eg; |
|
0
|
|
|
|
|
0
|
|
36
|
348
|
|
|
|
|
526
|
$s =~ s/\\u([0-9A-Fa-f]{1,4})/chr(hex($1))/eg; |
|
0
|
|
|
|
|
0
|
|
37
|
348
|
|
|
|
|
535
|
$s =~ s/\\a/\a/g; |
38
|
348
|
|
|
|
|
495
|
$s =~ s/\\b/\b/g; |
39
|
348
|
|
|
|
|
580
|
$s =~ s/\\t/\t/g; |
40
|
348
|
|
|
|
|
557
|
$s =~ s/\\n/\n/g; |
41
|
348
|
|
|
|
|
466
|
$s =~ s/\\r/\r/g; |
42
|
348
|
|
|
|
|
481
|
$s =~ s/\\f/\f/g; |
43
|
|
|
|
|
|
|
#$s =~ s/\\v/\v/g; |
44
|
348
|
|
|
|
|
576
|
$s =~ s/\\(.)/$1/g; |
45
|
348
|
|
|
|
|
843
|
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
|
|
|
|
556
|
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__ |