File Coverage

blib/lib/Parse/BBCode/Tag.pm
Criterion Covered Total %
statement 62 72 86.1
branch 15 22 68.1
condition 9 14 64.2
subroutine 10 11 90.9
pod 4 4 100.0
total 100 123 81.3


line stmt bran cond sub pod time code
1             package Parse::BBCode::Tag;
2             $Parse::BBCode::Tag::VERSION = '0.15';
3 14     14   78 use strict;
  14         27  
  14         462  
4 14     14   69 use warnings;
  14         27  
  14         548  
5 14     14   73 use Carp qw(croak carp);
  14         27  
  14         1235  
6              
7 14     14   77 use base 'Class::Accessor::Fast';
  14         34  
  14         16899  
8             __PACKAGE__->follow_best_practice;
9             __PACKAGE__->mk_accessors(qw/ name attr attr_raw content
10             finished start end close class single type in_url num level auto_closed /);
11              
12             sub add_content {
13 463     463 1 774 my ($self, $new) = @_;
14 463         1445 my $content = $self->get_content;
15 463 100       2287 if (ref $new) {
16 131         213 push @$content, $new;
17 131         387 return;
18             }
19 332 100 100     1073 if (@$content and not ref $content->[-1]) {
20 18         68 $content->[-1] .= $new;
21             }
22             else {
23 314         1052 push @$content, $new;
24             }
25             }
26              
27             sub raw_text {
28 38     38 1 183 my ($self, %args) = @_;
29 38         137 %args = (
30             auto_close => 1,
31             %args,
32             );
33 38         66 my $auto_close = $args{auto_close};
34 38         105 my ($start, $end) = ($self->get_start, $self->get_end);
35 38 100 100     336 if (not $auto_close and $self->get_auto_closed) {
36 2         14 $end = '';
37             }
38 38         68 my $text = $start;
39 38         105 $text .= $self->raw_content(%args);
40 14     14   59178 no warnings;
  14         42  
  14         8986  
41 38         63 $text .= $end;
42 38         133 return $text;
43             }
44              
45             sub _init_info {
46 507     507   748 my ($self, $num, $level) = @_;
47 507   100     1346 $level ||= 0;
48 507         1198 my $name = $self->get_name;
49 507         2683 $num->{$name}++;
50 507         1517 $self->set_num($num->{$name});
51 507         3093 $self->set_level($level);
52 507   50     2869 my $content = $self->get_content || [];
53 507         2665 for my $c (@$content) {
54 880 100       2693 next unless ref $c;
55 315         840 $c->_init_info($num, $level + 1);
56             }
57             }
58              
59             sub walk {
60 0     0 1 0 my ($self, $type, $sub) = @_;
61 0   0     0 $type ||= 'bfs';
62 0 0       0 unless ($type eq 'bfs') {
63 0         0 croak "walk(): $type '$type' not implemented";
64             }
65 0         0 my $result = $sub->($self);
66 0 0       0 return if $result;
67 0   0     0 my $content = $self->get_content || [];
68 0         0 for my $c (@$content) {
69 0 0       0 next unless ref $c;
70 0         0 $c->walk($type, $sub);
71             }
72             }
73              
74             sub raw_content {
75 39     39 1 173 my ($self, %args) = @_;
76 39         109 my $content = $self->get_content;
77 39         159 my $text = '';
78             #warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$self], ['self']);
79 39         68 for my $c (@$content) {
80 60 100       128 if (ref $c eq ref $self) {
81 20         59 $text .= $c->raw_text(%args);
82             }
83             else {
84 40         92 $text .= $c;
85             }
86             }
87 39         144 return $text;
88             }
89              
90             sub _reduce {
91 28     28   46 my ($self) = @_;
92 28 100       87 if ($self->get_finished) {
93 6         43 return $self;
94             }
95 22         190 my @text = $self->get_start;
96 22         151 my $content = $self->get_content;
97 22         108 for my $c (@$content) {
98 24 100       71 if (ref $c eq ref $self) {
99 6         49 push @text, $c->_reduce;
100             }
101             else {
102 18         56 push @text, $c;
103             }
104             }
105 22 50       81 push @text, $self->get_end if defined $self->get_end;
106 22         200 return @text;
107             }
108              
109              
110             1;
111              
112             __END__