File Coverage

blib/lib/Dist/Zilla/Plugin/TrialVersionComment.pm
Criterion Covered Total %
statement 48 50 96.0
branch 12 20 60.0
condition 6 12 50.0
subroutine 8 8 100.0
pod 0 1 0.0
total 74 91 81.3


line stmt bran cond sub pod time code
1 6     6   3178599 use strict;
  6         9  
  6         252  
2 6     6   29 use warnings;
  6         9  
  6         318  
3             package Dist::Zilla::Plugin::TrialVersionComment; # git description: v0.003-12-g095c87e
4             # ABSTRACT: Add a "# TRIAL" comment after your version declaration in trial releases
5             # KEYWORDS: plugin modules package version comment trial release
6             # vim: set ts=8 sts=4 sw=4 tw=78 et :
7             our $VERSION = '0.004';
8 6     6   27 use Moose;
  6         10  
  6         41  
9             with
10             'Dist::Zilla::Role::PPI',
11             'Dist::Zilla::Role::FileMunger',
12             'Dist::Zilla::Role::FileFinderUser' =>
13             { default_finders => [ ':InstallModules', ':ExecFiles' ] },
14             ;
15 6     6   27581 use Module::Runtime 'module_notional_filename';
  6         10  
  6         41  
16 6     6   3168 use PPI::Document;
  6         508958  
  6         203  
17 6     6   49 use namespace::autoclean;
  6         7  
  6         49  
