File Coverage

blib/lib/Text/Trac/BlockNode.pm
Criterion Covered Total %
statement 64 64 100.0
branch 10 10 100.0
condition 4 6 66.6
subroutine 13 13 100.0
pod 1 5 20.0
total 92 98 93.8


line stmt bran cond sub pod time code
1             package Text::Trac::BlockNode;
2              
3 9     9   79 use strict;
  9         26  
  9         270  
4 9     9   44 use warnings;
  9         16  
  9         253  
5              
6 9     9   49 use base qw( Class::Accessor::Fast Class::Data::Inheritable );
  9         20  
  9         525  
7 9     9   12098 use UNIVERSAL::require;
  9         10331  
  9         85  
8 9     9   4242 use Text::Trac::InlineNode;
  9         27  
  9         78  
9              
10             our $VERSION = '0.23';
11              
12             __PACKAGE__->mk_classdata( block_nodes => [qw( heading hr p ul ol blockquote pre table dl )] );
13              
14             #__PACKAGE__->mk_classdata(
15             # inline_nodes => [ qw( bold_italic bold italic underline monospace strike sup sub br
16             # auto_link_http macro trac_links ) ]
17             #);
18             __PACKAGE__->mk_classdata( block_parsers => [] );
19              
20             __PACKAGE__->mk_classdata( inline_parsers => [] );
21              
22             __PACKAGE__->mk_accessors(qw( context pattern inline_parser ));
23              
24             sub new {
25 1607     1607 1 10741 my ( $class, $params ) = @_;
26 1607         5144 my $self = { %$params, };
27 1607         3392 bless $self, $class;
28 1607         5546 $self->init;
29 1607         31942 $self->inline_parser( Text::Trac::InlineNode->new( $self->context ) );
30 1607         14737 return $self;
31             }
32              
33             sub init {
34 447     447 0 699 my $self = shift;
35 447         697 return $self;
36             }
37              
38             sub parse {
39 120     120 0 252 my $self = shift;
40 120         2239 my $c = $self->context;
41              
42 120         751 $self->block_parsers( $self->_get_parsers('block') );
43              
44             #$self->inline_parsers( $self->_get_parsers('inline') );
45              
46 120         7235 while ( defined( my $l = $c->shiftline ) ) {
47 205 100       746 next if $l =~ /^$/;
48 198         351 for my $parser ( @{ $self->_get_matched_parsers( 'block', $l ) } ) {
  198         484  
49 201         694 $parser->parse($l);
50             }
51             }
52             }
53              
54             sub escape {
55 4     4 0 11 my ( $self, $l ) = @_;
56 4         74 return $self->inline_parser->escape($l);
57             }
58              
59             sub replace {
60 210     210 0 593 my ( $self, $l ) = @_;
61 210         3775 return $self->inline_parser->parse($l);
62             }
63              
64             sub _get_parsers {
65 220     220   526 my ( $self, $type ) = @_;
66              
67 220         443 $type .= '_nodes';
68 220         337 my @parsers;
69 220         339 for ( @{ $self->$type } ) {
  220         808  
70 1280         4894 my $class = 'Text::Trac::' . $self->_camelize($_);
71 1280         5714 $class->require;
72 1280         58991 push @parsers, $class->new( { context => $self->context } );
73             }
74 220         1210 return \@parsers;
75             }
76              
77             sub _get_matched_parsers {
78 314     314   790 my ( $self, $type, $l ) = @_;
79 314         5998 my $c = $self->context;
80 314         1822 $type .= '_parsers';
81              
82 314         495 my @matched_parsers;
83              
84 314         470 for my $parser ( @{ $self->$type } ) {
  314         1080  
85             next
86 2070 100 66     5857 if ( grep { ref($parser) eq 'Text::Trac::' . $self->_camelize($_) } @{ $c->in_block_of }
  314         1634  
  2070         33815  
87             and $type =~ /^block/ );
88 2055 100       40214 my $pattern = $parser->pattern or next;
89              
90 1849 100       12919 if ( $l =~ /$pattern/ ) {
91 110         285 push @matched_parsers, $parser;
92             }
93             }
94              
95 314 100 66     4982 push @matched_parsers, Text::Trac::P->new( { context => $self->context } )
96             if ( !@matched_parsers and $type =~ /^block/ );
97 314         1245 return \@matched_parsers;
98             }
99              
100             sub _camelize {
101 1594     1594   3193 my ( $self, $word ) = @_;
102              
103 1594         2194 my $camelized_word;
104 1594         4158 for ( split '_', $word ) {
105 1594         2693 chomp($_);
106 1594         3889 $camelized_word .= ucfirst($_);
107             }
108              
109 1594         4588 return $camelized_word;
110             }
111              
112             1;