File Coverage

blib/lib/Text/GooglewikiFormat/Blocks.pm
Criterion Covered Total %
statement 69 73 94.5
branch 16 24 66.6
condition 9 9 100.0
subroutine 22 22 100.0
pod n/a
total 116 128 90.6


line stmt bran cond sub pod time code
1             package Text::GooglewikiFormat::Blocks;
2            
3 4     4   26 use warnings;
  4         9  
  4         160  
4 4     4   26 use strict;
  4         9  
  4         193  
5            
6             sub import {
7 4     4   10 my $caller = caller();
8 4     4   20 no strict 'refs';
  4         10  
  4         677  
9 4         127 *{ $caller . '::new_block' } = sub
10             {
11 68     68   108 my $type = shift;
12 68         125 my $class = "Text::GooglewikiFormat::Block::$type";
13 68         120 my $ctor;
14            
15 68 100       541 unless ($ctor = $class->can( 'new' ))
16             {
17 15         23 @{ $class . '::ISA' } = ( 'Text::GooglewikiFormat::Block' );
  15         352  
18 15         225 $ctor = $class->can( 'new' );
19             }
20            
21 68         217 return $class->new( type => $type, @_ );
22 4         23 };
23             }
24            
25             package Text::GooglewikiFormat::Block;
26            
27 4     4   38 use Scalar::Util qw( blessed reftype );
  4         9  
  4         2363  
28            
29             sub new
30             {
31 68     68   315 my ($class, %args) = @_;
32            
33 68   100     372 $args{text} = $class->arg_to_ref( delete $args{text} || '' );
34 68   100     313 $args{args} = [ $class->arg_to_ref( delete $args{args} || [] ) ];
35            
36 68         440 bless \%args, $class;
37             }
38            
39             sub arg_to_ref
40             {
41 136     136   217 my ($class, $value) = @_;
42 136 100 100     802 return $value if ( reftype( $value ) || '' ) eq 'ARRAY';
43 68         247 return [ $value ];
44             }
45            
46             sub shift_args
47             {
48 26     26   35 my $self = shift;
49 26         27 my $args = shift @{ $self->{args} };
  26         92  
50 26 50       133 return wantarray ? @$args : $args;
51             }
52            
53             sub all_args
54             {
55 28     28   47 my $args = $_[0]{args};
56 28 50       117 return wantarray ? @$args : $args;
57             }
58            
59             sub text
60             {
61 55     55   104 my $text = $_[0]{text};
62 55 50       202 return wantarray ? @$text : $text;
63             }
64            
65             sub add_text
66             {
67 28     28   38 my $self = shift;
68 28         34 push @{ $self->{text} }, @_;
  28         72  
69             }
70            
71             sub formatted_text
72             {
73 27     27   41 my $self = shift;
74 54 50       258 return map
75             {
76 27         85 blessed( $_ ) ? $_ : $self->formatter( $_ )
77             } $self->text();
78             }
79            
80             sub formatter
81             {
82 47     47   76 my ($self, $line) = @_;
83 47         145 Text::GooglewikiFormat::format_line( $line, $self->tags(), $self->opts() );
84             }
85            
86             sub add_args
87             {
88 28     28   37 my $self = shift;
89 28         25 push @{ $self->{args} }, @_;
  28         66  
90             }
91            
92             {
93 4     4   27 no strict 'refs';
  4         8  
  4         1374  
94             for my $attribute (qw( level opts tags type ))
95             {
96 439     439   1757 *{ $attribute } = sub { $_[0]{$attribute} };
97             }
98             }
99            
100             sub merge
101             {
102 78     78   148 my ($self, $next_block) = @_;
103            
104 78 100       164 return $next_block unless $self->type() eq $next_block->type();
105 30 100       99 return $next_block unless $self->level() == $next_block->level();
106            
107 28         89 $self->add_text( $next_block->text() );
108 28         87 $self->add_args( $next_block->all_args() );
109 28         88 return;
110             }
111            
112             sub nests
113             {
114 32     32   39 my $self = shift;
115 32         94 return exists $self->{tags}{nests}{ $self->type() };
116             }
117            
118             sub nest
119             {
120 25     25   37 my ($self, $next_block) = @_;
121            
122 25 50       50 return unless $next_block = $self->merge( $next_block );
123 25 100 100     92 return $next_block unless $self->nests() and $next_block->nests();
124 2 50       16 return $next_block unless $self->level() < $next_block->level();
125            
126             # if there's a nested block at the end, maybe it can nest too
127 0         0 my $last_item = ( $self->text() )[-1];
128 0 0       0 return $last_item->nest( $next_block ) if blessed( $last_item );
129            
130 0         0 $self->add_text( $next_block );
131 0         0 return;
132             }
133            
134             package Text::GooglewikiFormat::Block::code;
135            
136 4     4   28 use base 'Text::GooglewikiFormat::Block';
  4         6  
  4         2775  
137            
138 7     7   24 sub formatter { $_[1] }
139            
140             package Text::GooglewikiFormat::Blocks;
141            
142             1;
143             __END__