File Coverage

blib/lib/Dist/Zilla/Plugin/PkgDist.pm
Criterion Covered Total %
statement 38 40 95.0
branch 12 18 66.6
condition 2 6 33.3
subroutine 6 6 100.0
pod 0 3 0.0
total 58 73 79.4


line stmt bran cond sub pod time code
1             package Dist::Zilla::Plugin::PkgDist 6.037;
2             # ABSTRACT: add a $DIST to your packages
3              
4 2     2   3542 use Moose;
  2         4  
  2         15  
5             with(
6             'Dist::Zilla::Role::FileMunger',
7             'Dist::Zilla::Role::FileFinderUser' => {
8             default_finders => [ ':InstallModules', ':ExecFiles' ],
9             },
10             'Dist::Zilla::Role::PPI',
11             );
12              
13 2     2   11258 use Dist::Zilla::Pragmas;
  2         3  
  2         18  
14              
15 2     2   10 use namespace::autoclean;
  2         4  
  2         26  
16              
17             #pod =head1 DESCRIPTION
18             #pod
19             #pod This plugin will add a line like the following to each package in each Perl
20             #pod module or program (more or less) within the distribution:
21             #pod
22             #pod { our $DIST = 'My-CPAN-Dist'; } # where 'My-CPAN-Dist' is your dist name
23             #pod
24             #pod It will skip any package declaration that includes a newline between the
25             #pod C<package> keyword and the package name, like:
26             #pod
27             #pod package
28             #pod Foo::Bar;
29             #pod
30             #pod This sort of declaration is also ignored by the CPAN toolchain, and is
31             #pod typically used when doing monkey patching or other tricky things.
32             #pod
33             #pod =cut
34              
35             sub munge_files {
36 1     1 0 3 my ($self) = @_;
37              
38 1         2 $self->munge_file($_) for @{ $self->found_files };
  1         9  
39             }
40              
41             sub munge_file {
42 9     9 0 1860 my ($self, $file) = @_;
43              
44             # XXX: for test purposes, for now! evil! -- rjbs, 2010-03-17
45 9 50       51 return if $file->name =~ /^corpus\//;
46              
47 9 50       19 return if $file->name =~ /\.t$/i;
48 9 50       20 return $self->munge_perl($file) if $file->name =~ /\.(?:pm|pl)$/i;
49 0 0       0 return $self->munge_perl($file) if $file->content =~ /^#!(?:.*)perl(?:$|\s)/;
50 0         0 return;
51             }
52              
53             sub munge_perl {
54 9     9 0 29 my ($self, $file) = @_;
55              
56 9         210 my $dist_name = $self->zilla->name;
57              
58 9         36 my $document = $self->ppi_document_for_file($file);
59              
60 9 100       1678 return unless my $package_stmts = $document->find('PPI::Statement::Package');
61              
62 8 100       4454 if ($self->document_assigns_to_variable($document, '$DIST')) {
63 3         14 $self->log([ 'skipping %s: assigns to $DIST', $file->name ]);
64 3         1108 return;
65             }
66              
67 5         6 my %seen_pkg;
68              
69 5         9 for my $stmt (@$package_stmts) {
70 9         1321 my $package = $stmt->namespace;
71              
72 9 100       215 if ($seen_pkg{ $package }++) {
73 1         7 $self->log([ 'skipping package re-declaration for %s', $package ]);
74 1         301 next;
75             }
76              
77 8 100       17 if ($stmt->content =~ /package\s*\n\s*\Q$package/) {
78 1         54 $self->log([ 'skipping private package %s', $package ]);
79 1         296 next;
80             }
81              
82             # the \x20 hack is here so that when we scan *this* document we don't find
83             # an assignment to version; it shouldn't be needed, but it's been annoying
84             # enough in the past that I'm keeping it here until tests are better
85 7         343 my $perl = "{\n \$$package\::DIST\x20=\x20'$dist_name';\n}\n";
86              
87 7         24 my $dist_doc = PPI::Document->new(\$perl);
88 7         11164 my @children = $dist_doc->schildren;
89              
90 7         74 $self->log_debug([
91             'adding $DIST assignment to %s in %s',
92             $package,
93             $file->name,
94             ]);
95              
96             # the extra whitespace element ensures we don't swallow up any blanks
97             # lines after 'package ...' in the source file that PkgVersion warns about
98             # if it's missing.
99 7 50 33     241 Carp::carp('error inserting $DIST in ' . $file->name)
      33        
100             unless $stmt->add_element( PPI::Token::Whitespace->new("\n") )
101             and $stmt->insert_after($children[0]->clone)
102             and $stmt->insert_after( PPI::Token::Whitespace->new("\n") );
103             }
104              
105             # the document is no longer correct; it must be reparsed before it can be used again
106 5         1065 $file->content($document->serialize);
107             }
108              
109             __PACKAGE__->meta->make_immutable;
110             1;
111              
112             __END__
113              
114             =pod
115              
116             =encoding UTF-8
117              
118             =head1 NAME
119              
120             Dist::Zilla::Plugin::PkgDist - add a $DIST to your packages
121              
122             =head1 VERSION
123              
124             version 6.037
125              
126             =head1 DESCRIPTION
127              
128             This plugin will add a line like the following to each package in each Perl
129             module or program (more or less) within the distribution:
130              
131             { our $DIST = 'My-CPAN-Dist'; } # where 'My-CPAN-Dist' is your dist name
132              
133             It will skip any package declaration that includes a newline between the
134             C<package> keyword and the package name, like:
135              
136             package
137             Foo::Bar;
138              
139             This sort of declaration is also ignored by the CPAN toolchain, and is
140             typically used when doing monkey patching or other tricky things.
141              
142             =head1 PERL VERSION
143              
144             This module should work on any version of perl still receiving updates from
145             the Perl 5 Porters. This means it should work on any version of perl
146             released in the last two to three years. (That is, if the most recently
147             released version is v5.40, then this module should work on both v5.40 and
148             v5.38.)
149              
150             Although it may work on older versions of perl, no guarantee is made that the
151             minimum required version will not be increased. The version may be increased
152             for any reason, and there is no promise that patches will be accepted to
153             lower the minimum required perl.
154              
155             =head1 AUTHOR
156              
157             Ricardo SIGNES 😏 <cpan@semiotic.systems>
158              
159             =head1 COPYRIGHT AND LICENSE
160              
161             This software is copyright (c) 2026 by Ricardo SIGNES.
162              
163             This is free software; you can redistribute it and/or modify it under
164             the same terms as the Perl 5 programming language system itself.
165              
166             =cut