File Coverage

blib/lib/BBCode/TagSet.pm
Criterion Covered Total %
statement 48 58 82.7
branch 13 24 54.1
condition 2 6 33.3
subroutine 14 16 87.5
pod 0 7 0.0
total 77 111 69.3


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;