File Coverage

lib/MetaPOD/Assembler.pm
Criterion Covered Total %
statement 43 53 81.1
branch 2 4 50.0
condition n/a
subroutine 13 16 81.2
pod 5 5 100.0
total 63 78 80.7


line stmt bran cond sub pod time code
1 2     2   66978 use 5.008; # utf8
  2         7  
  2         93  
2 2     2   172 use strict;
  2         101  
  2         81  
3 2     2   22 use warnings;
  2         5  
  2         68  
4 2     2   4608 use utf8;
  2         24  
  2         11  
5              
6             package MetaPOD::Assembler;
7             $MetaPOD::Assembler::VERSION = '0.3.6';
8             # ABSTRACT: Glue layer that dispatches segments to a constructed Result
9              
10             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
11              
12              
13              
14              
15              
16              
17              
18              
19              
20              
21              
22              
23              
24              
25              
26              
27              
28              
29              
30              
31              
32              
33              
34              
35              
36              
37              
38              
39              
40              
41              
42              
43              
44 2     2   5618 use Moo qw( has );
  2         40362  
  2         15  
45 2     2   4445 use Carp qw( croak );
  2         5  
  2         131  
46 2     2   11 use Module::Runtime qw( use_module );
  2         4  
  2         14  
47              
48              
49              
50              
51              
52             has 'result' => (
53             is => ro =>,
54             required => 0,
55             lazy => 1,
56             builder => sub {
57 2     2   4129 require MetaPOD::Result;
58 2         34 return MetaPOD::Result->new();
59             },
60             clearer => 'clear_result',
61             );
62              
63              
64              
65              
66              
67             has extractor => (
68             is => ro =>,
69             required => 1,
70             lazy => 1,
71             builder => sub {
72 2     2   2511 my $self = shift;
73 2         718 require MetaPOD::Extractor;
74             return MetaPOD::Extractor->new(
75             end_segment_callback => sub {
76 1     1   3 my $segment = shift;
77 1         5 $self->handle_segment($segment);
78             },
79 2         48 );
80             },
81             );
82              
83              
84              
85              
86              
87             has format_map => (
88             is => ro =>,
89             required => 1,
90             lazy => 1,
91             builder => sub {
92 0     0   0 return { 'JSON' => 'MetaPOD::Format::JSON', };
93             },
94             );
95              
96              
97              
98              
99              
100              
101              
102             sub assemble_handle {
103 0     0 1 0 my ( $self, $handle ) = @_;
104 0         0 $self->clear_result;
105 0         0 $self->extractor->read_handle($handle);
106 0         0 return $self->result;
107             }
108              
109              
110              
111              
112              
113              
114              
115             sub assemble_file {
116 1     1 1 1508 my ( $self, $file ) = @_;
117 1         6 $self->clear_result;
118 1         669 $self->extractor->read_file($file);
119 1         554 return $self->result;
120             }
121              
122              
123              
124              
125              
126              
127              
128             sub assemble_string {
129 0     0 1 0 my ( $self, $string ) = @_;
130 0         0 $self->clear_result;
131 0         0 $self->extractor->read_string($string);
132 0         0 return $self->result;
133             }
134              
135              
136              
137              
138              
139              
140              
141             sub get_class_for_format {
142 1     1 1 4 my ( $self, $format ) = @_;
143 1 50       5 if ( not exists $self->format_map->{$format} ) {
144 0         0 croak "format $format unsupported";
145             }
146 1         467 return $self->format_map->{$format};
147             }
148              
149              
150              
151              
152              
153              
154              
155              
156              
157              
158              
159              
160              
161              
162             sub handle_segment {
163 1     1 1 2 my ( $self, $segment ) = @_;
164 1         3 my $format = $segment->{format};
165 1         3 my $version = $segment->{version};
166              
167 1         6 my $class = $self->get_class_for_format($format);
168 1         59 use_module($class);
169              
170 1 50       49 return unless $class->supports_version($version);
171              
172 1         29 $class->add_segment( $segment, $self->result );
173              
174 1         35 return $self;
175             }
176              
177             1;
178              
179             __END__