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_001'; # TRIAL
3              
4 14     14   51 $Parse::BBCode::Tag::VERSION = '0.15001';use strict;
  14         16  
  14         314  
5 14     14   42 use warnings;
  14         16  
  14         304  
6 14     14   55 use Carp qw(croak carp);
  14         16  
  14         700  
7              
8 14     14   48 use base 'Class::Accessor::Fast';
  14         13  
  14         6849  
9             __PACKAGE__->follow_best_practice;
10             __PACKAGE__->mk_accessors(qw/ 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 523     523 1 468 my ($self, $new) = @_;
15 523         713 my $content = $self->get_content;
16 523 100       1561 if (ref $new) {
17 155         144 push @$content, $new;
18 155         265 return;
19             }
20 368 100 100     822 if (@$content and not ref $content->[-1]) {
21 22         51 $content->[-1] .= $new;
22             }
23             else {
24 346         760 push @$content, $new;
25             }
26             }
27              
28             sub raw_text {
29 38     38 1 110 my ($self, %args) = @_;
30 38         64 %args = (
31             auto_close => 1,
32             %args,
33             );
34 38         34 my $auto_close = $args{auto_close};
35 38         59 my ($start, $end) = ($self->get_start, $self->get_end);
36 38 100 100     247 if (not $auto_close and $self->get_auto_closed) {
37 2         9 $end = '';
38             }
39 38         42 my $text = $start;
40 38         60 $text .= $self->raw_content(%args);
41 14     14   32231 no warnings;
  14         30  
  14         5162  
42 38         36 $text .= $end;
43 38         60 return $text;
44             }
45              
46             sub _init_info {
47 544     544   470 my ($self, $num, $level) = @_;
48 544   100     914 $level ||= 0;
49 544         721 my $name = $self->get_name;
50 544         1564 $num->{$name}++;
51 544         797 $self->set_num($num->{$name});
52 544         1784 $self->set_level($level);
53 544   50     1602 my $content = $self->get_content || [];
54 544         1608 for my $c (@$content) {
55 946 100       1516 next unless ref $c;
56 345         529 $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 45 my ($self, %args) = @_;
77 39         48 my $content = $self->get_content;
78 39         93 my $text = '';
79             #warn __PACKAGE__.':'.__LINE__.$".Data::Dumper->Dump([\$self], ['self']);
80 39         41 for my $c (@$content) {
81 60 100       75 if (ref $c eq ref $self) {
82 20         37 $text .= $c->raw_text(%args);
83             }
84             else {
85 40         53 $text .= $c;
86             }
87             }
88 39         55 return $text;
89             }
90              
91             sub _reduce {
92 31     31   34 my ($self) = @_;
93 31 100       48 if ($self->get_finished) {
94 7         27 return $self;
95             }
96 24         103 my @text = $self->get_start;
97 24         98 my $content = $self->get_content;
98 24         69 for my $c (@$content) {
99 28 100       46 if (ref $c eq ref $self) {
100 7         29 push @text, $c->_reduce;
101             }
102             else {
103 21         27 push @text, $c;
104             }
105             }
106 24 50       53 push @text, $self->get_end if defined $self->get_end;
107 24         130 return @text;
108             }
109              
110              
111             1;
112              
113             __END__