File Coverage

blib/lib/Markdent/Parser.pm
Criterion Covered Total %
statement 111 111 100.0
branch 19 22 86.3
condition 4 6 66.6
subroutine 23 23 100.0
pod 1 2 50.0
total 158 164 96.3


line stmt bran cond sub pod time code
1             package Markdent::Parser;
2              
3 35     35   18739 use strict;
  35         80  
  35         1233  
4 35     35   188 use warnings;
  35         71  
  35         1359  
5 35     35   263 use namespace::autoclean 0.09;
  35         1085  
  35         315  
6              
7             our $VERSION = '0.39';
8              
9 35     35   20012 use Markdent::Parser::BlockParser;
  35         143  
  35         1553  
10 35     35   20525 use Markdent::Parser::SpanParser;
  35         166  
  35         1694  
11 35     35   320 use Markdent::Types;
  35         80  
  35         319  
12 35     35   846309 use Module::Runtime qw( require_module );
  35         110  
  35         389  
13 35     35   2090 use Moose::Meta::Class;
  35         106  
  35         1671  
14 35     35   613 use Params::ValidationCompiler 0.14 qw( validation_for );
  35         1250  
  35         2654  
15 35     35   272 use Specio::Declare;
  35         74  
  35         418  
16 35     35   7241 use Try::Tiny;
  35         319  
  35         2305  
17              
18 35     35   263 use Moose 0.92;
  35         579  
  35         327  
19 35     35   244094 use MooseX::SemiAffordanceAccessor 0.05;
  35         848  
  35         276  
20 35     35   141812 use MooseX::StrictConstructor 0.08;
  35         791  
  35         280  
