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