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