File Coverage

blib/lib/Dist/Inktly/Minty.pm
Criterion Covered Total %
statement 26 116 22.4
branch 0 20 0.0
condition 0 20 0.0
subroutine 9 22 40.9
pod 7 8 87.5
total 42 186 22.5


line stmt bran cond sub pod time code
1 1     1   764 use 5.010001;
  1         4  
2 1     1   6 use strict;
  1         2  
  1         19  
3 1     1   5 use warnings;
  1         2  
  1         52  
4              
5             package Dist::Inktly::Minty;
6              
7             our $AUTHORITY = 'cpan:TOBYINK';
8             our $VERSION = '0.003';
9              
10 1     1   6 use Carp;
  1         2  
  1         76  
11 1     1   461 use File::chdir;
  1         2992  
  1         106  
12 1     1   825 use Path::Tiny 'path';
  1         11940  
  1         65  
13 1     1   536 use Software::License;
  1         33845  
  1         38  
14 1     1   9 use Text::Template;
  1         2  
  1         53  
15 1     1   512 use URI::Escape qw[];
  1         1481  
  1         1425  
16              
17             {
18             my %templates;
19             my $key = undef;
20             while (my $line = )
21             {
22             if ($line =~ /^COMMENCE\s+(.+)\s*$/)
23             {
24             $key = $1;
25             }
26             elsif (defined $key)
27             {
28             $templates{$key} .= $line;
29             }
30             }
31             sub _has_template
32             {
33 0     0     my $class = shift;
34 0           my ($key) = @_;
35 0           exists $templates{$key};
36             }
37             sub _get_template
38             {
39 0     0     my $class = shift;
40 0           my ($key) = @_;
41 0           'Text::Template'->new(-type=>'string', -source=>$templates{$key});
42             }
43             sub _get_template_names
44             {
45 0     0     my $class = shift;
46 0           return keys %templates;
47             }
48             }
49              
50             sub _fill_in_template
51             {
52 0     0     my $self = shift;
53 0           my ($template) = @_;
54 0 0         $template = $self->_get_template($template) unless ref $template;
55            
56 0           my %hash = ();
57 0           while (my ($k, $v) = each %$self)
58             {
59 0 0         $hash{$k} = ref $v ? \$v : $v;
60             }
61            
62 0           $template->fill_in(-hash => \%hash);
63             }
64              
65             sub _file
66             {
67 0     0     my $self = shift;
68             my $file = path(
69             $self->{destination},
70 0           sprintf('p5-%s', lc($self->{dist_name}))
71             )->child($_[0]);
72 0           $file->parent->mkpath;
73 0           return $file;
74             }
75              
76             sub create
77             {
78 0     0 1   my $class = shift;
79 0           my ($name, %options) = @_;
80            
81 0           $options{module_name} = $name;
82 0           $options{dist_name} = $name;
83            
84 0 0         if ($name =~ /::/)
    0          
85             {
86 0           $options{dist_name} =~ s/::/-/g;
87             }
88             elsif ($name =~ /\-/)
89             {
90 0           $options{module_name} =~ s/\-/::/g;
91             }
92            
93 0           my $self = bless \%options, $class;
94 0           $self->set_defaults;
95 0           $self->create_module;
96 0           $self->create_dist_ini;
97 0           $self->create_metadata;
98 0           $self->create_tests;
99 0           $self->create_author_tests;
100 0           $self->run_then;
101 0           return $self;
102             }
103              
104             sub set_defaults
105             {
106 0     0 1   my $self = shift;
107            
108 0 0         croak "Need an author name." unless defined $self->{author}{name};
109 0 0         croak "Need an author cpanid." unless defined $self->{author}{cpanid};
110            
111 0           $self->{author}{cpanid} = lc $self->{author}{cpanid};
112 0   0       $self->{author}{mbox} ||= sprintf('%s@cpan.org', $self->{author}{cpanid});
113              
114             $self->{backpan} ||= sprintf('http://backpan.cpan.org/authors/id/%s/%s/%s/',
115             substr(uc $self->{author}{cpanid}, 0, 1),
116             substr(uc $self->{author}{cpanid}, 0, 2),
117             uc $self->{author}{cpanid},
118 0   0       );
119            
120 0   0       $self->{abstract} ||= 'a module that does something-or-other';
121 0   0       $self->{version} ||= '0.001';
122 0           $self->{version_ident} = 'v_'.$self->{version};
123 0           $self->{version_ident} =~ s/\./-/g;
124 0   0       $self->{destination} ||= './';
125            
126 0 0         unless ($self->{module_filename})
127             {
128 0           $self->{module_filename} = 'lib::'.$self->{module_name};
129 0           $self->{module_filename} =~ s/::/\//g;
130 0           $self->{module_filename} .= '.pm';
131             }
132            
133 0 0         unless ($self->{unit_test_filename})
134             {
135 0           $self->{unit_test_filename} = $self->{module_filename};
136 0           $self->{unit_test_filename} =~ s/\.pm$/\.t/;
137 0           $self->{unit_test_filename} =~ s/lib/t\/unit/;
138             }
139            
140 0   0       $self->{copyright}{holder} ||= $self->{author}{name};
141 0   0       $self->{copyright}{year} ||= 1900 + [localtime]->[5];
142            
143 0   0       $self->{licence_class} ||= 'Software::License::Perl_5';
144 0           eval sprintf('use %s;', $self->{licence_class});
145             $self->{licence} = $self->{licence_class}->new({
146             year => $self->{copyright}{year},
147             holder => $self->{copyright}{holder},
148 0           });
149             }
150              
151             sub create_module
152             {
153 0     0 1   my $self = shift;
154 0           $self->_file( $self->{module_filename} )->spew( $self->_fill_in_template('module') );
155 0           return;
156             }
157              
158             sub create_dist_ini
159             {
160 0     0 1   my $self = shift;
161 0           $self->_file('dist.ini')->spew($self->_fill_in_template('dist.ini'));
162 0           return;
163             }
164              
165             sub create_metadata
166             {
167 0     0 1   my $self = shift;
168             $self->_file($_)->spew($self->_fill_in_template($_))
169 0           for grep { m#^meta/# } $self->_get_template_names;
  0            
170 0           return;
171             }
172              
173             sub create_tests
174             {
175 0     0 1   my $self = shift;
176             $self->_file($_)->spew($self->_fill_in_template($_))
177 0           for grep { m#^t/# } $self->_get_template_names;
  0            
178 0           mkdir( $self->_file('t/unit') );
179 0           mkdir( $self->_file('t/integration') );
180 0           $self->_file( $self->{unit_test_filename} )->spew( $self->_fill_in_template('unit-test') );
181 0           return;
182             }
183              
184             sub create_author_tests
185             {
186 0     0 1   my $self = shift;
187            
188             $self->_file($_)->spew($self->_fill_in_template($_))
189 0           for grep { m#^xt/# } $self->_get_template_names;
  0            
190            
191 0           my $xtdir = path("~/perl5/xt");
192 0 0         if ( $xtdir->exists ) {
193             $self->_file("xt/" . $_->relative($xtdir))->spew(scalar $_->slurp)
194 0           for grep { $_ =~ /\.t$/ } $xtdir->children;
  0            
195             }
196            
197 0           return;
198             }
199              
200             sub run_then {
201 0     0 0   my $self = shift;
202 0 0         ref $self->{then} or return;
203             my $dir = path(
204             $self->{destination},
205 0           sprintf('p5-%s', lc($self->{dist_name})),
206             );
207 0           local $CWD = "$dir";
208 0           system($_) for @{ $self->{then} };
  0            
209             }
210              
211             1;
212              
213             =head1 NAME
214              
215             Dist::Inktly::Minty - create distributions that will use Dist::Inkt
216              
217             =head1 SYNOPSIS
218              
219             distinkt-mint Local::Example::Useful
220              
221             =head1 STATUS
222              
223             Experimental.
224              
225             =head1 DESCRIPTION
226              
227             Sets up a new distribution in the style TOBYINK likes.
228              
229             This package provides just one (class) method:
230              
231             =over
232              
233             =item C<< Dist::Inktly::Minty->create($distname, %options) >>
234              
235             Create a distribution directory including all needed files.
236              
237             =back
238              
239             There are various methods that may be useful for people subclassing this
240             class to look at (and possibly override).
241              
242             =over
243              
244             =item C<< set_defaults >>
245              
246             =item C<< create_module >>
247              
248             =item C<< create_dist_ini >>
249              
250             =item C<< create_metadata >>
251              
252             =item C<< create_tests >>
253              
254             =item C<< create_author_tests >>
255              
256             =back
257              
258             =head1 SEE ALSO
259              
260             L.
261              
262             =head1 AUTHOR
263              
264             Toby Inkster Etobyink@cpan.orgE.
265              
266             =head1 COPYRIGHT AND LICENCE
267              
268             This software is copyright (c) 2013-2022 by Toby Inkster.
269              
270             This is free software; you can redistribute it and/or modify it under
271             the same terms as the Perl 5 programming language system itself.
272              
273             =head1 DISCLAIMER OF WARRANTIES
274              
275             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
276             WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
277             MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
278              
279             =cut
280              
281             __DATA__