File Coverage

blib/lib/Dist/Zilla/Plugin/Author/Plicease/ReadmeAnyFromPod.pm
Criterion Covered Total %
statement 23 24 95.8
branch n/a
condition n/a
subroutine 8 9 88.8
pod 0 1 0.0
total 31 34 91.1


line stmt bran cond sub pod time code
1             package Dist::Zilla::Plugin::Author::Plicease::ReadmeAnyFromPod 2.75 {
2              
3 1     1   1436 use 5.020;
  1         6  
4 1     1   7 use Moose;
  1         3  
  1         8  
5 1     1   7184 use experimental qw( signatures );
  1         3  
  1         8  
6 1     1   723 use URI::Escape ();
  1         1643  
  1         35  
7 1     1   8 use File::Which ();
  1         3  
  1         22  
8 1     1   513 use Ref::Util qw( is_plain_hashref );
  1         1744  
  1         84  
9 1     1   9 use experimental qw( postderef );
  1         3  
  1         6  
10              
11             # ABSTRACT: Personal subclass of Dist::Zilla::Plugin::ReadmeAnyFromPod
12              
13              
14             extends 'Dist::Zilla::Plugin::ReadmeAnyFromPod';
15              
16             around BUILDARGS => sub {
17             my $orig = shift;
18             my $class = shift;
19              
20             my %args = @_ == 1 && is_plain_hashref($_[0]) ? $_[0]->%* : @_;
21             foreach my $key (keys %args)
22             {
23             die "removed key: $key"
24             if $key =~ /^(travis_.*|appveyor_user|appveyor)$/;
25             }
26              
27             return $class->$orig(@_);
28             };
29              
30             has github_user => (
31             is => 'ro',
32             default => 'plicease',
33             );
34              
35             has github_repo => (
36             is => 'ro',
37             lazy => 1,
38             default => sub ($self) {
39             $self->zilla->name
40             },
41             );
42              
43             has workflow => (
44             is => 'ro',
45             isa => 'ArrayRef[Str]',
46             default => sub { [] },
47             );
48              
49             has default_branch => (
50             is => 'ro',
51             lazy => 1,
52             default => sub ($self) {
53             if(File::Which::which('git'))
54             {
55             my %b = map { $_ => 1 }
56             map { s/\s$//r }
57             map { s/^\*?\s*//r }
58             `git branch`;
59             if($b{main} && $b{master})
60             {
61             $self->log("!! You have both a main and master branch, please switch to just a main branch (or explicitly set default_branch) !!");
62             return 'main';
63             }
64             elsif($b{main})
65             {
66             $self->log("deteching main as default branch");
67             return 'main';
68             }
69             elsif($b{master})
70             {
71             $self->log("!! Please switch to using main as the main branch (or explicitly set default_branch) !!");
72             return 'master';
73             }
74             else
75             {
76             $self->log("!! cannot find either a main or master branch please create one or explicitly set default_branch !!");
77             return 'main';
78             }
79             }
80             $self->log("unable to detect default branch assuming main");
81             return 'main'; # may need to update the repo
82             },
83             );
84              
85 0     0 0   sub mvp_multivalue_args { qw( workflow ) }
86              
87             around get_readme_content => sub {
88             my $orig = shift;
89             my $self = shift;
90              
91             my $content = do {
92 1     1   783 no warnings 'redefine';
  1         3  
  1         385  
93              
94             # The super class at some point changes its behavior to escape URLs
95             # so that IPv6 addresses could be properly used in markdown.
96             # Unfortunately this also meant that class names with :: also got
97             # escaped making them hard to read. Since I never use literal IPv6
98             # addresses in URLs and I do very often have links to Perl
99             # documentation with :: that was not a useful change.
100             local *URI::Escape::uri_escape = sub {
101             my($uri) = @_;
102             $uri;
103             };
104              
105             $self->$orig(@_);
106             };
107              
108             return $content unless $self->type eq 'gfm';
109              
110             my $status = '';
111              
112             foreach my $workflow ($self->workflow->@*)
113             {
114             $status .= " ![$workflow](https://github.com/@{[ $self->github_user ]}/@{[ $self->github_repo ]}/workflows/$workflow/badge.svg)";
115             }
116              
117             $content =~ s{# NAME\s+(.*?) - (.*?#)}{# $1$status\n\n$2}s;
118             $content =~ s{# VERSION\s+version (\d+\.|)\d+\.\d+(\\_\d+|)\s+#}{#}a;
119             return $content;
120             };
121              
122             __PACKAGE__->meta->make_immutable;
123             }
124              
125             1;
126              
127             __END__
128              
129             =pod
130              
131             =encoding UTF-8
132              
133             =head1 NAME
134              
135             Dist::Zilla::Plugin::Author::Plicease::ReadmeAnyFromPod - Personal subclass of Dist::Zilla::Plugin::ReadmeAnyFromPod
136              
137             =head1 VERSION
138              
139             version 2.75
140              
141             =head1 SYNOPSIS
142              
143             [Author::Plicease::ReadmeAnyFromPod]
144              
145             =head1 SEE ALSO
146              
147             =over 4
148              
149             =item L<Dist::Zilla>
150              
151             =item L<Dist::Zilla::PluginBundle::Author::Plicease>
152              
153             =back
154              
155             =head1 AUTHOR
156              
157             Graham Ollis <plicease@cpan.org>
158              
159             =head1 COPYRIGHT AND LICENSE
160              
161             This software is copyright (c) 2012-2022 by Graham Ollis.
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