File Coverage

blib/lib/Dist/Zilla/Plugin/Author/Plicease/Thanks.pm
Criterion Covered Total %
statement 36 37 97.3
branch 9 12 75.0
condition n/a
subroutine 8 8 100.0
pod 0 3 0.0
total 53 60 88.3


line stmt bran cond sub pod time code
1             package Dist::Zilla::Plugin::Author::Plicease::Thanks 2.74 {
2              
3 2     2   3258226 use 5.020;
  2         8  
4 2     2   14 use Moose;
  2         5  
  2         17  
5 2     2   14062 use experimental qw( postderef );
  2         7  
  2         17  
6              
7             with 'Dist::Zilla::Role::MetaProvider';
8             with 'Dist::Zilla::Role::FileMunger';
9             with 'Dist::Zilla::Role::FileFinderUser' => {
10             default_finders => [ ':InstallModules', ':ExecFiles' ],
11             };
12              
13             # ABSTRACT: munge the AUTHOR section
14              
15              
16             has original => (
17             is => 'ro',
18             isa => 'Str',
19             );
20              
21             has current => (
22             is => 'ro',
23             isa => 'Str',
24             );
25              
26             has contributor => (
27             is => 'ro',
28             isa => 'ArrayRef[Str]',
29             default => sub { [] },
30             );
31              
32             sub mvp_multivalue_args { qw( contributor ) }
33              
34             sub munge_files
35             {
36 4     4 0 119233 my($self) = @_;
37 4         27 $self->munge_file($_) for $self->found_files->@*;
38             }
39              
40             sub _escape ($)
41             {
42 12     12   30 my($txt) = @_;
43 12         42 my %map = qw(
44             < lt
45             > gt
46             );
47 12         28 $txt =~ s{([<>])}{E<$map{$1}>}g;
48 12         130 $txt;
49             }
50              
51             sub munge_file
52             {
53 4     4 0 6508 my($self, $file) = @_;
54              
55 4 50       165 $self->log_fatal('requires at least current')
56             unless $self->current;
57              
58             my $replacer = sub {
59 4     4   8 my @list;
60 4         14 push @list, '=head1 AUTHOR', '';
61 4 100       169 if($self->original)
62             {
63 2         77 push @list, 'Original author: ' . _escape $self->original,
64             '',
65             'Current maintainer: ' . _escape $self->current,
66             '';
67             }
68             else
69             {
70 2         76 push @list, 'Author: ' . _escape $self->current,
71             '';
72             }
73 4 100       159 if($self->contributor->@* > 0)
74             {
75 2         77 push @list, 'Contributors:', '', map { (_escape $_, '') } $self->contributor->@*;
  6         11  
76             }
77 4         49 return join "\n", @list, '';
78 4         30 };
79              
80 4         22 my $content = $file->content;
81 4 50       3997 unless($content =~ s{^=head1 AUTHOR.*(=head1 COPYRIGHT)}{$replacer->() . $1}sem)
  4         15  
82             {
83 0         0 $self->log_fatal('could not replace AUTHOR section');
84             }
85 4         23 $file->content($content);
86              
87 4         1168 return;
88             }
89              
90             sub metadata
91             {
92 4     4 0 32253 my ($self) = @_;
93              
94 4         178 my @contributors = $self->contributor->@*;
95 4 50       163 unshift @contributors, $self->current if $self->current;
96 4 100       150 unshift @contributors, $self->original if $self->original;
97              
98 4         31 return +{ x_contributors => \@contributors };
99             }
100              
101             __PACKAGE__->meta->make_immutable;
102              
103             }
104              
105             1;
106              
107             __END__
108              
109             =pod
110              
111             =encoding UTF-8
112              
113             =head1 NAME
114              
115             Dist::Zilla::Plugin::Author::Plicease::Thanks - munge the AUTHOR section
116              
117             =head1 VERSION
118              
119             version 2.74
120              
121             =head1 SYNOPSIS
122              
123             [Author::Plicease::Thanks]
124             original = Original Author
125             current = Current Maintainer
126             contributor = Contributor One
127             contributor = Contributor Two
128              
129             =head1 SEE ALSO
130              
131             =over 4
132              
133             =item L<Dist::Zilla>
134              
135             =item L<Dist::Zilla::PluginBundle::Author::Plicease>
136              
137             =back
138              
139             =head1 AUTHOR
140              
141             Graham Ollis <plicease@cpan.org>
142              
143             =head1 COPYRIGHT AND LICENSE
144              
145             This software is copyright (c) 2012-2022 by Graham Ollis.
146              
147             This is free software; you can redistribute it and/or modify it under
148             the same terms as the Perl 5 programming language system itself.
149              
150             =cut