File Coverage

blib/lib/Dist/Zilla/Plugin/ReadmeAnyFromPod.pm
Criterion Covered Total %
statement 119 124 95.9
branch 32 38 84.2
condition 16 18 88.8
subroutine 25 26 96.1
pod 7 8 87.5
total 199 214 92.9


line stmt bran cond sub pod time code
1 12     12   1824485 use strict;
  12         22  
  12         387  
2 12     12   59 use warnings;
  12         16  
  12         786  
3              
4             package Dist::Zilla::Plugin::ReadmeAnyFromPod;
5             # ABSTRACT: Automatically convert POD to a README in any format for Dist::Zilla
6             $Dist::Zilla::Plugin::ReadmeAnyFromPod::VERSION = '0.163250';
7 12     12   64 use List::Util 1.33 qw( none first );
  12         379  
  12         1294  
8 12     12   8947 use Moose::Util::TypeConstraints qw(enum);
  12         2939456  
  12         138  
9 12     12   15595 use Moose;
  12         1679026  
  12         90  
10 12     12   80060 use MooseX::Has::Sugar;
  12         7571  
  12         57  
11 12     12   8875 use Path::Tiny 0.004;
  12         84635  
  12         815  
12 12     12   93 use Scalar::Util 'blessed';
  12         19  
  12         22062  
