| 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; |