18              
19             sub munge_files
20             {
21 6     6 0 294715 my $self = shift;
22              
23 6 100       189 $self->log_debug([ 'release_status is not trial; doing nothing' ]), return
24             if not $self->zilla->is_trial;
25              
26 2         96 foreach my $file ( @{ $self->found_files })
  2         12  
27             {
28 2 50 33     2331 next if $file->can('is_bytes') and $file->is_bytes;
29 2 50 33     119 next if $INC{module_notional_filename('Dist::Zilla::Role::MutableFile')} and not $file->does('Dist::Zilla::Role::MutableFile');
30              
31             # it would be nice if we could just ask Module::Metadata for the line
32             # (and character offset!) that it already found - might be faster
33              
34 2         1036 my $document = $self->ppi_document_for_file($file);
35              
36 2         10496 my $package_stmt = $document->find_first('PPI::Statement::Package');
37 2 50       402 $self->log_debug([ 'skipping %s: no package statement found', $file->name ]), return
38             if not $package_stmt;
39              
40 2         3 my %seen_version_for_package;
41 2         4 my $package = 'main';
42              
43 2         3 my $munged = 0;
44              
45             my $finder = sub {
46 48     48   414 my $node = $_[1];
47 48 100       175 return 0 if not $node->isa('PPI::Statement');
48              
49             # this does not properly handle scopes - see the ::Package docs
50 9 100       40 $package = $node->namespace, return undef if $node->isa('PPI::Statement::Package');
51              
52             # do not descend into the nodes comprising the statement
53 3         262 return undef unless $node->isa('PPI::Statement::Variable')
54             and $node->type eq 'our'
55 5 50 66     28 and grep { $_ eq '$VERSION' } $node->variables;
      66        
56              
57             # find the line with this statement - this is safe to do even
58             # after munging because we do not insert or remove lines
59 3         14 my @content_lines = split("\n", $file->content, $node->line_number + 1);
60 3         2829 return $content_lines[$#content_lines - 1] !~ /;\h*#\s*TRIAL/; # no existing comment on line
61 2         13 };
62              
63 2         15 my $matches = $document->find($finder);
64 2 50       24 if (not $matches)
65             {
66 0 0       0 $self->log_fatal('got PPI error') if not defined $matches;
67 0         0 next;
68             }
69              
70 2         5 foreach my $node (@{ $matches })
  2         5  
71             {
72 3         23 $self->log_debug([ 'Adding # TRIAL to $VERSION line for %s', $package ]);
73              
74             # inserted in reverse order... can I insert both at the same time?
75 3         1013 $node->insert_after(PPI::Token::Comment->new('# TRIAL'));
76 3         209 $node->insert_after(PPI::Token::Whitespace->new(' '));
77 3         116 $document->flush_locations;
78 3         449 $munged = 1;
79             }
80              
81 2 50       14 $self->save_ppi_document_to_file($document, $file) if $munged;
82             }
83             }
84              
85             __PACKAGE__->meta->make_immutable;
86              
87             __END__
88              
89             =pod
90              
91             =encoding UTF-8
92              
93             =head1 NAME
94              
95             Dist::Zilla::Plugin::TrialVersionComment - Add a "# TRIAL" comment after your version declaration in trial releases
96              
97             =head1 VERSION
98              
99             version 0.004
100              
101             =head1 SYNOPSIS
102              
103             In your F<dist.ini>:
104              
105             [TrialVersionComment]
106              
107             =head1 DESCRIPTION
108              
109             This is a L<Dist::Zilla> plugin that munges your F<.pm> files to add a
110             C<# TRIAL> comment after C<$VERSION> assignments, if the release is C<--trial>.
111              
112             If the distribution is not a C<--trial> release (i.e. C<release_status> in
113             metadata is C<stable>), this plugin does nothing.
114              
115             =for stopwords PkgVersion OurPkgVersion RewriteVersion
116              
117             Other plugins that munge versions into files also add the C<# TRIAL> comment (such as
118             L<[PkgVersion]|Dist::Zilla::Plugin::PkgVersion>,
119             L<[OurPkgVersion]|Dist::Zilla::Plugin::OurPkgVersion>, and
120             L<[RewriteVersion]|Dist::Zilla::Plugin::RewriteVersion>, so you would
121             generally only need this plugin if you added the version yourself, manually.
122              
123             Nothing currently parses these comments, but the idea is that things like
124             L<Module::Metadata> might make use of this in the future.
125              
126             =for Pod::Coverage munge_files
127              
128             =head1 SUPPORT
129              
130             =for stopwords irc
131              
132             Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=Dist-Zilla-Plugin-TrialVersionComment>
133             (or L<bug-Dist-Zilla-Plugin-TrialVersionComment@rt.cpan.org|mailto:bug-Dist-Zilla-Plugin-TrialVersionComment@rt.cpan.org>).
134             I am also usually active on irc, as 'ether' at C<irc.perl.org>.
135              
136             =head1 ACKNOWLEDGEMENTS
137              
138             =for stopwords xdg
139              
140             Inspiration for this module came about through multiple toolchain conversations with David Golden (xdg).
141              
142             =head1 SEE ALSO
143              
144             =for stopwords BumpVersionAfterRelease
145             OverridePkgVersion
146             PkgVersionIfModuleWithPod
147             SurgicalPkgVersion
148              
149             =over 4
150              
151             =item *
152              
153             L<[PkgVersion]|Dist::Zilla::Plugin::PkgVersion>
154              
155             =item *
156              
157             L<[OurPkgVersion]|Dist::Zilla::Plugin::OurPkgVersion>
158              
159             =item *
160              
161             L<[BumpVersionAfterRelease]|Dist::Zilla::Plugin::BumpVersionAfterRelease>
162              
163             =item *
164              
165             L<[OverridePkgVersion]|Dist::Zilla::Plugin::OverridePkgVersion>
166              
167             =item *
168              
169             L<[SurgicalPkgVersion]|Dist::Zilla::Plugin::SurgicalPkgVersion>
170              
171             =item *
172              
173             L<[PkgVersionIfModuleWithPod]|Dist::Zilla::Plugin::PkgVersionIfModuleWithPod>
174              
175             =back
176              
177             =head1 AUTHOR
178              
179             Karen Etheridge <ether@cpan.org>
180              
181             =head1 COPYRIGHT AND LICENSE
182              
183             This software is copyright (c) 2014 by Karen Etheridge.
184              
185             This is free software; you can redistribute it and/or modify it under
186             the same terms as the Perl 5 programming language system itself.
187              
188             =head1 CONTRIBUTOR
189              
190             =for stopwords David Golden
191              
192             David Golden <dagolden@cpan.org>
193              
194             =cut