13              
14             with 'Dist::Zilla::Role::AfterBuild',
15             'Dist::Zilla::Role::AfterRelease',
16             'Dist::Zilla::Role::FileGatherer',
17             'Dist::Zilla::Role::FileMunger',
18             'Dist::Zilla::Role::FilePruner',
19             'Dist::Zilla::Role::FileWatcher',
20             'Dist::Zilla::Role::PPI',
21             ;
22              
23             # TODO: Should these be separate modules?
24             our $_types = {
25             pod => {
26             filename => 'README.pod',
27             parser => sub {
28             return $_[0];
29             },
30             },
31             text => {
32             filename => 'README',
33             parser => sub {
34             my $pod = $_[0];
35              
36             require Pod::Simple::Text;
37             Pod::Simple::Text->VERSION('3.23');
38             my $parser = Pod::Simple::Text->new;
39             $parser->output_string( \my $content );
40             $parser->parse_characters(1);
41             $parser->parse_string_document($pod);
42             return $content;
43             },
44             },
45             markdown => {
46             filename => 'README.mkdn',
47             parser => sub {
48             my $pod = $_[0];
49              
50             require Pod::Markdown;
51             Pod::Markdown->VERSION('2.000');
52             my $parser = Pod::Markdown->new();
53             $parser->output_string( \my $content );
54             $parser->parse_characters(1);
55             $parser->parse_string_document($pod);
56             return $content;
57             },
58             },
59             gfm => {
60             filename => 'README.md',
61             parser => sub {
62             my $pod = $_[0];
63              
64             require Pod::Markdown::Github;
65             Pod::Markdown->VERSION('0.01');
66             my $parser = Pod::Markdown::Github->new();
67             $parser->output_string( \my $content );
68             $parser->parse_characters(1);
69             $parser->parse_string_document($pod);
70             return $content;
71             },
72             },
73             html => {
74             filename => 'README.html',
75             parser => sub {
76             my $pod = $_[0];
77              
78             require Pod::Simple::HTML;
79             Pod::Simple::HTML->VERSION('3.23');
80             my $parser = Pod::Simple::HTML->new;
81             $parser->output_string( \my $content );
82             $parser->parse_characters(1);
83             $parser->parse_string_document($pod);
84             return $content;
85             }
86             }
87             };
88              
89              
90             has type => (
91             ro, lazy,
92             isa => enum([keys %$_types]),
93             default => sub { $_[0]->__from_name()->[0] || 'text' },
94             );
95              
96              
97             has filename => (
98             ro, lazy,
99             isa => 'Str',
100             default => sub { $_types->{$_[0]->type}->{filename}; }
101             );
102              
103              
104             has source_filename => (
105             ro, lazy,
106             isa => 'Str',
107             builder => '_build_source_filename',
108             );
109              
110             sub _build_source_filename {
111 47     47   83 my $self = shift;
112 47         1557 my $pm = $self->zilla->main_module->name;
113 47         36337 (my $pod = $pm) =~ s/\.pm$/\.pod/;
114 47 50       3105 return -e $pod ? $pod : $pm;
115             }
116              
117              
118             has location => (
119             ro, lazy,
120             isa => enum([qw(build root)]),
121             default => sub { $_[0]->__from_name()->[1] || 'build' },
122             );
123              
124              
125             has phase => (
126             ro, lazy,
127             isa => enum([qw(build release)]),
128             default => 'build',
129             );
130              
131              
132             sub BUILD {
133 50     50 0 74 my $self = shift;
134              
135 50 100 100     2125 $self->log_fatal('You cannot use location=build with phase=release!')
136             if $self->location eq 'build' and $self->phase eq 'release';
137              
138 49 100 100     1758 $self->log('You are creating a .pod directly in the build - be aware that this will be installed like a .pm file and as a manpage')
139             if $self->location eq 'build' and $self->type eq 'pod';
140             }
141              
142              
143             sub gather_files {
144 49     49 1 991640 my ($self) = @_;
145              
146 49         1950 my $filename = $self->filename;
147 49 100 100     1916 if ( $self->location eq 'build'
148             # allow for the file to also exist in the dist
149 123     123   4353 and none { $_->name eq $filename } @{ $self->zilla->files }
  26         816  
150             ) {
151 25         6228 require Dist::Zilla::File::InMemory;
152 25         609410 my $file = Dist::Zilla::File::InMemory->new({
153             content => 'this will be overwritten',
154             name => $self->filename,
155             });
156              
157 25         7596 $self->add_file($file);
158             }
159 49         9584 return;
160             }
161              
162              
163             sub prune_files {
164 49     49 1 23164 my ($self) = @_;
165              
166             # leave the file in the dist if another instance of us is adding it there.
167 49 100 100     1928 if ($self->location eq 'root'
168             and not grep {
169 371 100 100     5864 blessed($self) eq blessed($_)
170             and $_->location eq 'build'
171             and $_->filename eq $self->filename
172 23         714 } @{$self->zilla->plugins}) {
173 12         17 for my $file (@{ $self->zilla->files }) {
  12         337  
174 49 100       632 next unless $file->name eq $self->filename;
175 1         4 $self->log_debug([ 'pruning %s', $file->name ]);
176 1         148 $self->zilla->prune_file($file);
177             }
178             }
179 49         125 return;
180             }
181              
182              
183             sub munge_files {
184 49     49 1 26816 my $self = shift;
185              
186 49 100       1984 if ( $self->location eq 'build' ) {
187 26         975 my $filename = $self->filename;
188 26     146   134 my $file = first { $_->name eq $filename } @{ $self->zilla->files };
  146         5517  
  26         768  
189 26 100       1062 if ($file) {
190 25         86 $self->munge_file($file);
191             }
192             else {
193 1         7 $self->log_fatal(
194             "Could not find a $filename file during the build"
195             . ' - did you prune it away with a PruneFiles block?' );
196             }
197             }
198 48         182 return;
199             }
200              
201              
202             my %watching;
203             sub munge_file {
204 25     25 1 51 my ($self, $target_file) = @_;
205              
206             # Ensure that we repeat the munging if the source file is modified
207             # after we run.
208 25         94 my $source_file = $self->_source_file();
209             $self->watch_file($source_file, sub {
210 0     0   0 my ($self, $watched_file) = @_;
211              
212             # recalculate the content based on the updates
213 0         0 $self->log('someone tried to munge ' . $watched_file->name . ' after we read from it. Making modifications again...');
214 0         0 $self->munge_file($target_file);
215 25 100       994 }) if not $watching{$source_file->name}++;
216              
217 25         363105 $self->log_debug([ 'ReadmeAnyFromPod updating contents of %s in dist', $target_file->name ]);
218 25         2958 $target_file->content($self->get_readme_content);
219 25         8149 return;
220             }
221              
222              
223             sub after_build {
224 48     48 1 669331 my $self = shift;
225 48 100       2246 $self->_create_readme if $self->phase eq 'build';
226             }
227              
228              
229             sub after_release {
230 1     1 1 100341 my $self = shift;
231 1 50       50 $self->_create_readme if $self->phase eq 'release';
232             }
233              
234             sub _create_readme {
235 48     48   96 my $self = shift;
236              
237 48 100       1961 if ( $self->location eq 'root' ) {
238 23         1004 my $filename = $self->filename;
239 23         172 $self->log_debug([ 'ReadmeAnyFromPod updating contents of %s in root', $filename ]);
240              
241 23         1811 my $content = $self->get_readme_content();
242              
243 23         961 my $destination_file = path($self->zilla->root)->child($filename);
244 23 100       2415 if (-e $destination_file) {
245 2         94 $self->log("overriding $filename in root");
246             }
247 23         1875 my $encoding = $self->_get_source_encoding();
248             $destination_file->spew_raw(
249             $encoding eq 'raw'
250             ? $content
251 23 50       205 : do { require Encode; Encode::encode($encoding, $content) }
  23         133  
  23         110  
252             );
253             }
254              
255 48         11577 return;
256             }
257              
258             sub _source_file {
259 144     144   227 my ($self) = shift;
260              
261 144         6454 my $filename = $self->source_filename;
262 144     582   598 first { $_->name eq $filename } @{ $self->zilla->files };
  582         23187  
  144         4435  
263             }
264              
265             # Holds the contents of the source file as of the last time we
266             # generated a readme from it. We use this to detect when the source
267             # file is modified so we can update the README file again.
268             has _last_source_content => (
269             is => 'rw', isa => 'Str',
270             default => '',
271             );
272              
273             sub _get_source_pod {
274 48     48   111 my ($self) = shift;
275              
276 48         137 my $source_file = $self->_source_file;
277              
278             # cache contents before we alter it, for later comparison
279 48         2043 $self->_last_source_content($source_file->content);
280              
281 48         7870 require PPI::Document; # for Dist::Zilla::Role::PPI < 5.009
282 48         1154003 my $doc = $self->ppi_document_for_file($source_file);
283              
284 48         108038 my $pod_elems = $doc->find('PPI::Token::Pod');
285 48         69197 my $pod_content = "";
286 48 50       228 if ($pod_elems) {
287             # Concatenation should stringify it
288 48         253 $pod_content .= PPI::Token::Pod->merge(@$pod_elems);
289             }
290              
291 48 50 33     6490 if ((my $encoding = $self->_get_source_encoding) ne 'raw'
292 48         1716 and not eval { Dist::Zilla::Role::PPI->VERSION('6.003') }
293             ) {
294             # older Dist::Zilla::Role::PPI passes encoded content to PPI
295 0         0 require Encode;
296 0         0 $pod_content = Encode::decode($encoding, $pod_content);
297             }
298              
299 48         416 return $pod_content;
300             }
301              
302             sub _get_source_encoding {
303 71     71   515 my ($self) = shift;
304 71         204 my $source_file = $self->_source_file;
305             return
306 71 50       4926 $source_file->can('encoding')
307             ? $source_file->encoding
308             : 'raw'; # Dist::Zilla pre-5.0
309             }
310              
311              
312             sub get_readme_content {
313 48     48 1 157 my ($self) = shift;
314 48         317 my $source_pod = $self->_get_source_pod();
315 48         15996 my $parser = $_types->{$self->type}->{parser};
316             # Save the POD text used to generate the README.
317 48         185 return $parser->($source_pod);
318             }
319              
320             {
321             my %cache;
322             sub __from_name {
323 77     77   114 my ($self) = @_;
324 77         2201 my $name = $self->plugin_name;
325              
326             # Use cached values if available
327 77 100       581 if ($cache{$name}) {
328 38         1442 return $cache{$name};
329             }
330              
331             # qr{TYPE1|TYPE2|...}
332 39         163 my $type_regex = join('|', map {quotemeta} keys %$_types);
  195         362  
333             # qr{LOC1|LOC2|...}
334 39         98 my $location_regex = join('|', map {quotemeta} qw(build root));
  78         133  
335             # qr{(?:Readme)? (TYPE1|TYPE2|...) (?:In)? (LOC1|LOC2|...) }x
336 39         1084 my $complete_regex = qr{ (?:Readme)? ($type_regex) (?:(?:In)? ($location_regex))? }ix;
337 39         1277 my ($type, $location) = (lc $name) =~ m{(?:\A|/) \s* $complete_regex \s* \Z}ix;
338 39         154 $cache{$name} = [$type, $location];
339 39         1686 return $cache{$name};
340             }
341             }
342              
343             __PACKAGE__->meta->make_immutable;
344              
345             __END__
346              
347             =pod
348              
349             =head1 NAME
350              
351             Dist::Zilla::Plugin::ReadmeAnyFromPod - Automatically convert POD to a README in any format for Dist::Zilla
352              
353             =head1 VERSION
354              
355             version 0.163250
356              
357             =head1 SYNOPSIS
358              
359             In your F<dist.ini>
360              
361             [ReadmeAnyFromPod]
362             ; Default is plaintext README in build dir
363              
364             ; Using non-default options: POD format with custom filename in
365             ; dist root, outside of build. Including this README in version
366             ; control makes Github happy.
367             [ReadmeAnyFromPod / ReadmePodInRoot]
368             type = pod
369             filename = README.pod
370             location = root
371              
372             ; Using plugin name autodetection: Produces README.html in root
373             [ ReadmeAnyFromPod / HtmlInRoot ]
374              
375             =head1 DESCRIPTION
376              
377             Generates a README for your L<Dist::Zilla> powered dist from its
378             C<main_module> in any of several formats. The generated README can be
379             included in the build or created in the root of your dist for e.g.
380             inclusion into version control.
381              
382             =head2 PLUGIN NAME AUTODETECTION
383              
384             If you give the plugin an appropriate name (a string after the slash)
385             in your dist.ini, it will can parse the C<type> and C<location>
386             attributes from it. The format is "Readme[TYPE]In[LOCATION]". The
387             words "Readme" and "In" are optional, and the whole name is
388             case-insensitive. The SYNOPSIS section above gives one example.
389              
390             When run with C<location = dist>, this plugin runs in the C<FileMunger> phase
391             to create the new file. If it runs before another C<FileMunger> plugin does,
392             that happens to modify the input pod (like, say,
393             L<C<[PodWeaver]>|Dist::Zilla::Plugin::PodWeaver>), the README file contents
394             will be recalculated, along with a warning that you should modify your
395             F<dist.ini> by referencing C<[ReadmeAnyFromPod]> lower down in the file (the
396             build still works, but is less efficient).
397              
398             =head1 ATTRIBUTES
399              
400             =head2 type
401              
402             The file format for the readme. Supported types are "text",
403             "markdown", "gfm" (Github-flavored markdown), "pod", and "html". Note
404             that you are not advised to create a F<.pod> file in the dist itself,
405             as L<ExtUtils::MakeMaker> will install that, both into C<PERL5LIB> and
406             C<MAN3DIR>.
407              
408             =head2 filename
409              
410             The file name of the README file to produce. The default depends on
411             the selected format.
412              
413             =head2 source_filename
414              
415             The file from which to extract POD for the content of the README. The
416             default is the file of the main module of the dist. If the main module
417             has a companion ".pod" file with the same basename, that is used as
418             the default instead.
419              
420             =head2 location
421              
422             Where to put the generated README file. Choices are:
423              
424             =over 4
425              
426             =item build
427              
428             This puts the README in the directory where the dist is currently
429             being built, where it will be incorporated into the dist.
430              
431             =item root
432              
433             This puts the README in the root directory (the same directory that
434             contains F<dist.ini>). The README will not be incorporated into the
435             built dist.
436              
437             =back
438              
439             If you want to generate the same README file in both the build
440             directory and the root directory, simply generate it in the build
441             directory and use the
442             L<C<[CopyFilesFromBuild]>|Dist::Zilla::Plugin::CopyFilesFromBuild>
443             plugin to copy it to the dist root.
444              
445             =head2 phase
446              
447             At what phase to generate the README file. Choices are:
448              
449             =over 4
450              
451             =item build
452              
453             (Default) This generates the README at 'after build' time. A new
454             README will be generated each time you build the dist.
455              
456             =item release
457              
458             This generates the README at 'after release' time. Note that this is
459             too late to get the file into the generated tarball, and is therefore
460             incompatible with C<location = build>. However, this is ideal if you
461             are using C<location = root> and only want to update the README upon
462             each release of your module.
463              
464             =back
465              
466             =head1 METHODS
467              
468             =head2 gather_files
469              
470             We create the file early, so other plugins that need to have the full list of
471             files are aware of what we will be generating.
472              
473             =head2 prune_files
474              
475             Files with C<location = root> must also be pruned, so that they don't
476             sneak into the I<next> build by virtue of already existing in the root
477             dir. (The alternative is that the user doesn't add them to the build in the
478             first place, with an option to their C<GatherDir> plugin.)
479              
480             =head2 munge_files
481              
482             =head2 munge_file
483              
484             Edits the content into the requested README file in the dist.
485              
486             =head2 after_build
487              
488             Create the requested README file at build time, if requested.
489              
490             =head2 after_release
491              
492             Create the requested README file at release time, if requested.
493              
494             =head2 get_readme_content
495              
496             Get the content of the README in the desired format.
497              
498             =for Pod::Coverage BUILD
499              
500             =head1 BUGS AND LIMITATIONS
501              
502             Please report any bugs or feature requests to
503             C<rct+perlbug@thompsonclan.org>.
504              
505             =head1 SEE ALSO
506              
507             =over 4
508              
509             =item *
510              
511             L<Dist::Zilla::Plugin::ReadmeFromPod> - The base for this module
512              
513             =item *
514              
515             L<Dist::Zilla::Plugin::ReadmeMarkdownFromPod> - Functionality subsumed by this module
516              
517             =item *
518              
519             L<Dist::Zilla::Plugin::CopyReadmeFromBuild> - Functionality partly subsumed by this module
520              
521             =back
522              
523             =head1 INSTALLATION
524              
525             See perlmodinstall for information and options on installing Perl modules.
526              
527             =head1 AUTHORS
528              
529             =over 4
530              
531             =item *
532              
533             Ryan C. Thompson <rct@thompsonclan.org>
534              
535             =item *
536              
537             Karen Etheridge <ether@cpan.org>
538              
539             =back
540              
541             =head1 COPYRIGHT AND LICENSE
542              
543             This software is copyright (c) 2016 by Ryan C. Thompson.
544              
545             This is free software; you can redistribute it and/or modify it under
546             the same terms as the Perl 5 programming language system itself.
547              
548             =head1 DISCLAIMER OF WARRANTY
549              
550             BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
551             FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT
552             WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER
553             PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND,
554             EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
555             IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
556             PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
557             SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME
558             THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION.
559              
560             IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
561             WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
562             REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE
563             TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR
564             CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
565             SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
566             RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
567             FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
568             SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
569             DAMAGES.
570              
571             =cut