File Coverage

blib/lib/Dist/Zilla/Plugin/PkgVersion/Block.pm
Criterion Covered Total %
statement 56 65 86.1
branch 21 30 70.0
condition 12 15 80.0
subroutine 8 8 100.0
pod 0 3 0.0
total 97 121 80.1


line stmt bran cond sub pod time code
1 1     1   662818 use 5.14.0;
  1         4  
  1         87  
2              
3             # ABSTRACT: PkgVersion for block packages
4              
5             package Dist::Zilla::Plugin::PkgVersion::Block {
6              
7             our $VERSION = '0.0107'; # VERSION
8              
9 1     1   5 use Moose;
  1         2  
  1         7  
10             with('Dist::Zilla::Role::FileMunger',
11             'Dist::Zilla::Role::FileFinderUser' => { default_finders => [':InstallModules', ':ExecFiles'] },
12             'Dist::Zilla::Role::PPI'
13             );
14              
15 1     1   5480 use PPI;
  1         90312  
  1         35  
16 1     1   10 use MooseX::Types::Perl qw/StrictVersionStr/;
  1         1  
  1         11  
17 1     1   1890 use namespace::autoclean;
  1         2  
  1         9  
18              
19             sub munge_files {
20 1     1 0 94631 my($self) = @_;
21              
22 1 50       6 if(!StrictVersionStr->check($self->zilla->version)) {
23 0         0 Carp::croak('Version ' . $self->zilla->version . ' does not conform to the strict version string format.') ;
24             }
25 1         841 $self->munge_file($_) for @{ $self->found_files };
  1         6  
26             }
27              
28             sub munge_file {
29 5     5 0 4356 my $self = shift;
30 5         7 my $file = shift;
31              
32 5 50       21 if($file->is_bytes) {
33 0         0 $self->log_debug([ "%s has 'bytes' encoding, skipping...", $file->name ]);
34 0         0 return;
35             }
36 5         288 return $self->munge_perl($file);
37             }
38              
39             sub munge_perl {
40 5     5 0 11 my $self = shift;
41 5         4 my $file = shift;
42              
43 5         18 my $document = $self->ppi_document_for_file($file);
44              
45 5         12790 my $package_statements = $document->find('PPI::Statement::Package');
46 5 50       3464 if(!$package_statements) {
47 0         0 $self->log_debug([ 'skipping %s: no package statement found', $file->name ]);
48 0         0 return;
49             }
50              
51 5 50       26 if($self->document_assigns_to_variable($document, '$VERSION')) {
52 0         0 $self->log_fatal([ 'existing assignment to $VERSION in %s', $file->name ]);
53             }
54              
55 5         4899 my %seen;
56 5         9 my $munged = 0;
57              
58 5         14 STATEMENT:
59 5         6 for my $stmt (@{ $package_statements }) {
60 6         18 my $package = $stmt->namespace;
61 6 50       130 if($seen{ $package }++) {
62 0         0 $self->log([ 'skipping package re-declaration for %s', $package ]);
63 0         0 next STATEMENT;
64             }
65 6 100       19 if($stmt->content =~ m{ package \s* (?:\#.*)? \n \s* \Q$package}x ) {
66 1         80 $self->log([ 'skipping private package %s in %s', $package, $file->name] );
67 1         421 next STATEMENT;
68             }
69 5 50       383 if($package =~ m{\P{ASCII}}) {
70 0         0 $self->log('non-ASCII package name is likely to cause problems');
71             }
72              
73 5         10 my $count = 0;
74 5         7 my $name_token = undef;
75              
76             TOKEN:
77 5         19 foreach my $token ($stmt->tokens) {
78 24         217 ++$count;
79              
80 24 50 66     54 last TOKEN if $count == 1 && $token ne 'package';
81 24 50 66     139 last TOKEN if $count == 2 && $token !~ m{\s+};
82 24 50 66     74 last TOKEN if $count == 3 && $token !~ m{\w+(::\w+)*};
83 24 100       56 $name_token = $token if $count == 3;
84 24 100 100     44 last TOKEN if $count == 4 && $token !~ m{\s+};
85 23 100 100     61 last TOKEN if $count == 5 && $token ne '{';
86              
87 22 100       67 if($count == 5) {
88 3         110 my $version_token = PPI::Token::Comment->new(" " . $self->zilla->version);
89 3         134 $name_token->insert_after($version_token);
90 3         214 $munged = 1;
91 3         34 $self->log([ 'adding version to %s in %s', $package, $file->name ]);
92 3         1147 last TOKEN;
93             }
94             }
95             }
96 5 100       56 $self->save_ppi_document_to_file($document, $file) if $munged;
97             }
98             }
99              
100             1;
101              
102             __END__
103              
104             =pod
105              
106             =encoding UTF-8
107              
108             =head1 NAME
109              
110             Dist::Zilla::Plugin::PkgVersion::Block - PkgVersion for block packages
111              
112              
113              
114             =begin HTML
115              
116             <p><img src="https://img.shields.io/badge/perl-5.14+-brightgreen.svg" alt="Requires Perl 5.14+" /> <a href="https://travis-ci.org/Csson/p5-Dist-Zilla-Plugin-PkgVersion-Block"><img src="https://api.travis-ci.org/Csson/p5-Dist-Zilla-Plugin-PkgVersion-Block.svg?branch=master" alt="Travis status" /></a></p>
117              
118             =end HTML
119              
120              
121             =begin markdown
122              
123             ![Requires Perl 5.14+](https://img.shields.io/badge/perl-5.14+-brightgreen.svg) [![Travis status](https://api.travis-ci.org/Csson/p5-Dist-Zilla-Plugin-PkgVersion-Block.svg?branch=master)](https://travis-ci.org/Csson/p5-Dist-Zilla-Plugin-PkgVersion-Block)
124              
125             =end markdown
126              
127             =head1 VERSION
128              
129             Version 0.0107, released 2015-05-31.
130              
131             =head1 SYNOPSIS
132              
133             # dist.ini
134             [PkgVersion::Block]
135              
136             =head1 DESCRIPTION
137              
138             This plugin turns:
139              
140             package My::Package {
141             ...
142             }
143              
144             into:
145              
146             package My::Package 0.01 {
147             ...
148             }
149              
150             for all packages in the distribution.
151              
152             The block package syntax was introduced in Perl 5.14, so this plugin is only usable in projects that only support 5.14+.
153              
154             There are no attributes. However:
155              
156             =over 4
157              
158             =item *
159              
160             Having an existing assignment to $VERSION in the file is a fatal error.
161              
162             =item *
163              
164             Packages with a version number between the namespace and the block are silently skipped.
165              
166             =back
167              
168             =head1 KNOWN PROBLEMS
169              
170             In files with more than one package block it is currently necessary to end (all but the last) package blocks with a semicolon. Otherwise only the first package will get a version number:
171              
172             package My::Package {
173             ...
174             };
175              
176             package My::Package::Other {
177             ...
178             }
179              
180             =head1 SEE ALSO
181              
182             =over 4
183              
184             =item *
185              
186             L<Dist::Zilla::Plugin::PkgVersion> (on which this is based)
187              
188             =item *
189              
190             L<Dist::Zilla::Plugin::OurPkgVersion>
191              
192             =back
193              
194             =head1 SOURCE
195              
196             L<https://github.com/Csson/p5-Dist-Zilla-Plugin-PkgVersion-Block>
197              
198             =head1 HOMEPAGE
199              
200             L<https://metacpan.org/release/Dist-Zilla-Plugin-PkgVersion-Block>
201              
202             =head1 AUTHOR
203              
204             Erik Carlsson <info@code301.com>
205              
206             =head1 COPYRIGHT AND LICENSE
207              
208             This software is copyright (c) 2015 by Erik Carlsson <info@code301.com>.
209              
210             This is free software; you can redistribute it and/or modify it under
211             the same terms as the Perl 5 programming language system itself.
212              
213             =cut