line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Dist::Man::Simple; |
2
|
|
|
|
|
|
|
# vi:et:sw=4 ts=4 |
3
|
|
|
|
|
|
|
|
4
|
4
|
|
|
4
|
|
28603
|
use strict; |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
132
|
|
5
|
4
|
|
|
4
|
|
21
|
use warnings; |
|
4
|
|
|
|
|
13
|
|
|
4
|
|
|
|
|
520
|
|
6
|
|
|
|
|
|
|
|
7
|
4
|
|
|
4
|
|
19360
|
use ExtUtils::Command qw( rm_rf mkpath touch ); |
|
4
|
|
|
|
|
67151
|
|
|
4
|
|
|
|
|
358
|
|
8
|
4
|
|
|
4
|
|
38
|
use File::Spec (); |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
402
|
|
9
|
4
|
|
|
4
|
|
24
|
use Carp qw( carp confess croak ); |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
238
|
|
10
|
|
|
|
|
|
|
|
11
|
4
|
|
|
4
|
|
2842
|
use Dist::Man::BuilderSet; |
|
4
|
|
|
|
|
25
|
|
|
4
|
|
|
|
|
13426
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
=head1 NAME |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
Dist::Man::Simple - a simple, comprehensive Dist::Man plugin |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 VERSION |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
Version 0.0.6 |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=cut |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
our $VERSION = '0.0.7'; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head1 SYNOPSIS |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
use Dist::Man qw(Dist::Man::Simple); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
Dist::Man->create_distro(%args); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=head1 DESCRIPTION |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
Dist::Man::Simple is a plugin for Dist::Man that will perform all |
34
|
|
|
|
|
|
|
the work needed to create a distribution. Given the parameters detailed in |
35
|
|
|
|
|
|
|
L, it will create content, create directories, and populate |
36
|
|
|
|
|
|
|
the directories with the required files. |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
=head1 CLASS METHODS |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=head2 C<< create_distro(%args) >> |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
This method works as advertised in L. |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
=cut |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
sub create_distro { |
47
|
8
|
|
|
8
|
1
|
193771
|
my $class = shift; |
48
|
|
|
|
|
|
|
|
49
|
8
|
|
|
|
|
42
|
my $self = $class->new( @_ ); |
50
|
|
|
|
|
|
|
|
51
|
8
|
|
50
|
|
|
51
|
my $modules = $self->{modules} || []; |
52
|
8
|
|
|
|
|
20
|
my @modules = map { split /,/ } @{$modules}; |
|
27
|
|
|
|
|
69
|
|
|
8
|
|
|
|
|
24
|
|
53
|
8
|
50
|
|
|
|
30
|
croak "No modules specified.\n" unless @modules; |
54
|
8
|
|
|
|
|
18
|
for (@modules) { |
55
|
27
|
50
|
|
|
|
149
|
croak "Invalid module name: $_" unless /\A[a-z_]\w*(?:::[\w]+)*\Z/i; |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
|
58
|
8
|
50
|
|
|
|
34
|
croak "Must specify an author\n" unless $self->{author}; |
59
|
8
|
50
|
|
|
|
33
|
croak "Must specify an email address\n" unless $self->{email}; |
60
|
8
|
|
|
|
|
49
|
($self->{email_obfuscated} = $self->{email}) =~ s/@/ at /; |
61
|
|
|
|
|
|
|
|
62
|
8
|
|
50
|
|
|
26
|
$self->{license} ||= 'perl'; |
63
|
|
|
|
|
|
|
|
64
|
8
|
|
|
|
|
20
|
$self->{main_module} = $modules[0]; |
65
|
8
|
50
|
|
|
|
24
|
if ( not $self->{distro} ) { |
66
|
0
|
|
|
|
|
0
|
$self->{distro} = $self->{main_module}; |
67
|
0
|
|
|
|
|
0
|
$self->{distro} =~ s/::/-/g; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
8
|
|
33
|
|
|
33
|
$self->{basedir} = $self->{dir} || $self->{distro}; |
71
|
8
|
|
|
|
|
34
|
$self->create_basedir; |
72
|
|
|
|
|
|
|
|
73
|
8
|
|
|
|
|
14
|
my @files; |
74
|
8
|
|
|
|
|
50
|
push @files, $self->create_modules( @modules ); |
75
|
|
|
|
|
|
|
|
76
|
8
|
|
|
|
|
40
|
push @files, $self->create_t( @modules ); |
77
|
8
|
|
|
|
|
34
|
push @files, $self->create_ignores; |
78
|
8
|
|
|
|
|
34
|
my %build_results = $self->create_build(); |
79
|
8
|
|
|
|
|
15
|
push(@files, @{ $build_results{files} } ); |
|
8
|
|
|
|
|
20
|
|
80
|
|
|
|
|
|
|
|
81
|
8
|
|
|
|
|
34
|
push @files, $self->create_Changes; |
82
|
8
|
|
|
|
|
34
|
push @files, $self->create_README( $build_results{instructions} ); |
83
|
8
|
|
|
|
|
19
|
push @files, 'MANIFEST'; |
84
|
8
|
|
|
|
|
13
|
$self->create_MANIFEST( grep { $_ ne 't/boilerplate.t' } @files ); |
|
91
|
|
|
|
|
170
|
|
85
|
|
|
|
|
|
|
|
86
|
8
|
|
|
|
|
94
|
return; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=head2 C<< new(%args) >> |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
This method is called to construct and initialize a new Dist::Man object. |
92
|
|
|
|
|
|
|
It is never called by the end user, only internally by C, which |
93
|
|
|
|
|
|
|
creates ephemeral Dist::Man objects. It's documented only to call it to |
94
|
|
|
|
|
|
|
the attention of subclass authors. |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=cut |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub new { |
99
|
8
|
|
|
8
|
1
|
14
|
my $class = shift; |
100
|
8
|
|
|
|
|
87
|
return bless { @_ } => $class; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=head1 OBJECT METHODS |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
All the methods documented below are object methods, meant to be called |
106
|
|
|
|
|
|
|
internally by the ephemperal objects created during the execution of the class |
107
|
|
|
|
|
|
|
method C above. |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=head2 create_basedir |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
Creates the base directory for the distribution. If the directory already |
112
|
|
|
|
|
|
|
exists, and I<$force> is true, then the existing directory will get erased. |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
If the directory can't be created, or re-created, it dies. |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=cut |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub create_basedir { |
119
|
8
|
|
|
8
|
1
|
16
|
my $self = shift; |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
# Make sure there's no directory |
122
|
8
|
50
|
|
|
|
190
|
if ( -e $self->{basedir} ) { |
123
|
0
|
0
|
|
|
|
0
|
die( "$self->{basedir} already exists. ". |
124
|
|
|
|
|
|
|
"Use --force if you want to stomp on it.\n" |
125
|
|
|
|
|
|
|
) unless $self->{force}; |
126
|
|
|
|
|
|
|
|
127
|
0
|
|
|
|
|
0
|
local @ARGV = $self->{basedir}; |
128
|
0
|
|
|
|
|
0
|
rm_rf(); |
129
|
|
|
|
|
|
|
|
130
|
0
|
0
|
|
|
|
0
|
die "Couldn't delete existing $self->{basedir}: $!\n" |
131
|
|
|
|
|
|
|
if -e $self->{basedir}; |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
CREATE_IT: { |
135
|
8
|
|
|
|
|
13
|
$self->progress( "Created $self->{basedir}" ); |
|
8
|
|
|
|
|
46
|
|
136
|
|
|
|
|
|
|
|
137
|
8
|
|
|
|
|
30
|
local @ARGV = $self->{basedir}; |
138
|
8
|
|
|
|
|
73
|
mkpath(); |
139
|
|
|
|
|
|
|
|
140
|
8
|
50
|
|
|
|
1700
|
die "Couldn't create $self->{basedir}: $!\n" unless -d $self->{basedir}; |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
8
|
|
|
|
|
29
|
return; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=head2 create_modules( @modules ) |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
This method will create a starter module file for each module named in |
149
|
|
|
|
|
|
|
I<@modules>. |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=cut |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
sub create_modules { |
154
|
8
|
|
|
8
|
1
|
16
|
my $self = shift; |
155
|
8
|
|
|
|
|
21
|
my @modules = @_; |
156
|
|
|
|
|
|
|
|
157
|
8
|
|
|
|
|
12
|
my @files; |
158
|
|
|
|
|
|
|
|
159
|
8
|
|
|
|
|
20
|
for my $module ( @modules ) { |
160
|
27
|
|
|
|
|
51
|
my $rtname = lc $module; |
161
|
27
|
|
|
|
|
102
|
$rtname =~ s/::/-/g; |
162
|
27
|
|
|
|
|
77
|
push @files, $self->_create_module( $module, $rtname ); |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
8
|
|
|
|
|
30
|
return @files; |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=head2 module_guts( $module, $rtname ) |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
This method returns the text which should serve as the contents for the named |
171
|
|
|
|
|
|
|
module. I<$rtname> is the email suffix which rt.cpan.org will use for bug |
172
|
|
|
|
|
|
|
reports. (This should, and will, be moved out of the parameters for this |
173
|
|
|
|
|
|
|
method eventually.) |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=cut |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
sub _get_licenses_mapping { |
178
|
35
|
|
|
35
|
|
39
|
my $self = shift; |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
return |
181
|
|
|
|
|
|
|
[ |
182
|
|
|
|
|
|
|
{ |
183
|
35
|
|
|
|
|
149
|
license => 'perl', |
184
|
|
|
|
|
|
|
blurb => <<'EOT', |
185
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
186
|
|
|
|
|
|
|
under the terms of either: the GNU General Public License as published |
187
|
|
|
|
|
|
|
by the Free Software Foundation; or the Artistic License. |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
See http://dev.perl.org/licenses/ for more information. |
190
|
|
|
|
|
|
|
EOT |
191
|
|
|
|
|
|
|
}, |
192
|
|
|
|
|
|
|
{ |
193
|
|
|
|
|
|
|
license => 'mit', |
194
|
|
|
|
|
|
|
blurb => <<'EOT', |
195
|
|
|
|
|
|
|
This program is distributed under the MIT (X11) License: |
196
|
|
|
|
|
|
|
L |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
Permission is hereby granted, free of charge, to any person |
199
|
|
|
|
|
|
|
obtaining a copy of this software and associated documentation |
200
|
|
|
|
|
|
|
files (the "Software"), to deal in the Software without |
201
|
|
|
|
|
|
|
restriction, including without limitation the rights to use, |
202
|
|
|
|
|
|
|
copy, modify, merge, publish, distribute, sublicense, and/or sell |
203
|
|
|
|
|
|
|
copies of the Software, and to permit persons to whom the |
204
|
|
|
|
|
|
|
Software is furnished to do so, subject to the following |
205
|
|
|
|
|
|
|
conditions: |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
The above copyright notice and this permission notice shall be |
208
|
|
|
|
|
|
|
included in all copies or substantial portions of the Software. |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, |
211
|
|
|
|
|
|
|
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES |
212
|
|
|
|
|
|
|
OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND |
213
|
|
|
|
|
|
|
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT |
214
|
|
|
|
|
|
|
HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, |
215
|
|
|
|
|
|
|
WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING |
216
|
|
|
|
|
|
|
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR |
217
|
|
|
|
|
|
|
OTHER DEALINGS IN THE SOFTWARE. |
218
|
|
|
|
|
|
|
EOT |
219
|
|
|
|
|
|
|
}, |
220
|
|
|
|
|
|
|
{ |
221
|
|
|
|
|
|
|
license => 'bsd', |
222
|
|
|
|
|
|
|
blurb => <<"EOT", |
223
|
|
|
|
|
|
|
This program is distributed under the (Revised) BSD License: |
224
|
|
|
|
|
|
|
L |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
Redistribution and use in source and binary forms, with or without |
227
|
|
|
|
|
|
|
modification, are permitted provided that the following conditions |
228
|
|
|
|
|
|
|
are met: |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
* Redistributions of source code must retain the above copyright |
231
|
|
|
|
|
|
|
notice, this list of conditions and the following disclaimer. |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
* Redistributions in binary form must reproduce the above copyright |
234
|
|
|
|
|
|
|
notice, this list of conditions and the following disclaimer in the |
235
|
|
|
|
|
|
|
documentation and/or other materials provided with the distribution. |
236
|
|
|
|
|
|
|
|
237
|
35
|
|
|
|
|
351
|
* Neither the name of @{[$self->{author}]}'s Organization |
238
|
|
|
|
|
|
|
nor the names of its contributors may be used to endorse or promote |
239
|
|
|
|
|
|
|
products derived from this software without specific prior written |
240
|
|
|
|
|
|
|
permission. |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS |
243
|
|
|
|
|
|
|
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT |
244
|
|
|
|
|
|
|
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR |
245
|
|
|
|
|
|
|
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT |
246
|
|
|
|
|
|
|
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, |
247
|
|
|
|
|
|
|
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT |
248
|
|
|
|
|
|
|
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, |
249
|
|
|
|
|
|
|
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY |
250
|
|
|
|
|
|
|
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT |
251
|
|
|
|
|
|
|
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE |
252
|
|
|
|
|
|
|
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
253
|
|
|
|
|
|
|
EOT |
254
|
|
|
|
|
|
|
}, |
255
|
|
|
|
|
|
|
{ |
256
|
|
|
|
|
|
|
license => 'gpl', |
257
|
|
|
|
|
|
|
blurb => <<'EOT', |
258
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify |
259
|
|
|
|
|
|
|
it under the terms of the GNU General Public License as published by |
260
|
|
|
|
|
|
|
the Free Software Foundation; version 2 dated June, 1991 or at your option |
261
|
|
|
|
|
|
|
any later version. |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful, |
264
|
|
|
|
|
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of |
265
|
|
|
|
|
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
266
|
|
|
|
|
|
|
GNU General Public License for more details. |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
A copy of the GNU General Public License is available in the source tree; |
269
|
|
|
|
|
|
|
if not, write to the Free Software Foundation, Inc., |
270
|
|
|
|
|
|
|
59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
271
|
|
|
|
|
|
|
EOT |
272
|
|
|
|
|
|
|
}, |
273
|
|
|
|
|
|
|
{ |
274
|
|
|
|
|
|
|
license => 'lgpl', |
275
|
|
|
|
|
|
|
blurb => <<'EOT', |
276
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or |
277
|
|
|
|
|
|
|
modify it under the terms of the GNU Lesser General Public |
278
|
|
|
|
|
|
|
License as published by the Free Software Foundation; either |
279
|
|
|
|
|
|
|
version 2.1 of the License, or (at your option) any later version. |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful, |
282
|
|
|
|
|
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of |
283
|
|
|
|
|
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
284
|
|
|
|
|
|
|
Lesser General Public License for more details. |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
You should have received a copy of the GNU Lesser General Public |
287
|
|
|
|
|
|
|
License along with this program; if not, write to the Free |
288
|
|
|
|
|
|
|
Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA |
289
|
|
|
|
|
|
|
02111-1307 USA. |
290
|
|
|
|
|
|
|
EOT |
291
|
|
|
|
|
|
|
}, |
292
|
|
|
|
|
|
|
]; |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
sub _license_record { |
296
|
35
|
|
|
35
|
|
35
|
my $self = shift; |
297
|
|
|
|
|
|
|
|
298
|
35
|
|
|
|
|
43
|
foreach my $record (@{$self->_get_licenses_mapping()}) { |
|
35
|
|
|
|
|
69
|
|
299
|
87
|
100
|
|
|
|
204
|
if ($record->{license} eq $self->{license}) { |
300
|
35
|
|
|
|
|
70
|
return $record; |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
|
304
|
0
|
|
|
|
|
0
|
return; |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
sub _license_blurb { |
308
|
35
|
|
|
35
|
|
40
|
my $self = shift; |
309
|
|
|
|
|
|
|
|
310
|
35
|
|
|
|
|
69
|
my $record = $self->_license_record(); |
311
|
|
|
|
|
|
|
|
312
|
35
|
|
|
|
|
135
|
my $license_blurb; |
313
|
35
|
50
|
|
|
|
67
|
if (defined($record)) { |
314
|
35
|
|
|
|
|
56
|
$license_blurb = $record->{blurb}; |
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
else { |
317
|
0
|
|
|
|
|
0
|
$license_blurb = <<"EOT"; |
318
|
|
|
|
|
|
|
This program is released under the following license: $self->{license} |
319
|
|
|
|
|
|
|
EOT |
320
|
|
|
|
|
|
|
} |
321
|
35
|
|
|
|
|
78
|
chomp $license_blurb; |
322
|
35
|
|
|
|
|
101
|
return $license_blurb; |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
# _create_module: used by create_modules to build each file and put data in it |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
sub _create_module { |
328
|
27
|
|
|
27
|
|
37
|
my $self = shift; |
329
|
27
|
|
|
|
|
37
|
my $module = shift; |
330
|
27
|
|
|
|
|
32
|
my $rtname = shift; |
331
|
|
|
|
|
|
|
|
332
|
27
|
|
|
|
|
94
|
my @parts = split( /::/, $module ); |
333
|
27
|
|
|
|
|
52
|
my $filepart = (pop @parts) . '.pm'; |
334
|
27
|
|
|
|
|
82
|
my @dirparts = ( $self->{basedir}, 'lib', @parts ); |
335
|
27
|
|
|
|
|
32
|
my $SLASH = q{/}; |
336
|
27
|
|
|
|
|
63
|
my $manifest_file = join( $SLASH, 'lib', @parts, $filepart ); |
337
|
27
|
50
|
|
|
|
66
|
if ( @dirparts ) { |
338
|
27
|
|
|
|
|
215
|
my $dir = File::Spec->catdir( @dirparts ); |
339
|
27
|
100
|
|
|
|
553
|
if ( not -d $dir ) { |
340
|
21
|
|
|
|
|
54
|
local @ARGV = $dir; |
341
|
21
|
|
|
|
|
79
|
mkpath @ARGV; |
342
|
21
|
|
|
|
|
4477
|
$self->progress( "Created $dir" ); |
343
|
|
|
|
|
|
|
} |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
|
346
|
27
|
|
|
|
|
260
|
my $module_file = File::Spec->catfile( @dirparts, $filepart ); |
347
|
|
|
|
|
|
|
|
348
|
27
|
|
|
|
|
253
|
$self->{module_file}{$module} = File::Spec->catfile('lib', @parts, $filepart); |
349
|
27
|
|
|
|
|
107
|
$self->create_file( $module_file, $self->module_guts( $module, $rtname ) ); |
350
|
27
|
|
|
|
|
108
|
$self->progress( "Created $module_file" ); |
351
|
|
|
|
|
|
|
|
352
|
27
|
|
|
|
|
115
|
return $manifest_file; |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
sub _thisyear { |
356
|
35
|
|
|
35
|
|
1046
|
return (localtime())[5] + 1900; |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
sub _module_to_pm_file { |
360
|
35
|
|
|
35
|
|
41
|
my $self = shift; |
361
|
35
|
|
|
|
|
42
|
my $module = shift; |
362
|
|
|
|
|
|
|
|
363
|
35
|
|
|
|
|
98
|
my @parts = split( /::/, $module ); |
364
|
35
|
|
|
|
|
54
|
my $pm = pop @parts; |
365
|
35
|
|
|
|
|
281
|
my $pm_file = File::Spec->catfile( 'lib', @parts, "${pm}.pm" ); |
366
|
35
|
|
|
|
|
79
|
$pm_file =~ s{\\}{/}g; # even on Win32, use forward slash |
367
|
|
|
|
|
|
|
|
368
|
35
|
|
|
|
|
153
|
return $pm_file; |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
sub _reference_links { |
372
|
|
|
|
|
|
|
return ( |
373
|
35
|
|
|
35
|
|
262
|
{ nickname => 'RT', |
374
|
|
|
|
|
|
|
title => 'CPAN\'s request tracker', |
375
|
|
|
|
|
|
|
link => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=%s', |
376
|
|
|
|
|
|
|
}, |
377
|
|
|
|
|
|
|
{ nickname => 'AnnoCPAN', |
378
|
|
|
|
|
|
|
title => 'Annotated CPAN documentation', |
379
|
|
|
|
|
|
|
link => 'http://annocpan.org/dist/%s', |
380
|
|
|
|
|
|
|
}, |
381
|
|
|
|
|
|
|
{ title => 'CPAN Ratings', |
382
|
|
|
|
|
|
|
link => 'http://cpanratings.perl.org/d/%s', |
383
|
|
|
|
|
|
|
}, |
384
|
|
|
|
|
|
|
{ title => 'Search CPAN', |
385
|
|
|
|
|
|
|
link => 'http://search.cpan.org/dist/%s/', |
386
|
|
|
|
|
|
|
}, |
387
|
|
|
|
|
|
|
); |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
=head2 create_Makefile_PL( $main_module ) |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
This will create the Makefile.PL for the distribution, and will use the module |
393
|
|
|
|
|
|
|
named in I<$main_module> as the main module of the distribution. |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
=cut |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
sub create_Makefile_PL { |
398
|
3
|
|
|
3
|
1
|
6
|
my $self = shift; |
399
|
3
|
|
|
|
|
5
|
my $main_module = shift; |
400
|
3
|
|
|
|
|
7
|
my $builder_name = 'ExtUtils::MakeMaker'; |
401
|
3
|
|
|
|
|
11
|
my $output_file = |
402
|
|
|
|
|
|
|
Dist::Man::BuilderSet->new()->file_for_builder($builder_name); |
403
|
3
|
|
|
|
|
46
|
my $fname = File::Spec->catfile( $self->{basedir}, $output_file ); |
404
|
|
|
|
|
|
|
|
405
|
3
|
|
|
|
|
11
|
$self->create_file( |
406
|
|
|
|
|
|
|
$fname, |
407
|
|
|
|
|
|
|
$self->Makefile_PL_guts( |
408
|
|
|
|
|
|
|
$main_module, |
409
|
|
|
|
|
|
|
$self->_module_to_pm_file($main_module), |
410
|
|
|
|
|
|
|
), |
411
|
|
|
|
|
|
|
); |
412
|
|
|
|
|
|
|
|
413
|
3
|
|
|
|
|
14
|
$self->progress( "Created $fname" ); |
414
|
|
|
|
|
|
|
|
415
|
3
|
|
|
|
|
10
|
return $output_file; |
416
|
|
|
|
|
|
|
} |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
=head2 create_MI_Makefile_PL( $main_module ) |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
This will create a Module::Install Makefile.PL for the distribution, and will |
421
|
|
|
|
|
|
|
use the module named in I<$main_module> as the main module of the distribution. |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
=cut |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
sub create_MI_Makefile_PL { |
426
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
427
|
0
|
|
|
|
|
0
|
my $main_module = shift; |
428
|
0
|
|
|
|
|
0
|
my $builder_name = 'Module::Install'; |
429
|
0
|
|
|
|
|
0
|
my $output_file = |
430
|
|
|
|
|
|
|
Dist::Man::BuilderSet->new()->file_for_builder($builder_name); |
431
|
0
|
|
|
|
|
0
|
my $fname = File::Spec->catfile( $self->{basedir}, $output_file ); |
432
|
|
|
|
|
|
|
|
433
|
0
|
|
|
|
|
0
|
$self->create_file( |
434
|
|
|
|
|
|
|
$fname, |
435
|
|
|
|
|
|
|
$self->MI_Makefile_PL_guts( |
436
|
|
|
|
|
|
|
$main_module, |
437
|
|
|
|
|
|
|
$self->_module_to_pm_file($main_module), |
438
|
|
|
|
|
|
|
), |
439
|
|
|
|
|
|
|
); |
440
|
|
|
|
|
|
|
|
441
|
0
|
|
|
|
|
0
|
$self->progress( "Created $fname" ); |
442
|
|
|
|
|
|
|
|
443
|
0
|
|
|
|
|
0
|
return $output_file; |
444
|
|
|
|
|
|
|
} |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
=head2 Makefile_PL_guts( $main_module, $main_pm_file ) |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
This method is called by create_Makefile_PL and returns text used to populate |
449
|
|
|
|
|
|
|
Makefile.PL; I<$main_pm_file> is the filename of the distribution's main |
450
|
|
|
|
|
|
|
module, I<$main_module>. |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
=cut |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
sub Makefile_PL_guts { |
455
|
3
|
|
|
3
|
1
|
6
|
my $self = shift; |
456
|
3
|
|
|
|
|
4
|
my $main_module = shift; |
457
|
3
|
|
|
|
|
4
|
my $main_pm_file = shift; |
458
|
|
|
|
|
|
|
|
459
|
3
|
|
|
|
|
13
|
(my $author = "$self->{author} <$self->{email}>") =~ s/'/\'/g; |
460
|
|
|
|
|
|
|
|
461
|
3
|
|
|
|
|
24
|
return <<"HERE"; |
462
|
|
|
|
|
|
|
use strict; |
463
|
|
|
|
|
|
|
use warnings; |
464
|
|
|
|
|
|
|
use ExtUtils::MakeMaker; |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
WriteMakefile( |
467
|
|
|
|
|
|
|
NAME => '$main_module', |
468
|
|
|
|
|
|
|
AUTHOR => q{$author}, |
469
|
|
|
|
|
|
|
VERSION_FROM => '$main_pm_file', |
470
|
|
|
|
|
|
|
ABSTRACT_FROM => '$main_pm_file', |
471
|
|
|
|
|
|
|
(\$ExtUtils::MakeMaker::VERSION >= 6.3002 |
472
|
|
|
|
|
|
|
? ('LICENSE'=> '$self->{license}') |
473
|
|
|
|
|
|
|
: ()), |
474
|
|
|
|
|
|
|
PL_FILES => {}, |
475
|
|
|
|
|
|
|
PREREQ_PM => { |
476
|
|
|
|
|
|
|
'Test::More' => 0, |
477
|
|
|
|
|
|
|
}, |
478
|
|
|
|
|
|
|
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, |
479
|
|
|
|
|
|
|
clean => { FILES => '$self->{distro}-*' }, |
480
|
|
|
|
|
|
|
); |
481
|
|
|
|
|
|
|
HERE |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
} |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
=head2 MI_Makefile_PL_guts( $main_module, $main_pm_file ) |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
This method is called by create_MI_Makefile_PL and returns text used to populate |
488
|
|
|
|
|
|
|
Makefile.PL; I<$main_pm_file> is the filename of the distribution's main |
489
|
|
|
|
|
|
|
module, I<$main_module>. |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
=cut |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
sub MI_Makefile_PL_guts { |
494
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
495
|
0
|
|
|
|
|
0
|
my $main_module = shift; |
496
|
0
|
|
|
|
|
0
|
my $main_pm_file = shift; |
497
|
|
|
|
|
|
|
|
498
|
0
|
|
|
|
|
0
|
my $author = "$self->{author} <$self->{email}>"; |
499
|
0
|
|
|
|
|
0
|
$author =~ s/'/\'/g; |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
# To avoid making it a dependency: |
502
|
0
|
|
|
|
|
0
|
my $my_mod = "Mod"; |
503
|
0
|
|
|
|
|
0
|
my $my_inst = "Inst"; |
504
|
|
|
|
|
|
|
|
505
|
0
|
|
|
|
|
0
|
return <<"HERE"; |
506
|
|
|
|
|
|
|
use inc::${my_mod}ule::${my_inst}all; |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
name '$self->{distro}'; |
509
|
|
|
|
|
|
|
all_from '$main_pm_file'; |
510
|
|
|
|
|
|
|
author q{$author}; |
511
|
|
|
|
|
|
|
license '$self->{license}'; |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
build_requires 'Test::More'; |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
auto_install; |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
WriteAll; |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
HERE |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
} |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
=head2 create_Build_PL( $main_module ) |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
This will create the Build.PL for the distribution, and will use the module |
526
|
|
|
|
|
|
|
named in I<$main_module> as the main module of the distribution. |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
=cut |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
sub create_Build_PL { |
531
|
5
|
|
|
5
|
1
|
11
|
my $self = shift; |
532
|
5
|
|
|
|
|
7
|
my $main_module = shift; |
533
|
5
|
|
|
|
|
10
|
my $builder_name = 'Module::Build'; |
534
|
5
|
|
|
|
|
16
|
my $output_file = |
535
|
|
|
|
|
|
|
Dist::Man::BuilderSet->new()->file_for_builder($builder_name); |
536
|
5
|
|
|
|
|
92
|
my $fname = File::Spec->catfile( $self->{basedir}, $output_file ); |
537
|
|
|
|
|
|
|
|
538
|
5
|
|
|
|
|
21
|
$self->create_file( |
539
|
|
|
|
|
|
|
$fname, |
540
|
|
|
|
|
|
|
$self->Build_PL_guts( |
541
|
|
|
|
|
|
|
$main_module, |
542
|
|
|
|
|
|
|
$self->_module_to_pm_file($main_module), |
543
|
|
|
|
|
|
|
), |
544
|
|
|
|
|
|
|
); |
545
|
|
|
|
|
|
|
|
546
|
5
|
|
|
|
|
20
|
$self->progress( "Created $fname" ); |
547
|
|
|
|
|
|
|
|
548
|
5
|
|
|
|
|
20
|
return $output_file; |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
=head2 Build_PL_guts( $main_module, $main_pm_file ) |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
This method is called by create_Build_PL and returns text used to populate |
554
|
|
|
|
|
|
|
Build.PL; I<$main_pm_file> is the filename of the distribution's main module, |
555
|
|
|
|
|
|
|
I<$main_module>. |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
=cut |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
sub Build_PL_guts { |
560
|
5
|
|
|
5
|
1
|
9
|
my $self = shift; |
561
|
5
|
|
|
|
|
9
|
my $main_module = shift; |
562
|
5
|
|
|
|
|
7
|
my $main_pm_file = shift; |
563
|
|
|
|
|
|
|
|
564
|
5
|
|
|
|
|
21
|
(my $author = "$self->{author} <$self->{email}>") =~ s/'/\'/g; |
565
|
|
|
|
|
|
|
|
566
|
5
|
|
|
|
|
30
|
return <<"HERE"; |
567
|
|
|
|
|
|
|
use strict; |
568
|
|
|
|
|
|
|
use warnings; |
569
|
|
|
|
|
|
|
use Module::Build; |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
my \$builder = Module::Build->new( |
572
|
|
|
|
|
|
|
module_name => '$main_module', |
573
|
|
|
|
|
|
|
license => '$self->{license}', |
574
|
|
|
|
|
|
|
dist_author => q{$author}, |
575
|
|
|
|
|
|
|
dist_version_from => '$main_pm_file', |
576
|
|
|
|
|
|
|
build_requires => { |
577
|
|
|
|
|
|
|
'Test::More' => 0, |
578
|
|
|
|
|
|
|
}, |
579
|
|
|
|
|
|
|
add_to_cleanup => [ '$self->{distro}-*' ], |
580
|
|
|
|
|
|
|
create_makefile_pl => 'traditional', |
581
|
|
|
|
|
|
|
); |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
\$builder->create_build_script(); |
584
|
|
|
|
|
|
|
HERE |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
} |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
=head2 create_Changes( ) |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
This method creates a skeletal Changes file. |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
=cut |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
sub create_Changes { |
595
|
8
|
|
|
8
|
1
|
10
|
my $self = shift; |
596
|
|
|
|
|
|
|
|
597
|
8
|
|
|
|
|
87
|
my $fname = File::Spec->catfile( $self->{basedir}, 'Changes' ); |
598
|
8
|
|
|
|
|
36
|
$self->create_file( $fname, $self->Changes_guts() ); |
599
|
8
|
|
|
|
|
33
|
$self->progress( "Created $fname" ); |
600
|
|
|
|
|
|
|
|
601
|
8
|
|
|
|
|
19
|
return 'Changes'; |
602
|
|
|
|
|
|
|
} |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
=head2 Changes_guts |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
Called by create_Changes, this method returns content for the Changes file. |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
=cut |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
sub Changes_guts { |
611
|
8
|
|
|
8
|
1
|
14
|
my $self = shift; |
612
|
|
|
|
|
|
|
|
613
|
8
|
|
|
|
|
36
|
return <<"HERE"; |
614
|
|
|
|
|
|
|
Revision history for $self->{distro} |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
0.01 Date/time |
617
|
|
|
|
|
|
|
First version, released on an unsuspecting world. |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
HERE |
620
|
|
|
|
|
|
|
} |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
=head2 create_README( $build_instructions ) |
623
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
This method creates the distribution's README file. |
625
|
|
|
|
|
|
|
|
626
|
|
|
|
|
|
|
=cut |
627
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
sub create_README { |
629
|
8
|
|
|
8
|
1
|
14
|
my $self = shift; |
630
|
8
|
|
|
|
|
11
|
my $build_instructions = shift; |
631
|
|
|
|
|
|
|
|
632
|
8
|
|
|
|
|
88
|
my $fname = File::Spec->catfile( $self->{basedir}, 'README' ); |
633
|
8
|
|
|
|
|
39
|
$self->create_file( $fname, $self->README_guts($build_instructions) ); |
634
|
8
|
|
|
|
|
33
|
$self->progress( "Created $fname" ); |
635
|
|
|
|
|
|
|
|
636
|
8
|
|
|
|
|
19
|
return 'README'; |
637
|
|
|
|
|
|
|
} |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
=head2 README_guts |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
Called by create_README, this method returns content for the README file. |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
=cut |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
sub _README_intro { |
646
|
8
|
|
|
8
|
|
10
|
my $self = shift; |
647
|
|
|
|
|
|
|
|
648
|
8
|
|
|
|
|
15
|
return <<"HERE"; |
649
|
|
|
|
|
|
|
The README is used to introduce the module and provide instructions on |
650
|
|
|
|
|
|
|
how to install the module, any machine dependencies it may have (for |
651
|
|
|
|
|
|
|
example C compilers and installed libraries) and any other information |
652
|
|
|
|
|
|
|
that should be provided before the module is installed. |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
A README file is required for CPAN modules since CPAN extracts the README |
655
|
|
|
|
|
|
|
file from a module distribution so that people browsing the archive |
656
|
|
|
|
|
|
|
can use it to get an idea of the module's uses. It is usually a good idea |
657
|
|
|
|
|
|
|
to provide version information here so that people can decide whether |
658
|
|
|
|
|
|
|
fixes for the module are worth downloading. |
659
|
|
|
|
|
|
|
HERE |
660
|
|
|
|
|
|
|
} |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
sub _README_information { |
663
|
8
|
|
|
8
|
|
10
|
my $self = shift; |
664
|
|
|
|
|
|
|
|
665
|
8
|
|
|
|
|
19
|
my @reference_links = _reference_links(); |
666
|
|
|
|
|
|
|
|
667
|
8
|
|
|
|
|
16
|
my $content = "You can also look for information at:\n"; |
668
|
|
|
|
|
|
|
|
669
|
8
|
|
|
|
|
18
|
foreach my $ref (@reference_links){ |
670
|
32
|
|
|
|
|
36
|
my $title; |
671
|
32
|
100
|
|
|
|
71
|
$title = "$ref->{nickname}, " if exists $ref->{nickname}; |
672
|
32
|
|
|
|
|
43
|
$title .= $ref->{title}; |
673
|
32
|
|
|
|
|
72
|
my $link = sprintf($ref->{link}, $self->{distro}); |
674
|
|
|
|
|
|
|
|
675
|
32
|
|
|
|
|
94
|
$content .= qq[ |
676
|
|
|
|
|
|
|
$title |
677
|
|
|
|
|
|
|
$link |
678
|
|
|
|
|
|
|
]; |
679
|
|
|
|
|
|
|
} |
680
|
|
|
|
|
|
|
|
681
|
8
|
|
|
|
|
38
|
return $content; |
682
|
|
|
|
|
|
|
} |
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
sub _README_license { |
685
|
8
|
|
|
8
|
|
18
|
my $self = shift; |
686
|
|
|
|
|
|
|
|
687
|
8
|
|
|
|
|
17
|
my $year = $self->_thisyear(); |
688
|
8
|
|
|
|
|
26
|
my $license_blurb = $self->_license_blurb(); |
689
|
|
|
|
|
|
|
|
690
|
8
|
|
|
|
|
42
|
return <<"HERE"; |
691
|
|
|
|
|
|
|
COPYRIGHT AND LICENCE |
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
Copyright (C) $year $self->{author} |
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
$license_blurb |
696
|
|
|
|
|
|
|
HERE |
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
sub README_guts { |
700
|
8
|
|
|
8
|
1
|
13
|
my $self = shift; |
701
|
8
|
|
|
|
|
13
|
my $build_instructions = shift; |
702
|
|
|
|
|
|
|
|
703
|
8
|
|
|
|
|
28
|
my $intro = $self->_README_intro(); |
704
|
8
|
|
|
|
|
29
|
my $information = $self->_README_information(); |
705
|
8
|
|
|
|
|
211
|
my $license = $self->_README_license(); |
706
|
|
|
|
|
|
|
|
707
|
8
|
|
|
|
|
77
|
return <<"HERE"; |
708
|
|
|
|
|
|
|
$self->{distro} |
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
$intro |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
INSTALLATION |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
$build_instructions |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
SUPPORT AND DOCUMENTATION |
717
|
|
|
|
|
|
|
|
718
|
|
|
|
|
|
|
After installing, you can find documentation for this module with the |
719
|
|
|
|
|
|
|
perldoc command. |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
perldoc $self->{main_module} |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
$information |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
$license |
726
|
|
|
|
|
|
|
HERE |
727
|
|
|
|
|
|
|
} |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
=head2 create_t( @modules ) |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
This method creates a bunch of *.t files. I<@modules> is a list of all modules |
732
|
|
|
|
|
|
|
in the distribution. |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
=cut |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
sub create_t { |
737
|
8
|
|
|
8
|
1
|
15
|
my $self = shift; |
738
|
8
|
|
|
|
|
18
|
my @modules = @_; |
739
|
|
|
|
|
|
|
|
740
|
8
|
|
|
|
|
33
|
my %t_files = $self->t_guts(@modules); |
741
|
|
|
|
|
|
|
|
742
|
8
|
|
|
|
|
26
|
my @files = map { $self->_create_t($_, $t_files{$_}) } keys %t_files; |
|
32
|
|
|
|
|
93
|
|
743
|
|
|
|
|
|
|
|
744
|
8
|
|
|
|
|
46
|
return @files; |
745
|
|
|
|
|
|
|
} |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
=head2 t_guts( @modules ) |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
This method is called by create_t, and returns a description of the *.t files |
750
|
|
|
|
|
|
|
to be created. |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
The return value is a hash of test files to create. Each key is a filename and |
753
|
|
|
|
|
|
|
each value is the contents of that file. |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
=cut |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
sub t_guts { |
758
|
8
|
|
|
8
|
1
|
15
|
my $self = shift; |
759
|
8
|
|
|
|
|
20
|
my @modules = @_; |
760
|
|
|
|
|
|
|
|
761
|
8
|
|
|
|
|
14
|
my %t_files; |
762
|
|
|
|
|
|
|
|
763
|
8
|
|
|
|
|
18
|
$t_files{'pod.t'} = <<'HERE'; |
764
|
|
|
|
|
|
|
#!perl -T |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
use strict; |
767
|
|
|
|
|
|
|
use warnings; |
768
|
|
|
|
|
|
|
use Test::More; |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
# Ensure a recent version of Test::Pod |
771
|
|
|
|
|
|
|
my $min_tp = 1.22; |
772
|
|
|
|
|
|
|
eval "use Test::Pod $min_tp"; |
773
|
|
|
|
|
|
|
plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
all_pod_files_ok(); |
776
|
|
|
|
|
|
|
HERE |
777
|
|
|
|
|
|
|
|
778
|
8
|
|
|
|
|
16
|
$t_files{'pod-coverage.t'} = <<'HERE'; |
779
|
|
|
|
|
|
|
use strict; |
780
|
|
|
|
|
|
|
use warnings; |
781
|
|
|
|
|
|
|
use Test::More; |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
# Ensure a recent version of Test::Pod::Coverage |
784
|
|
|
|
|
|
|
my $min_tpc = 1.08; |
785
|
|
|
|
|
|
|
eval "use Test::Pod::Coverage $min_tpc"; |
786
|
|
|
|
|
|
|
plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" |
787
|
|
|
|
|
|
|
if $@; |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, |
790
|
|
|
|
|
|
|
# but older versions don't recognize some common documentation styles |
791
|
|
|
|
|
|
|
my $min_pc = 0.18; |
792
|
|
|
|
|
|
|
eval "use Pod::Coverage $min_pc"; |
793
|
|
|
|
|
|
|
plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" |
794
|
|
|
|
|
|
|
if $@; |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
all_pod_coverage_ok(); |
797
|
|
|
|
|
|
|
HERE |
798
|
|
|
|
|
|
|
|
799
|
8
|
|
|
|
|
11
|
my $nmodules = @modules; |
800
|
8
|
|
|
|
|
12
|
my $main_module = $modules[0]; |
801
|
8
|
|
|
|
|
15
|
my $use_lines = join( "\n", map { " use_ok( '$_' );" } @modules ); |
|
27
|
|
|
|
|
79
|
|
802
|
|
|
|
|
|
|
|
803
|
8
|
|
|
|
|
38
|
$t_files{'00-load.t'} = <<"HERE"; |
804
|
|
|
|
|
|
|
#!perl -T |
805
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
use Test::More tests => $nmodules; |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
BEGIN { |
809
|
|
|
|
|
|
|
$use_lines |
810
|
|
|
|
|
|
|
} |
811
|
|
|
|
|
|
|
|
812
|
|
|
|
|
|
|
diag( "Testing $main_module \$${main_module}::VERSION, Perl \$], \$^X" ); |
813
|
|
|
|
|
|
|
HERE |
814
|
|
|
|
|
|
|
|
815
|
8
|
|
|
|
|
11
|
my $module_boilerplate_tests; |
816
|
|
|
|
|
|
|
$module_boilerplate_tests .= |
817
|
8
|
|
|
|
|
38
|
" module_boilerplate_ok('".$self->_module_to_pm_file($_)."');\n" for @modules; |
818
|
|
|
|
|
|
|
|
819
|
4
|
|
|
4
|
|
3784
|
my $boilerplate_tests = @modules + 2 + $[; |
|
4
|
|
|
|
|
2087
|
|
|
4
|
|
|
|
|
6062
|
|
|
8
|
|
|
|
|
59
|
|
820
|
8
|
|
|
|
|
45
|
$t_files{'boilerplate.t'} = <<"HERE"; |
821
|
|
|
|
|
|
|
#!perl -T |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
use strict; |
824
|
|
|
|
|
|
|
use warnings; |
825
|
|
|
|
|
|
|
use Test::More tests => $boilerplate_tests; |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
sub not_in_file_ok { |
828
|
|
|
|
|
|
|
my (\$filename, \%regex) = \@_; |
829
|
|
|
|
|
|
|
open( my \$fh, '<', \$filename ) |
830
|
|
|
|
|
|
|
or die "couldn't open \$filename for reading: \$!"; |
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
my \%violated; |
833
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
while (my \$line = <\$fh>) { |
835
|
|
|
|
|
|
|
while (my (\$desc, \$regex) = each \%regex) { |
836
|
|
|
|
|
|
|
if (\$line =~ \$regex) { |
837
|
|
|
|
|
|
|
push \@{\$violated{\$desc}||=[]}, \$.; |
838
|
|
|
|
|
|
|
} |
839
|
|
|
|
|
|
|
} |
840
|
|
|
|
|
|
|
} |
841
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
if (\%violated) { |
843
|
|
|
|
|
|
|
fail("\$filename contains boilerplate text"); |
844
|
|
|
|
|
|
|
diag "\$_ appears on lines \@{\$violated{\$_}}" for keys \%violated; |
845
|
|
|
|
|
|
|
} else { |
846
|
|
|
|
|
|
|
pass("\$filename contains no boilerplate text"); |
847
|
|
|
|
|
|
|
} |
848
|
|
|
|
|
|
|
} |
849
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
sub module_boilerplate_ok { |
851
|
|
|
|
|
|
|
my (\$module) = \@_; |
852
|
|
|
|
|
|
|
not_in_file_ok(\$module => |
853
|
|
|
|
|
|
|
'the great new \$MODULENAME' => qr/ - The great new /, |
854
|
|
|
|
|
|
|
'boilerplate description' => qr/Quick summary of what the module/, |
855
|
|
|
|
|
|
|
'stub function definition' => qr/function[12]/, |
856
|
|
|
|
|
|
|
); |
857
|
|
|
|
|
|
|
} |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
TODO: { |
860
|
|
|
|
|
|
|
local \$TODO = "Need to replace the boilerplate text"; |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
not_in_file_ok(README => |
863
|
|
|
|
|
|
|
"The README is used..." => qr/The README is used/, |
864
|
|
|
|
|
|
|
"'version information here'" => qr/to provide version information/, |
865
|
|
|
|
|
|
|
); |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
not_in_file_ok(Changes => |
868
|
|
|
|
|
|
|
"placeholder date/time" => qr(Date/time) |
869
|
|
|
|
|
|
|
); |
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
$module_boilerplate_tests |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
} |
874
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
HERE |
876
|
|
|
|
|
|
|
|
877
|
8
|
|
|
|
|
58
|
return %t_files; |
878
|
|
|
|
|
|
|
} |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
sub _create_t { |
881
|
32
|
|
|
32
|
|
36
|
my $self = shift; |
882
|
32
|
|
|
|
|
41
|
my $filename = shift; |
883
|
32
|
|
|
|
|
36
|
my $content = shift; |
884
|
|
|
|
|
|
|
|
885
|
32
|
|
|
|
|
68
|
my @dirparts = ( $self->{basedir}, 't' ); |
886
|
32
|
|
|
|
|
201
|
my $tdir = File::Spec->catdir( @dirparts ); |
887
|
32
|
100
|
|
|
|
503
|
if ( not -d $tdir ) { |
888
|
8
|
|
|
|
|
21
|
local @ARGV = $tdir; |
889
|
8
|
|
|
|
|
25
|
mkpath(); |
890
|
8
|
|
|
|
|
1025
|
$self->progress( "Created $tdir" ); |
891
|
|
|
|
|
|
|
} |
892
|
|
|
|
|
|
|
|
893
|
32
|
|
|
|
|
261
|
my $fname = File::Spec->catfile( @dirparts, $filename ); |
894
|
32
|
|
|
|
|
90
|
$self->create_file( $fname, $content ); |
895
|
32
|
|
|
|
|
175
|
$self->progress( "Created $fname" ); |
896
|
|
|
|
|
|
|
|
897
|
32
|
|
|
|
|
290
|
return "t/$filename"; |
898
|
|
|
|
|
|
|
} |
899
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
=head2 create_MANIFEST( @files ) |
901
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
This method creates the distribution's MANIFEST file. It must be run last, |
903
|
|
|
|
|
|
|
because all the other create_* functions have been returning the functions they |
904
|
|
|
|
|
|
|
create. |
905
|
|
|
|
|
|
|
|
906
|
|
|
|
|
|
|
=cut |
907
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
sub create_MANIFEST { |
909
|
8
|
|
|
8
|
1
|
14
|
my $self = shift; |
910
|
8
|
|
|
|
|
27
|
my @files = @_; |
911
|
|
|
|
|
|
|
|
912
|
8
|
|
|
|
|
82
|
my $fname = File::Spec->catfile( $self->{basedir}, 'MANIFEST' ); |
913
|
8
|
|
|
|
|
39
|
$self->create_file( $fname, $self->MANIFEST_guts(@files) ); |
914
|
8
|
|
|
|
|
96
|
$self->progress( "Created $fname" ); |
915
|
|
|
|
|
|
|
|
916
|
8
|
|
|
|
|
17
|
return 'MANIFEST'; |
917
|
|
|
|
|
|
|
} |
918
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
=head2 MANIFEST_guts( @files ) |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
This method is called by C, and returns content for the |
922
|
|
|
|
|
|
|
MANIFEST file. |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
=cut |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
sub MANIFEST_guts { |
927
|
8
|
|
|
8
|
1
|
9
|
my $self = shift; |
928
|
8
|
|
|
|
|
80
|
my @files = sort @_; |
929
|
|
|
|
|
|
|
|
930
|
8
|
|
|
|
|
48
|
return join( "\n", @files, '' ); |
931
|
|
|
|
|
|
|
} |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
=head2 create_build( ) |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
This method creates the build file(s) and puts together some build |
936
|
|
|
|
|
|
|
instructions. The builders currently supported are: |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
ExtUtils::MakeMaker |
939
|
|
|
|
|
|
|
Module::Build |
940
|
|
|
|
|
|
|
Module::Install |
941
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
=cut |
943
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
sub create_build { |
945
|
8
|
|
|
8
|
1
|
11
|
my $self = shift; |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
# pass one: pull the builders out of $self->{builder} |
948
|
1
|
|
|
|
|
3
|
my @tmp = |
949
|
8
|
100
|
|
|
|
37
|
ref $self->{builder} eq 'ARRAY' ? @{$self->{builder}} : $self->{builder}; |
950
|
|
|
|
|
|
|
|
951
|
8
|
|
|
|
|
11
|
my @builders; |
952
|
8
|
|
|
|
|
14
|
my $COMMA = q{,}; |
953
|
|
|
|
|
|
|
# pass two: expand comma-delimited builder lists |
954
|
8
|
|
|
|
|
13
|
foreach my $builder (@tmp) { |
955
|
8
|
|
|
|
|
65
|
push( @builders, split($COMMA, $builder) ); |
956
|
|
|
|
|
|
|
} |
957
|
|
|
|
|
|
|
|
958
|
8
|
|
|
|
|
73
|
my $builder_set = Dist::Man::BuilderSet->new(); |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
# Remove mutually exclusive and unsupported builders |
961
|
8
|
|
|
|
|
34
|
@builders = $builder_set->check_compatibility( @builders ); |
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
# compile some build instructions, create a list of files generated |
964
|
|
|
|
|
|
|
# by the builders' create_* methods, and call said methods |
965
|
|
|
|
|
|
|
|
966
|
8
|
|
|
|
|
12
|
my @build_instructions; |
967
|
|
|
|
|
|
|
my @files; |
968
|
|
|
|
|
|
|
|
969
|
8
|
|
|
|
|
16
|
foreach my $builder ( @builders ) { |
970
|
8
|
50
|
|
|
|
19
|
if ( !@build_instructions ) { |
971
|
8
|
|
|
|
|
14
|
push( @build_instructions, |
972
|
|
|
|
|
|
|
'To install this module, run the following commands:' |
973
|
|
|
|
|
|
|
); |
974
|
|
|
|
|
|
|
} |
975
|
|
|
|
|
|
|
else { |
976
|
0
|
|
|
|
|
0
|
push( @build_instructions, |
977
|
|
|
|
|
|
|
"Alternatively, to install with $builder, you can ". |
978
|
|
|
|
|
|
|
"use the following commands:" |
979
|
|
|
|
|
|
|
); |
980
|
|
|
|
|
|
|
} |
981
|
8
|
|
|
|
|
23
|
push( @files, $builder_set->file_for_builder($builder) ); |
982
|
8
|
|
|
|
|
34
|
my @commands = $builder_set->instructions_for_builder($builder); |
983
|
8
|
|
|
|
|
22
|
push( @build_instructions, join("\n", map { "\t$_" } @commands) ); |
|
32
|
|
|
|
|
66
|
|
984
|
|
|
|
|
|
|
|
985
|
8
|
|
|
|
|
28
|
my $build_method = $builder_set->method_for_builder($builder); |
986
|
8
|
|
|
|
|
54
|
$self->$build_method($self->{main_module}) |
987
|
|
|
|
|
|
|
} |
988
|
|
|
|
|
|
|
|
989
|
|
|
|
|
|
|
return( |
990
|
8
|
|
|
|
|
96
|
files => [ @files ], |
991
|
|
|
|
|
|
|
instructions => join( "\n\n", @build_instructions ), |
992
|
|
|
|
|
|
|
); |
993
|
|
|
|
|
|
|
} |
994
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
=head2 create_ignores() |
997
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
This creates an ignore.txt file for use as MANIFEST.SKIP, .cvsignore, |
999
|
|
|
|
|
|
|
.gitignore, or whatever you use. |
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
=cut |
1002
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
sub create_ignores { |
1004
|
8
|
|
|
8
|
1
|
196
|
my $self = shift; |
1005
|
|
|
|
|
|
|
|
1006
|
8
|
|
|
|
|
278
|
my $fname = File::Spec->catfile( $self->{basedir}, 'ignore.txt' ); |
1007
|
8
|
|
|
|
|
36
|
$self->create_file( $fname, $self->ignores_guts() ); |
1008
|
8
|
|
|
|
|
35
|
$self->progress( "Created $fname" ); |
1009
|
|
|
|
|
|
|
|
1010
|
8
|
|
|
|
|
14
|
return; # Not a file that goes in the MANIFEST |
1011
|
|
|
|
|
|
|
} |
1012
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
=head2 ignores_guts() |
1014
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
Called by C, this method returns the contents of the |
1016
|
|
|
|
|
|
|
ignore.txt file. |
1017
|
|
|
|
|
|
|
|
1018
|
|
|
|
|
|
|
=cut |
1019
|
|
|
|
|
|
|
|
1020
|
|
|
|
|
|
|
sub ignores_guts { |
1021
|
8
|
|
|
8
|
1
|
14
|
my $self = shift; |
1022
|
|
|
|
|
|
|
|
1023
|
8
|
|
|
|
|
227
|
return <<"HERE"; |
1024
|
|
|
|
|
|
|
blib* |
1025
|
|
|
|
|
|
|
Makefile |
1026
|
|
|
|
|
|
|
Makefile.old |
1027
|
|
|
|
|
|
|
Build |
1028
|
|
|
|
|
|
|
Build.bat |
1029
|
|
|
|
|
|
|
_build* |
1030
|
|
|
|
|
|
|
pm_to_blib* |
1031
|
|
|
|
|
|
|
*.tar.gz |
1032
|
|
|
|
|
|
|
.lwpcookies |
1033
|
|
|
|
|
|
|
cover_db |
1034
|
|
|
|
|
|
|
pod2htm*.tmp |
1035
|
|
|
|
|
|
|
$self->{distro}-* |
1036
|
|
|
|
|
|
|
HERE |
1037
|
|
|
|
|
|
|
} |
1038
|
|
|
|
|
|
|
|
1039
|
|
|
|
|
|
|
=head1 HELPER METHODS |
1040
|
|
|
|
|
|
|
|
1041
|
|
|
|
|
|
|
=head2 verbose |
1042
|
|
|
|
|
|
|
|
1043
|
|
|
|
|
|
|
C tells us whether we're in verbose mode. |
1044
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
=cut |
1046
|
|
|
|
|
|
|
|
1047
|
136
|
|
|
136
|
1
|
2287
|
sub verbose { return shift->{verbose} } |
1048
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
=head2 create_file( $fname, @content_lines ) |
1050
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
Creates I<$fname>, dumps I<@content_lines> in it, and closes it. |
1052
|
|
|
|
|
|
|
Dies on any error. |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
=cut |
1055
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
sub create_file { |
1057
|
99
|
|
|
99
|
1
|
114
|
my $self = shift; |
1058
|
99
|
|
|
|
|
275
|
my $fname = shift; |
1059
|
|
|
|
|
|
|
|
1060
|
99
|
|
|
|
|
174
|
my @content = @_; |
1061
|
99
|
50
|
|
|
|
9980
|
open( my $fh, '>', $fname ) or confess "Can't create $fname: $!\n"; |
1062
|
99
|
|
|
|
|
117
|
print {$fh} @content; |
|
99
|
|
|
|
|
788
|
|
1063
|
99
|
50
|
|
|
|
4497
|
close $fh or die "Can't close $fname: $!\n"; |
1064
|
|
|
|
|
|
|
|
1065
|
99
|
|
|
|
|
508
|
return; |
1066
|
|
|
|
|
|
|
} |
1067
|
|
|
|
|
|
|
|
1068
|
|
|
|
|
|
|
=head2 progress( @list ) |
1069
|
|
|
|
|
|
|
|
1070
|
|
|
|
|
|
|
C |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
=cut |
1073
|
|
|
|
|
|
|
|
1074
|
|
|
|
|
|
|
sub progress { |
1075
|
136
|
|
|
136
|
1
|
179
|
my $self = shift; |
1076
|
136
|
100
|
|
|
|
230
|
print @_, "\n" if $self->verbose; |
1077
|
|
|
|
|
|
|
|
1078
|
136
|
|
|
|
|
219
|
return; |
1079
|
|
|
|
|
|
|
} |
1080
|
|
|
|
|
|
|
|
1081
|
|
|
|
|
|
|
=head1 BUGS |
1082
|
|
|
|
|
|
|
|
1083
|
|
|
|
|
|
|
Please report any bugs or feature requests to |
1084
|
|
|
|
|
|
|
C, or through the web interface at |
1085
|
|
|
|
|
|
|
L. I will be notified, and then you'll automatically |
1086
|
|
|
|
|
|
|
be notified of progress on your bug as I make changes. |
1087
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
=head1 AUTHOR |
1089
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
Shlomi Fish, L |
1091
|
|
|
|
|
|
|
|
1092
|
|
|
|
|
|
|
Andy Lester, C<< >> |
1093
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
C.J. Adams-Collier, C<< >> |
1095
|
|
|
|
|
|
|
|
1096
|
|
|
|
|
|
|
=head1 Copyright & License |
1097
|
|
|
|
|
|
|
|
1098
|
|
|
|
|
|
|
=head2 Module::Starter::Simple |
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
Copyright 2005-2007 Andy Lester and C.J. Adams-Collier, All Rights Reserved. |
1101
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
1103
|
|
|
|
|
|
|
under the same terms as Perl itself. |
1104
|
|
|
|
|
|
|
|
1105
|
|
|
|
|
|
|
Please note that these modules are not products of or supported by the |
1106
|
|
|
|
|
|
|
employers of the various contributors to the code. |
1107
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
=head2 Dist::Man::Simple |
1109
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
Modified by Shlomi Fish, while disclaiming any explicit or implicit ownership |
1111
|
|
|
|
|
|
|
of the code. May be used under the present or future terms of Module-Starter. |
1112
|
|
|
|
|
|
|
|
1113
|
|
|
|
|
|
|
=cut |
1114
|
|
|
|
|
|
|
|
1115
|
|
|
|
|
|
|
sub _module_header { |
1116
|
27
|
|
|
27
|
|
36
|
my $self = shift; |
1117
|
27
|
|
|
|
|
32
|
my $module = shift; |
1118
|
27
|
|
|
|
|
28
|
my $rtname = shift; |
1119
|
27
|
|
|
|
|
100
|
my $content = <<"HERE"; |
1120
|
|
|
|
|
|
|
package $module; |
1121
|
|
|
|
|
|
|
|
1122
|
|
|
|
|
|
|
use warnings; |
1123
|
|
|
|
|
|
|
use strict; |
1124
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
\=head1 NAME |
1126
|
|
|
|
|
|
|
|
1127
|
|
|
|
|
|
|
$module - The great new $module! |
1128
|
|
|
|
|
|
|
|
1129
|
|
|
|
|
|
|
\=head1 VERSION |
1130
|
|
|
|
|
|
|
|
1131
|
|
|
|
|
|
|
Version 0.01 |
1132
|
|
|
|
|
|
|
|
1133
|
|
|
|
|
|
|
\=cut |
1134
|
|
|
|
|
|
|
|
1135
|
|
|
|
|
|
|
our \$VERSION = '0.01'; |
1136
|
|
|
|
|
|
|
HERE |
1137
|
27
|
|
|
|
|
55
|
return $content; |
1138
|
|
|
|
|
|
|
} |
1139
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
sub _module_bugs { |
1141
|
27
|
|
|
27
|
|
33
|
my $self = shift; |
1142
|
27
|
|
|
|
|
34
|
my $module = shift; |
1143
|
27
|
|
|
|
|
112
|
my $rtname = shift; |
1144
|
|
|
|
|
|
|
|
1145
|
27
|
|
|
|
|
65
|
my $bug_email = "bug-\L$self->{distro}\E at rt.cpan.org"; |
1146
|
27
|
|
|
|
|
45
|
my $bug_link = |
1147
|
|
|
|
|
|
|
"http://rt.cpan.org/NoAuth/ReportBug.html?Queue=$self->{distro}"; |
1148
|
|
|
|
|
|
|
|
1149
|
27
|
|
|
|
|
90
|
my $content = <<"HERE"; |
1150
|
|
|
|
|
|
|
\=head1 BUGS |
1151
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
Please report any bugs or feature requests to C<$bug_email>, or through |
1153
|
|
|
|
|
|
|
the web interface at L<$bug_link>. I will be notified, and then you'll |
1154
|
|
|
|
|
|
|
automatically be notified of progress on your bug as I make changes. |
1155
|
|
|
|
|
|
|
|
1156
|
|
|
|
|
|
|
HERE |
1157
|
|
|
|
|
|
|
|
1158
|
27
|
|
|
|
|
49
|
return $content; |
1159
|
|
|
|
|
|
|
} |
1160
|
|
|
|
|
|
|
|
1161
|
|
|
|
|
|
|
sub _module_support { |
1162
|
27
|
|
|
27
|
|
35
|
my $self = shift; |
1163
|
27
|
|
|
|
|
93
|
my $module = shift; |
1164
|
27
|
|
|
|
|
36
|
my $rtname = shift; |
1165
|
|
|
|
|
|
|
|
1166
|
27
|
|
|
|
|
52
|
my $content = qq[ |
1167
|
|
|
|
|
|
|
\=head1 SUPPORT |
1168
|
|
|
|
|
|
|
|
1169
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
1170
|
|
|
|
|
|
|
|
1171
|
|
|
|
|
|
|
perldoc $module |
1172
|
|
|
|
|
|
|
]; |
1173
|
27
|
|
|
|
|
90
|
my @reference_links = _reference_links(); |
1174
|
|
|
|
|
|
|
|
1175
|
27
|
50
|
|
|
|
77
|
return unless @reference_links; |
1176
|
27
|
|
|
|
|
66
|
$content .= qq[ |
1177
|
|
|
|
|
|
|
|
1178
|
|
|
|
|
|
|
You can also look for information at: |
1179
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
\=over 4 |
1181
|
|
|
|
|
|
|
]; |
1182
|
|
|
|
|
|
|
|
1183
|
27
|
|
|
|
|
45
|
foreach my $ref (@reference_links) { |
1184
|
108
|
|
|
|
|
98
|
my $title; |
1185
|
108
|
|
|
|
|
267
|
my $link = sprintf($ref->{link}, $self->{distro}); |
1186
|
|
|
|
|
|
|
|
1187
|
108
|
100
|
|
|
|
242
|
$title = "$ref->{nickname}: " if exists $ref->{nickname}; |
1188
|
108
|
|
|
|
|
125
|
$title .= $ref->{title}; |
1189
|
108
|
|
|
|
|
285
|
$content .= qq[ |
1190
|
|
|
|
|
|
|
\=item * $title |
1191
|
|
|
|
|
|
|
|
1192
|
|
|
|
|
|
|
L<$link> |
1193
|
|
|
|
|
|
|
]; |
1194
|
|
|
|
|
|
|
} |
1195
|
27
|
|
|
|
|
38
|
$content .= qq[ |
1196
|
|
|
|
|
|
|
\=back |
1197
|
|
|
|
|
|
|
]; |
1198
|
27
|
|
|
|
|
119
|
return $content; |
1199
|
|
|
|
|
|
|
} |
1200
|
|
|
|
|
|
|
|
1201
|
|
|
|
|
|
|
sub _module_license { |
1202
|
27
|
|
|
27
|
|
32
|
my $self = shift; |
1203
|
|
|
|
|
|
|
|
1204
|
27
|
|
|
|
|
32
|
my $module = shift; |
1205
|
27
|
|
|
|
|
24
|
my $rtname = shift; |
1206
|
|
|
|
|
|
|
|
1207
|
27
|
|
|
|
|
65
|
my $license_blurb = $self->_license_blurb(); |
1208
|
27
|
|
|
|
|
73
|
my $year = $self->_thisyear(); |
1209
|
|
|
|
|
|
|
|
1210
|
27
|
|
|
|
|
106
|
my $content = qq[ |
1211
|
|
|
|
|
|
|
\=head1 COPYRIGHT & LICENSE |
1212
|
|
|
|
|
|
|
|
1213
|
|
|
|
|
|
|
Copyright $year $self->{author}. |
1214
|
|
|
|
|
|
|
|
1215
|
|
|
|
|
|
|
$license_blurb |
1216
|
|
|
|
|
|
|
]; |
1217
|
|
|
|
|
|
|
|
1218
|
27
|
|
|
|
|
87
|
return $content; |
1219
|
|
|
|
|
|
|
} |
1220
|
|
|
|
|
|
|
|
1221
|
|
|
|
|
|
|
sub module_guts { |
1222
|
27
|
|
|
27
|
1
|
46
|
my $self = shift; |
1223
|
27
|
|
|
|
|
34
|
my $module = shift; |
1224
|
27
|
|
|
|
|
63
|
my $rtname = shift; |
1225
|
|
|
|
|
|
|
|
1226
|
|
|
|
|
|
|
# Sub-templates |
1227
|
27
|
|
|
|
|
71
|
my $header = $self->_module_header($module, $rtname); |
1228
|
27
|
|
|
|
|
69
|
my $bugs = $self->_module_bugs($module, $rtname); |
1229
|
27
|
|
|
|
|
65
|
my $support = $self->_module_support($module, $rtname); |
1230
|
27
|
|
|
|
|
83
|
my $license = $self->_module_license($module, $rtname); |
1231
|
|
|
|
|
|
|
|
1232
|
27
|
|
|
|
|
176
|
my $content = <<"HERE"; |
1233
|
|
|
|
|
|
|
$header |
1234
|
|
|
|
|
|
|
|
1235
|
|
|
|
|
|
|
\=head1 SYNOPSIS |
1236
|
|
|
|
|
|
|
|
1237
|
|
|
|
|
|
|
Quick summary of what the module does. |
1238
|
|
|
|
|
|
|
|
1239
|
|
|
|
|
|
|
Perhaps a little code snippet. |
1240
|
|
|
|
|
|
|
|
1241
|
|
|
|
|
|
|
use $module; |
1242
|
|
|
|
|
|
|
|
1243
|
|
|
|
|
|
|
my \$foo = $module->new(); |
1244
|
|
|
|
|
|
|
... |
1245
|
|
|
|
|
|
|
|
1246
|
|
|
|
|
|
|
\=head1 EXPORT |
1247
|
|
|
|
|
|
|
|
1248
|
|
|
|
|
|
|
A list of functions that can be exported. You can delete this section |
1249
|
|
|
|
|
|
|
if you don't export anything, such as for a purely object-oriented module. |
1250
|
|
|
|
|
|
|
|
1251
|
|
|
|
|
|
|
\=head1 FUNCTIONS |
1252
|
|
|
|
|
|
|
|
1253
|
|
|
|
|
|
|
\=head2 function1 |
1254
|
|
|
|
|
|
|
|
1255
|
|
|
|
|
|
|
\=cut |
1256
|
|
|
|
|
|
|
|
1257
|
|
|
|
|
|
|
sub function1 { |
1258
|
|
|
|
|
|
|
} |
1259
|
|
|
|
|
|
|
|
1260
|
|
|
|
|
|
|
\=head2 function2 |
1261
|
|
|
|
|
|
|
|
1262
|
|
|
|
|
|
|
\=cut |
1263
|
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
sub function2 { |
1265
|
|
|
|
|
|
|
} |
1266
|
|
|
|
|
|
|
|
1267
|
|
|
|
|
|
|
\=head1 AUTHOR |
1268
|
|
|
|
|
|
|
|
1269
|
|
|
|
|
|
|
$self->{author}, C<< <$self->{email_obfuscated}> >> |
1270
|
|
|
|
|
|
|
|
1271
|
|
|
|
|
|
|
$bugs |
1272
|
|
|
|
|
|
|
|
1273
|
|
|
|
|
|
|
$support |
1274
|
|
|
|
|
|
|
|
1275
|
|
|
|
|
|
|
\=head1 ACKNOWLEDGEMENTS |
1276
|
|
|
|
|
|
|
|
1277
|
|
|
|
|
|
|
$license |
1278
|
|
|
|
|
|
|
|
1279
|
|
|
|
|
|
|
\=cut |
1280
|
|
|
|
|
|
|
|
1281
|
|
|
|
|
|
|
1; # End of $module |
1282
|
|
|
|
|
|
|
HERE |
1283
|
27
|
|
|
|
|
124
|
return $content; |
1284
|
|
|
|
|
|
|
} |
1285
|
|
|
|
|
|
|
1; |