File Coverage

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