21              
22             with 'Markdent::Role::AnyParser';
23              
24             has _block_parser_class => (
25             is => 'rw',
26             isa => t('BlockParserClass'),
27             init_arg => 'block_parser_class',
28             default => 'Markdent::Parser::BlockParser',
29             );
30              
31             has _block_parser => (
32             is => 'rw',
33             does => object_does_type('Markdent::Role::BlockParser'),
34             lazy => 1,
35             init_arg => undef,
36             builder => '_build_block_parser',
37             );
38              
39             has _block_parser_args => (
40             is => 'rw',
41             isa => t('HashRef'),
42             init_arg => undef,
43             );
44              
45             has _span_parser_class => (
46             is => 'rw',
47             isa => t('SpanParserClass'),
48             init_arg => 'span_parser_class',
49             default => 'Markdent::Parser::SpanParser',
50             );
51              
52             has _span_parser => (
53             is => 'ro',
54             does => object_does_type('Markdent::Role::SpanParser'),
55             lazy => 1,
56             init_arg => undef,
57             builder => '_build_span_parser',
58             );
59              
60             has _span_parser_args => (
61             is => 'rw',
62             isa => t('HashRef'),
63             init_arg => undef,
64             );
65              
66             override BUILDARGS => sub {
67             my $class = shift;
68              
69             my $args = super();
70              
71             if ( exists $args->{dialect} ) {
72              
73             # XXX - deprecation warning
74             $args->{dialects} = [ delete $args->{dialect} ];
75             }
76             elsif ( exists $args->{dialects} ) {
77             $args->{dialects} = [ $args->{dialects} ]
78             unless ref $args->{dialects};
79             }
80              
81             return $args;
82             };
83              
84             sub BUILD {
85 184     184 0 412 my $self = shift;
86 184         349 my $args = shift;
87              
88 184         784 $self->_set_classes_for_dialects($args);
89              
90 184         395 my %sp_args;
91 184         4881 for my $key (
92 1656         2664 grep {defined}
93 1656         17810 map { $_->init_arg }
94             $self->_span_parser_class->meta->get_all_attributes
95             ) {
96              
97             $sp_args{$key} = $args->{$key}
98 552 100       1551 if exists $args->{$key};
99             }
100              
101 184         5526 $sp_args{handler} = $self->handler;
102              
103 184         5725 $self->_set_span_parser_args( \%sp_args );
104              
105 184         331 my %bp_args;
106 184         4687 for my $key (
107 1130         1931 grep {defined}
108 1130         12845 map { $_->init_arg }
109             $self->_block_parser_class->meta->get_all_attributes
110             ) {
111              
112             $bp_args{$key} = $args->{$key}
113 552 100       1456 if exists $args->{$key};
114             }
115              
116 184         5071 $bp_args{handler} = $self->handler;
117 184         4531 $bp_args{span_parser} = $self->_span_parser;
118              
119 184         5679 $self->_set_block_parser_args( \%bp_args );
120             }
121              
122             sub _set_classes_for_dialects {
123 184     184   396 my $self = shift;
124 184         351 my $args = shift;
125              
126 184         438 my $dialects = delete $args->{dialects};
127              
128 184 100       339 return unless @{ $dialects || [] };
  184 100       975  
129              
130 48         150 for my $thing (qw( block_parser span_parser )) {
131 96         213 my @roles;
132              
133 96         219 for my $dialect ( @{$dialects} ) {
  96         259  
134 98 50       298 next if $dialect eq 'Standard';
135              
136 98         358 my $role = $self->_role_name_for_dialect( $dialect, $thing );
137              
138             my $found = try {
139 98     98   4757 require_module($role);
140             }
141             catch {
142 1 50   1   421 die $_ unless $_ =~ /Can't locate/;
143 1         7 0;
144 98         756 };
145 98 100       33340 next unless $found;
146              
147 97         312 my $specified_class = $args->{ $thing . '_class' };
148              
149             next
150 97 50 66     350 if $specified_class
      66        
151             && $specified_class->can('meta')
152             && $specified_class->meta->does_role($role);
153              
154 97         344 push @roles, $role;
155             }
156              
157 96 100       283 next unless @roles;
158              
159 95         253 my $class_meth = q{_} . $thing . '_class';
160              
161 95         3244 my $class = Moose::Meta::Class->create_anon_class(
162             superclasses => [ $self->$class_meth() ],
163             roles => \@roles,
164             cache => 1,
165             )->name;
166              
167 95         175617 my $set_meth = '_set' . $class_meth;
168 95         3598 $self->$set_meth($class);
169             }
170             }
171              
172             sub _role_name_for_dialect {
173 98     98   197 my $self = shift;
174 98         175 my $dialect = shift;
175 98         170 my $type = shift;
176              
177 98         409 my $suffix = join q{}, map {ucfirst} split /_/, $type;
  196         666  
178              
179 98 100       358 if ( $dialect =~ /::/ ) {
180 4         16 return join '::', $dialect, $suffix;
181             }
182             else {
183 94         389 return join '::', 'Markdent::Dialect', $dialect, $suffix;
184             }
185             }
186              
187             sub _build_block_parser {
188 182     182   389 my $self = shift;
189              
190 182         4473 return $self->_block_parser_class->new( $self->_block_parser_args );
191             }
192              
193             sub _build_span_parser {
194 184     184   388 my $self = shift;
195              
196 184         4446 return $self->_span_parser_class->new( $self->_span_parser_args );
197             }
198              
199             {
200             my $validator = validation_for(
201             params => [ markdown => { type => t('Str') } ],
202             named_to_list => 1,
203             );
204              
205             sub parse {
206 178     178 1 970 my $self = shift;
207 178         3261 my ($text) = $validator->(@_);
208              
209 178         5060 $self->_clean_text( \$text );
210              
211 178         870 $self->_send_event('StartDocument');
212              
213 178         5333 $self->_block_parser->parse_document( \$text );
214              
215 176         898 $self->_send_event('EndDocument');
216              
217 176         4891 return;
218             }
219             }
220              
221             sub _clean_text {
222 178     178   421 my $self = shift;
223 178         331 my $text = shift;
224              
225 178         310 ${$text} =~ s/\r\n?/\n/g;
  178         877  
226 4         12 ${$text} .= "\n"
227 178 100       357 unless substr( ${$text}, -1, 1 ) eq "\n";
  178         1141  
228              
229 178         354 return;
230             }
231              
232             __PACKAGE__->meta->make_immutable;
233              
234             1;
235              
236             # ABSTRACT: A markdown parser
237              
238             __END__
239              
240             =pod
241              
242             =encoding UTF-8
243              
244             =head1 NAME
245              
246             Markdent::Parser - A markdown parser
247              
248             =head1 VERSION
249              
250             version 0.39
251              
252             =head1 SYNOPSIS
253              
254             my $handler = Markdent::Handler::HTMLStream->new( ... );
255              
256             my $parser = Markdent::Parser->new(
257             dialect => ...,
258             handler => $handler,
259             );
260              
261             $parser->parse( markdown => $markdown );
262              
263             =head1 DESCRIPTION
264              
265             This class provides the primary interface for creating a parser. It ties a
266             block and span parser together with a handler.
267              
268             By default, it will parse the standard Markdown dialect, but you can provide
269             alternate block or span parser classes.
270              
271             =head1 METHODS
272              
273             This class provides the following methods:
274              
275             =head2 Markdent::Parser->new(...)
276              
277             This method creates a new parser. It accepts the following parameters:
278              
279             =over 4
280              
281             =item * dialects => $name or [ $name1, $name2 ]
282              
283             You can use this to apply dialect roles to the standard parser class.
284              
285             If a dialect name does not contain a namespace separator (::), the constructor
286             looks for roles named C<Markdent::Dialect::${dialect}::BlockParser> and
287             C<Markdent::Dialect::${dialect}::SpanParser>.
288              
289             If a dialect name does contain a namespace separator, it is used a prefix -
290             C<$dialect::BlockParser> and C<$dialect::SpanParser>.
291              
292             If any relevant roles are found, they will be used by the parser.
293              
294             It is okay if a given dialect only provides a block or span parser, but not
295             both.
296              
297             =item * block_parser_class => $class
298              
299             This defaults to L<Markdent::Parser::BlockParser>, but can be any class which
300             implements the L<Markdent::Role::BlockParser> role.
301              
302             =item * span_parser_class => $class
303              
304             This defaults to L<Markdent::Parser::SpanParser>, but can be any class which
305             implements the L<Markdent::Role::SpanParser> role.
306              
307             =item * handler => $handler
308              
309             This can be any object which implements the L<Markdent::Role::Handler>
310             role. It is required.
311              
312             =back
313              
314             =head2 $parser->parse( markdown => $markdown )
315              
316             This method parses the given document. The parsing will cause events to be
317             fired which will be passed to the parser's handler.
318              
319             =head1 ROLES
320              
321             This class does the L<Markdent::Role::EventsAsMethods> and
322             L<Markdent::Role::Handler> roles.
323              
324             =head1 BUGS
325              
326             See L<Markdent> for bug reporting details.
327              
328             Bugs may be submitted at L<https://github.com/houseabsolute/Markdent/issues>.
329              
330             I am also usually active on IRC as 'autarch' on C<irc://irc.perl.org>.
331              
332             =head1 SOURCE
333              
334             The source code repository for Markdent can be found at L<https://github.com/houseabsolute/Markdent>.
335              
336             =head1 AUTHOR
337              
338             Dave Rolsky <autarch@urth.org>
339              
340             =head1 COPYRIGHT AND LICENSE
341              
342             This software is copyright (c) 2021 by Dave Rolsky.
343              
344             This is free software; you can redistribute it and/or modify it under
345             the same terms as the Perl 5 programming language system itself.
346              
347             The full text of the license can be found in the
348             F<LICENSE> file included with this distribution.
349              
350             =cut