line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# $Id: TagSet.pm 284 2006-12-01 07:51:49Z chronos $ |
2
|
|
|
|
|
|
|
package BBCode::TagSet; |
3
|
6
|
|
|
6
|
|
33
|
use BBCode::Util qw(:tag); |
|
6
|
|
|
|
|
7
|
|
|
6
|
|
|
|
|
872
|
|
4
|
6
|
|
|
6
|
|
33
|
use Carp qw(croak); |
|
6
|
|
|
|
|
9
|
|
|
6
|
|
|
|
|
283
|
|
5
|
6
|
|
|
6
|
|
123
|
use strict; |
|
6
|
|
|
|
|
15
|
|
|
6
|
|
|
|
|
165
|
|
6
|
6
|
|
|
6
|
|
28
|
use warnings; |
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
4385
|
|
7
|
|
|
|
|
|
|
our $VERSION = '0.34'; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
sub new($@):method { |
10
|
315
|
|
|
315
|
0
|
666
|
my $class = shift; |
11
|
315
|
|
66
|
|
|
1231
|
$class = ref($class) || $class; |
12
|
315
|
|
|
|
|
747
|
my $this = bless {}, $class; |
13
|
315
|
100
|
|
|
|
884
|
$this->add(@_) if @_; |
14
|
315
|
|
|
|
|
997
|
return $this; |
15
|
|
|
|
|
|
|
} |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub keys($):method { |
18
|
174
|
|
|
174
|
0
|
208
|
return keys %{+shift}; |
|
174
|
|
|
|
|
993
|
|
19
|
|
|
|
|
|
|
} |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub clone($):method { |
22
|
12
|
|
|
12
|
0
|
23
|
my $this = shift; |
23
|
12
|
|
|
|
|
32
|
my $that = $this->new(); |
24
|
12
|
|
|
|
|
29
|
$that->add($this); |
25
|
12
|
|
|
|
|
38
|
return $that; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub _args { |
29
|
326
|
|
|
326
|
|
689
|
my($std,$not) = splice @_, 0, 2; |
30
|
326
|
|
|
|
|
879
|
while(@_) { |
31
|
439
|
|
|
|
|
561
|
my $arg = shift; |
32
|
|
|
|
|
|
|
|
33
|
439
|
100
|
|
|
|
934
|
if(ref $arg) { |
34
|
174
|
50
|
0
|
|
|
532
|
if(UNIVERSAL::isa($arg,'BBCode::TagSet')) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
35
|
174
|
|
|
|
|
448
|
foreach($arg->keys) { |
36
|
38
|
|
|
|
|
119
|
$std->(); |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
} elsif(UNIVERSAL::isa($arg,'BBCode::Tag')) { |
39
|
0
|
|
|
|
|
0
|
local $_ = $arg->Tag; |
40
|
0
|
|
|
|
|
0
|
$std->(); |
41
|
|
|
|
|
|
|
} elsif(ref $arg eq 'HASH') { |
42
|
0
|
|
|
|
|
0
|
unshift @_, keys %$arg; |
43
|
|
|
|
|
|
|
} elsif(ref $arg eq 'ARRAY') { |
44
|
0
|
|
|
|
|
0
|
unshift @_, @$arg; |
45
|
|
|
|
|
|
|
} elsif(ref $arg eq 'SCALAR' or ref $arg eq 'REF') { |
46
|
0
|
|
|
|
|
0
|
unshift @_, $$arg; |
47
|
|
|
|
|
|
|
} else { |
48
|
0
|
|
|
|
|
0
|
croak qq(Invalid reference); |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
} else { |
51
|
265
|
100
|
|
|
|
1356
|
if($arg =~ /^(!?)(:\w+)$/) { |
|
|
50
|
|
|
|
|
|
52
|
171
|
|
|
|
|
483
|
local $_ = uc($2); |
53
|
171
|
100
|
|
|
|
704
|
(($1 eq '') ? $std : $not)->(); |
54
|
|
|
|
|
|
|
} elsif($arg =~ /^(!?)(\w+)$/) { |
55
|
94
|
|
|
|
|
311
|
local $_ = tagCanonical($2); |
56
|
94
|
50
|
|
|
|
467
|
(($1 eq '') ? $std : $not)->(); |
57
|
|
|
|
|
|
|
} else { |
58
|
0
|
|
|
|
|
0
|
croak qq(Malformed tag [$arg]); |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
} |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub add($@):method { |
65
|
245
|
|
|
245
|
0
|
383
|
my $this = shift; |
66
|
|
|
|
|
|
|
_args( |
67
|
277
|
|
|
277
|
|
1383
|
sub { $this->{$_} = 1 }, |
68
|
13
|
|
|
13
|
|
61
|
sub { delete $this->{$_} }, |
69
|
245
|
|
|
|
|
1704
|
@_, |
70
|
|
|
|
|
|
|
); |
71
|
245
|
|
|
|
|
1213
|
return $this; |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
sub remove($@):method { |
75
|
81
|
|
|
81
|
0
|
138
|
my $this = shift; |
76
|
|
|
|
|
|
|
_args( |
77
|
13
|
|
|
13
|
|
74
|
sub { delete $this->{$_} }, |
78
|
0
|
|
|
0
|
|
0
|
sub { $this->{$_} = 1 }, |
79
|
81
|
|
|
|
|
580
|
@_, |
80
|
|
|
|
|
|
|
); |
81
|
81
|
|
|
|
|
427
|
return $this; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub contains($$):method { |
85
|
2919
|
|
|
2919
|
0
|
3978
|
my $this = shift; |
86
|
2919
|
|
|
|
|
8477
|
my $tag = tagCanonical(shift); |
87
|
2919
|
100
|
|
|
|
10235
|
return 1 if exists $this->{$tag}; |
88
|
2452
|
|
|
|
|
8764
|
return 0; |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
sub toString($):method { |
92
|
0
|
|
|
0
|
0
|
|
my $this = shift; |
93
|
0
|
|
|
|
|
|
return join(" ", sort keys %$this); |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
*as_string = *toString; |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
1; |