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   62 use strict;
  9         24  
  9         259  
4 9     9   44 use warnings;
  9         16  
  9         250  
5              
6 9     9   42 use base qw( Class::Accessor::Fast Class::Data::Inheritable );
  9         14  
  9         592  
7 9     9   11875 use UNIVERSAL::require;
  9         10164  
  9         84  
8 9     9   4214 use Text::Trac::InlineNode;
  9         27  
  9         75  
9              
10             our $VERSION = '0.22';
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 10498 my ( $class, $params ) = @_;
26 1607         5115 my $self = { %$params, };
27 1607         3258 bless $self, $class;
28 1607         5508 $self->init;
29 1607         32001 $self->inline_parser( Text::Trac::InlineNode->new( $self->context ) );
30 1607         14911 return $self;
31             }
32              
33             sub init {
34 447     447 0 685 my $self = shift;
35 447         691 return $self;
36             }
37              
38             sub parse {
39 120     120 0 245 my $self = shift;
40 120         2154 my $c = $self->context;
41              
42 120         727 $self->block_parsers( $self->_get_parsers('block') );
43              
44             #$self->inline_parsers( $self->_get_parsers('inline') );
45              
46 120         7884 while ( defined( my $l = $c->shiftline ) ) {
47 205 100       693 next if $l =~ /^$/;
48 198         321 for my $parser ( @{ $self->_get_matched_parsers( 'block', $l ) } ) {
  198         490  
49 201         734 $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 924 my ( $self, $l ) = @_;
61 210         3794 return $self->inline_parser->parse($l);
62             }
63              
64             sub _get_parsers {
65 220     220   535 my ( $self, $type ) = @_;
66              
67 220         434 $type .= '_nodes';
68 220         346 my @parsers;
69 220         321 for ( @{ $self->$type } ) {
  220         755  
70 1280         4781 my $class = 'Text::Trac::' . $self->_camelize($_);
71 1280         5660 $class->require;
72 1280         58370 push @parsers, $class->new( { context => $self->context } );
73             }
74 220         1188 return \@parsers;
75             }
76              
77             sub _get_matched_parsers {
78 314     314   789 my ( $self, $type, $l ) = @_;
79 314         6035 my $c = $self->context;
80 314         1724 $type .= '_parsers';
81              
82 314         473 my @matched_parsers;
83              
84 314         474 for my $parser ( @{ $self->$type } ) {
  314         1051  
85             next
86 2070 100 66     5809 if ( grep { ref($parser) eq 'Text::Trac::' . $self->_camelize($_) } @{ $c->in_block_of }
  314         1590  
  2070         33856  
87             and $type =~ /^block/ );
88 2055 100       40121 my $pattern = $parser->pattern or next;
89              
90 1849 100       12973 if ( $l =~ /$pattern/ ) {
91 110         281 push @matched_parsers, $parser;
92             }
93             }
94              
95 314 100 66     4998 push @matched_parsers, Text::Trac::P->new( { context => $self->context } )
96             if ( !@matched_parsers and $type =~ /^block/ );
97 314         1177 return \@matched_parsers;
98             }
99              
100             sub _camelize {
101 1594     1594   3295 my ( $self, $word ) = @_;
102              
103 1594         2285 my $camelized_word;
104 1594         4252 for ( split '_', $word ) {
105 1594         2632 chomp($_);
106 1594         3762 $camelized_word .= ucfirst($_);
107             }
108              
109 1594         4466 return $camelized_word;
110             }
111              
112             1;