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_002'; # TRIAL
3              
4 14     14   101 $Parse::BBCode::Tag::VERSION = '0.15002';use strict;
  14         32  
  14         369  
5 14     14   74 use warnings;
  14         29  
  14         442  
6 14     14   103 use Carp qw(croak carp);
  14         30  
  14         886  
7              
8 14     14   107 use base 'Class::Accessor::Fast';
  14         35  
  14         6760  
9             __PACKAGE__->follow_best_practice;
10             __PACKAGE__->mk_accessors(qw/ id name attr attr_raw content
11             finished start end close class single type in_url num level auto_closed /);
12              
13             sub add_content {
14 524     524 1 1140 my ($self, $new) = @_;
15 524         1235 my $content = $self->get_content;
16 524 100       2488 if (ref $new) {
17 155         311 push @$content, $new;
18 155         380 return;
19             }
20 369 100 100     1307 if (@$content and not ref $content->[-1]) {
21 22         88 $content->[-1] .= $new;
22             }
23             else {
24 347         1077 push @$content, $new;
25             }
26             }
27              
28             sub raw_text {
29 38     38 1 220 my ($self, %args) = @_;
30 38         123 %args = (
31             auto_close => 1,
32             %args,
33             );
34 38         81 my $auto_close = $args{auto_close};
35 38         110 my ($start, $end) = ($self->get_start, $self->get_end);
36 38 100 100     391 if (not $auto_close and $self->get_auto_closed) {
37 2         11 $end = '';
38             }
39 38         108 my $text = $start;
40 38         123 $text .= $self->raw_content(%args);
41 14     14   40268 no warnings;
  14         46  
  14         6606  
42 38         86 $text .= $end;
43 38         137 return $text;
44             }
45              
46             sub _init_info {
47 546     546   1068 my ($self, $num, $level) = @_;
48 546   100     1690 $level ||= 0;
49 546         1254 my $name = $self->get_name;
50 546         2617 $num->{$name}++;
51 546         1584 $self->set_num($num->{$name});
52 546         3789 $self->set_level($level);
53 546   50     3634 my $content = $self->get_content || [];
54 546         2687 for my $c (@$content) {
55 949 100       2577 next unless ref $c;
56 346         880 $c->_init_info($num, $level + 1);
57             }
58             }
59              
60             sub walk {
61 0     0 1 0 my ($self, $type, $sub) = @_;
62 0   0     0 $type ||= 'bfs';
63 0 0       0 unless ($type eq 'bfs') {
64 0         0 croak "walk(): $type '$type' not implemented";
65             }
66 0         0 my $result = $sub->($self);
67 0 0       0 return if $result;
68 0   0     0 my $content = $self->get_content || [];
69 0         0 for my $c (@$content) {
70 0 0       0 next unless ref $c;
71 0         0 $c->walk($type, $sub);
72             }
73             }
74              
75             sub raw_content {
76 39     39 1 129 my ($self, %args) = @_;
77 39         107 my $content = $self->get_content;
78 39         184 my $text = '';
79             #warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$self], ['self']);
80 39         89 for my $c (@$content) {
81 60 100       165 if (ref $c eq ref $self) {
82 20         72 $text .= $c->raw_text(%args);
83             }
84             else {
85 40         99 $text .= $c;
86             }
87             }
88 39         114 return $text;
89             }
90              
91             sub _reduce {
92 31     31   74 my ($self) = @_;
93 31 100       150 if ($self->get_finished) {
94 7         39 return $self;
95             }
96 24         163 my @text = $self->get_start;
97 24         150 my $content = $self->get_content;
98 24         129 for my $c (@$content) {
99 28 100       82 if (ref $c eq ref $self) {
100 7         45 push @text, $c->_reduce;
101             }
102             else {
103 21         59 push @text, $c;
104             }
105             }
106 24 50       76 push @text, $self->get_end if defined $self->get_end;
107 24         207 return @text;
108             }
109              
110              
111             1;
112              
113             __END__