File Coverage

blib/lib/Module/Starter/Simple.pm
Criterion Covered Total %
statement 362 392 92.3
branch 50 90 55.5
condition 10 20 50.0
subroutine 50 57 87.7
pod 34 34 100.0
total 506 593 85.3


line stmt bran cond sub pod time code
1             package Module::Starter::Simple;
2              
3 3     3   57365 use 5.006;
  3         18  
4 3     3   12 use strict;
  3         12  
  3         54  
5 3     3   16 use warnings;
  3         3  
  3         75  
6              
7 3     3   15 use Cwd 'cwd';
  3         4  
  3         168  
8 3     3   1276 use ExtUtils::Command qw( rm_rf mkpath touch );
  3         4769  
  3         196  
9 3     3   18 use File::Spec ();
  3         6  
  3         59  
10 3     3   16 use Carp qw( carp confess croak );
  3         6  
  3         145  
11              
12 3     3   1308 use Module::Starter::BuilderSet;
  3         9  
  3         17209  
13              
14             =head1 NAME
15              
16             Module::Starter::Simple - a simple, comprehensive Module::Starter plugin
17              
18             =head1 VERSION
19              
20             Version 1.75
21              
22             =cut
23              
24             our $VERSION = '1.75';
25              
26             =head1 SYNOPSIS
27              
28             use Module::Starter qw(Module::Starter::Simple);
29              
30             Module::Starter->create_distro(%args);
31              
32             =head1 DESCRIPTION
33              
34             Module::Starter::Simple is a plugin for Module::Starter that will perform all
35             the work needed to create a distribution. Given the parameters detailed in
36             L, it will create content, create directories, and populate
37             the directories with the required files.
38              
39             =head1 CLASS METHODS
40              
41             =head2 C<< new(%args) >>
42              
43             This method is called to construct and initialize a new Module::Starter object.
44             It is never called by the end user, only internally by C, which
45             creates ephemeral Module::Starter objects. It's documented only to call it to
46             the attention of subclass authors.
47              
48             =cut
49              
50             sub new {
51 46     46 1 108 my $class = shift;
52 46         372 return bless { @_ } => $class;
53             }
54              
55             =head1 OBJECT METHODS
56              
57             All the methods documented below are object methods, meant to be called
58             internally by the ephemeral objects created during the execution of the class
59             method C above.
60              
61             =head2 postprocess_config
62              
63             A hook to do any work after the configuration is initially processed.
64              
65             =cut
66              
67 0     0 1 0 sub postprocess_config { 1 };
68              
69             =head2 pre_create_distro
70              
71             A hook to do any work right before the distro is created.
72              
73             =cut
74              
75 0     0 1 0 sub pre_create_distro { 1 };
76              
77             =head2 C<< create_distro(%args) >>
78              
79             This method works as advertised in L.
80              
81             =cut
82              
83             sub create_distro {
84 46     46 1 18129363 my $either = shift;
85              
86 46 50       363 ( ref $either ) or $either = $either->new( @_ );
87              
88 46         134 my $self = $either;
89 46   50     213 my $modules = $self->{modules} || [];
90 46         110 my @modules = map { split /,/ } @{$modules};
  552         1183  
  46         143  
91 46 50       174 croak "No modules specified.\n" unless @modules;
92 46         134 for (@modules) {
93 552 50       1862 croak "Invalid module name: $_" unless /\A[a-z_]\w*(?:::[\w]+)*\Z/i;
94             }
95              
96 46 50 33     312 if ( ( not $self->{author} ) && ( $^O ne 'MSWin32' ) ) {
97 0         0 ( $self->{author} ) = split /,/, ( getpwuid $> )[6];
98             }
99              
100 46 0 33     204 if ( not $self->{email} and exists $ENV{EMAIL} ) {
101 0         0 $self->{email} = $ENV{EMAIL};
102             }
103              
104 46 50       156 croak "Must specify an author\n" unless $self->{author};
105 46 50       140 croak "Must specify an email address\n" unless $self->{email};
106 46         269 ($self->{email_obfuscated} = $self->{email}) =~ s/@/ at /;
107              
108 46   50     171 $self->{license} ||= 'artistic2';
109 46   100     172 $self->{minperl} ||= '5.006';
110 46   100     162 $self->{ignores_type} ||= ['generic'];
111 46         105 $self->{manifest_skip} = !! grep { /manifest/ } @{ $self->{ignores_type} };
  178         524  
  46         141  
112            
113 46         282 $self->{license_record} = $self->_license_record();
114              
115 46         147 $self->{main_module} = $modules[0];
116 46 50 33     410 if ( not defined $self->{distro} or not length $self->{distro} ) {
117 0         0 $self->{distro} = $self->{main_module};
118 0         0 $self->{distro} =~ s/::/-/g;
119             }
120              
121 46   33     257 $self->{basedir} = $self->{dir} || $self->{distro};
122 46         195 $self->create_basedir;
123              
124 46         115 my @files;
125 46         273 push @files, $self->create_modules( @modules );
126              
127 46         416 push @files, $self->create_t( @modules );
128 46         249 push @files, $self->create_ignores;
129 46         320 my %build_results = $self->create_build();
130 46         205 push(@files, @{ $build_results{files} } );
  46         111  
131              
132 46         216 push @files, $self->create_Changes;
133 46         371 push @files, $self->create_README( $build_results{instructions} );
134              
135 46 100       181 $self->create_MANIFEST( $build_results{'manifest_method'} ) unless ( $self->{manifest_skip} );
136             # TODO: put files to ignore in a more standard form?
137             # XXX: no need to return the files created
138              
139 46         704 return;
140             }
141              
142             =head2 post_create_distro
143              
144             A hook to do any work after creating the distribution.
145              
146             =cut
147              
148 0     0 1 0 sub post_create_distro { 1 };
149              
150             =head2 pre_exit
151              
152             A hook to do any work right before exit time.
153              
154             =cut
155              
156             sub pre_exit {
157 0     0 1 0 print "Created starter directories and files\n";
158             }
159              
160             =head2 create_basedir
161              
162             Creates the base directory for the distribution. If the directory already
163             exists, and I<$force> is true, then the existing directory will get erased.
164              
165             If the directory can't be created, or re-created, it dies.
166              
167             =cut
168              
169             sub create_basedir {
170 46     46 1 103 my $self = shift;
171              
172             # Make sure there's no directory
173 46 100       1937 if ( -e $self->{basedir} ) {
174             die( "$self->{basedir} already exists. ".
175             "Use --force if you want to stomp on it.\n"
176 22 50       177 ) unless $self->{force};
177              
178 22         159 local @ARGV = $self->{basedir};
179 22         204 rm_rf();
180              
181             die "Couldn't delete existing $self->{basedir}: $!\n"
182 22 50       134483 if -e $self->{basedir};
183             }
184              
185             CREATE_IT: {
186 46         143 $self->progress( "Created $self->{basedir}" );
  46         581  
187              
188 46         227 local @ARGV = $self->{basedir};
189 46         305 mkpath();
190              
191 46 50       11672 die "Couldn't create $self->{basedir}: $!\n" unless -d $self->{basedir};
192             }
193              
194 46         160 return;
195             }
196              
197             =head2 create_modules( @modules )
198              
199             This method will create a starter module file for each module named in
200             I<@modules>.
201              
202             =cut
203              
204             sub create_modules {
205 46     46 1 184 my $self = shift;
206 46         212 my @modules = @_;
207              
208 46         101 my @files;
209              
210 46         145 for my $module ( @modules ) {
211 552         1178 my $rtname = lc $module;
212 552         2391 $rtname =~ s/::/-/g;
213 552         1301 push @files, $self->_create_module( $module, $rtname );
214             }
215              
216 46         326 return @files;
217             }
218              
219             =head2 module_guts( $module, $rtname )
220              
221             This method returns the text which should serve as the contents for the named
222             module. I<$rtname> is the email suffix which rt.cpan.org will use for bug
223             reports. (This should, and will, be moved out of the parameters for this
224             method eventually.)
225              
226             =cut
227              
228             our $LICENSES = {
229             perl => {
230             license => 'perl',
231             slname => 'perl_5',
232             url => 'http://dev.perl.org/licenses/',
233             blurb => <<'EOT',
234             This program is free software; you can redistribute it and/or modify it
235             under the terms of either: the GNU General Public License as published
236             by the Free Software Foundation; or the Artistic License.
237              
238             See L for more information.
239             EOT
240             },
241             artistic => {
242             license => 'artistic',
243             slname => 'artistic_1',
244             url => 'http://www.perlfoundation.org/artistic_license_1_0',
245             blurb => <<'EOT',
246             This program is free software; you can redistribute it and/or modify it
247             under the terms of the the Artistic License (1.0). You may obtain a
248             copy of the full license at:
249              
250             L
251              
252             Aggregation of this Package with a commercial distribution is always
253             permitted provided that the use of this Package is embedded; that is,
254             when no overt attempt is made to make this Package's interfaces visible
255             to the end user of the commercial distribution. Such use shall not be
256             construed as a distribution of this Package.
257              
258             The name of the Copyright Holder may not be used to endorse or promote
259             products derived from this software without specific prior written
260             permission.
261              
262             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
263             WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
264             MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
265             EOT
266             },
267             artistic2 => {
268             license => 'artistic2',
269             slname => 'artistic_2',
270             url => 'http://www.perlfoundation.org/artistic_license_2_0',
271             blurb => <<'EOT',
272             This program is free software; you can redistribute it and/or modify it
273             under the terms of the the Artistic License (2.0). You may obtain a
274             copy of the full license at:
275              
276             L
277              
278             Any use, modification, and distribution of the Standard or Modified
279             Versions is governed by this Artistic License. By using, modifying or
280             distributing the Package, you accept this license. Do not use, modify,
281             or distribute the Package, if you do not accept this license.
282              
283             If your Modified Version has been derived from a Modified Version made
284             by someone other than you, you are nevertheless required to ensure that
285             your Modified Version complies with the requirements of this license.
286              
287             This license does not grant you the right to use any trademark, service
288             mark, tradename, or logo of the Copyright Holder.
289              
290             This license includes the non-exclusive, worldwide, free-of-charge
291             patent license to make, have made, use, offer to sell, sell, import and
292             otherwise transfer the Package with respect to any patent claims
293             licensable by the Copyright Holder that are necessarily infringed by the
294             Package. If you institute patent litigation (including a cross-claim or
295             counterclaim) against any party alleging that the Package constitutes
296             direct or contributory patent infringement, then this Artistic License
297             to you shall terminate on the date that such litigation is filed.
298              
299             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
300             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
301             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
302             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
303             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
304             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
305             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
306             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
307             EOT
308             },
309             mit => {
310             license => 'mit',
311             slname => 'mit',
312             url => 'http://www.opensource.org/licenses/mit-license.php',
313             blurb => <<'EOT',
314             This program is distributed under the MIT (X11) License:
315             L
316              
317             Permission is hereby granted, free of charge, to any person
318             obtaining a copy of this software and associated documentation
319             files (the "Software"), to deal in the Software without
320             restriction, including without limitation the rights to use,
321             copy, modify, merge, publish, distribute, sublicense, and/or sell
322             copies of the Software, and to permit persons to whom the
323             Software is furnished to do so, subject to the following
324             conditions:
325              
326             The above copyright notice and this permission notice shall be
327             included in all copies or substantial portions of the Software.
328              
329             THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
330             EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
331             OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
332             NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
333             HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
334             WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
335             FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
336             OTHER DEALINGS IN THE SOFTWARE.
337             EOT
338             },
339             mozilla => {
340             license => 'mozilla',
341             slname => 'mozilla_1_1',
342             url => 'http://www.mozilla.org/MPL/1.1/',
343             blurb => <<'EOT',
344             The contents of this file are subject to the Mozilla Public License
345             Version 1.1 (the "License"); you may not use this file except in
346             compliance with the License. You may obtain a copy of the License at
347             L
348              
349             Software distributed under the License is distributed on an "AS IS"
350             basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
351             License for the specific language governing rights and limitations
352             under the License.
353             EOT
354             },
355             mozilla2 => {
356             license => 'mozilla2',
357             slname => 'open_source',
358             url => 'http://www.mozilla.org/MPL/2.0/',
359             blurb => <<'EOT',
360             This Source Code Form is subject to the terms of the Mozilla Public
361             License, v. 2.0. If a copy of the MPL was not distributed with this
362             file, You can obtain one at L.
363             EOT
364             },
365             bsd => {
366             license => 'bsd',
367             slname => 'bsd',
368             url => 'http://www.opensource.org/licenses/BSD-3-Clause',
369             blurb => <<"EOT",
370             This program is distributed under the (Revised) BSD License:
371             L
372              
373             Redistribution and use in source and binary forms, with or without
374             modification, are permitted provided that the following conditions
375             are met:
376              
377             * Redistributions of source code must retain the above copyright
378             notice, this list of conditions and the following disclaimer.
379              
380             * Redistributions in binary form must reproduce the above copyright
381             notice, this list of conditions and the following disclaimer in the
382             documentation and/or other materials provided with the distribution.
383              
384             * Neither the name of ___AUTHOR___'s Organization
385             nor the names of its contributors may be used to endorse or promote
386             products derived from this software without specific prior written
387             permission.
388              
389             THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
390             "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
391             LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
392             A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
393             OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
394             SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
395             LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
396             DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
397             THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
398             (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
399             OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
400             EOT
401             },
402             freebsd => {
403             license => 'freebsd',
404             slname => 'freebsd',
405             url => 'http://www.opensource.org/licenses/BSD-2-Clause',
406             blurb => <<"EOT",
407             This program is distributed under the (Simplified) BSD License:
408             L
409              
410             Redistribution and use in source and binary forms, with or without
411             modification, are permitted provided that the following conditions
412             are met:
413              
414             * Redistributions of source code must retain the above copyright
415             notice, this list of conditions and the following disclaimer.
416              
417             * Redistributions in binary form must reproduce the above copyright
418             notice, this list of conditions and the following disclaimer in the
419             documentation and/or other materials provided with the distribution.
420              
421             THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
422             "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
423             LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
424             A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
425             OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
426             SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
427             LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
428             DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
429             THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
430             (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
431             OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
432             EOT
433             },
434             cc0 => {
435             license => 'cc0',
436             slname => 'unrestricted',
437             url => 'http://creativecommons.org/publicdomain/zero/1.0/',
438             blurb => <<'EOT',
439             This program is distributed under the CC0 1.0 Universal License:
440             L
441              
442             The person who associated a work with this deed has dedicated the work
443             to the public domain by waiving all of his or her rights to the work
444             worldwide under copyright law, including all related and neighboring
445             rights, to the extent allowed by law.
446              
447             You can copy, modify, distribute and perform the work, even for
448             commercial purposes, all without asking permission. See Other
449             Information below.
450              
451             Other Information:
452              
453             * In no way are the patent or trademark rights of any person affected
454             by CC0, nor are the rights that other persons may have in the work or
455             in how the work is used, such as publicity or privacy rights.
456              
457             * Unless expressly stated otherwise, the person who associated a work
458             with this deed makes no warranties about the work, and disclaims
459             liability for all uses of the work, to the fullest extent permitted
460             by applicable law.
461              
462             * When using or citing the work, you should not imply endorsement by
463             the author or the affirmer.
464             EOT
465             },
466             gpl => {
467             license => 'gpl',
468             slname => 'gpl_2',
469             url => 'http://www.gnu.org/licenses/gpl-2.0.html',
470             blurb => <<'EOT',
471             This program is free software; you can redistribute it and/or modify
472             it under the terms of the GNU General Public License as published by
473             the Free Software Foundation; version 2 dated June, 1991 or at your option
474             any later version.
475              
476             This program is distributed in the hope that it will be useful,
477             but WITHOUT ANY WARRANTY; without even the implied warranty of
478             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
479             GNU General Public License for more details.
480              
481             A copy of the GNU General Public License is available in the source tree;
482             if not, write to the Free Software Foundation, Inc.,
483             51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
484             EOT
485             },
486             lgpl => {
487             license => 'lgpl',
488             slname => 'lgpl_2_1',
489             url => 'http://www.gnu.org/licenses/lgpl-2.1.html',
490             blurb => <<'EOT',
491             This program is free software; you can redistribute it and/or
492             modify it under the terms of the GNU Lesser General Public
493             License as published by the Free Software Foundation; either
494             version 2.1 of the License, or (at your option) any later version.
495              
496             This program is distributed in the hope that it will be useful,
497             but WITHOUT ANY WARRANTY; without even the implied warranty of
498             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
499             Lesser General Public License for more details.
500              
501             You should have received a copy of the GNU Lesser General Public
502             License along with this program; if not, write to the Free
503             Software Foundation, Inc.,
504             51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
505             EOT
506             },
507             gpl3 => {
508             license => 'gpl3',
509             slname => 'gpl_3',
510             url => 'http://www.gnu.org/licenses/gpl-3.0.html',
511             blurb => <<'EOT',
512             This program is free software: you can redistribute it and/or modify
513             it under the terms of the GNU General Public License as published by
514             the Free Software Foundation, either version 3 of the License, or
515             (at your option) any later version.
516              
517             This program is distributed in the hope that it will be useful,
518             but WITHOUT ANY WARRANTY; without even the implied warranty of
519             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
520             GNU General Public License for more details.
521              
522             You should have received a copy of the GNU General Public License
523             along with this program. If not, see L.
524             EOT
525             },
526             lgpl3 => {
527             license => 'lgpl3',
528             slname => 'lgpl_3_0',
529             url => 'http://www.gnu.org/licenses/lgpl-3.0.html',
530             blurb => <<'EOT',
531             This program is free software; you can redistribute it and/or
532             modify it under the terms of the GNU Lesser General Public
533             License as published by the Free Software Foundation; either
534             version 3 of the License, or (at your option) any later version.
535              
536             This program is distributed in the hope that it will be useful,
537             but WITHOUT ANY WARRANTY; without even the implied warranty of
538             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
539             Lesser General Public License for more details.
540              
541             You should have received a copy of the GNU Lesser General Public
542             License along with this program. If not, see
543             L.
544             EOT
545             },
546             agpl3 => {
547             license => 'agpl3',
548             slname => 'agpl_3',
549             url => 'http://www.gnu.org/licenses/agpl-3.0.html',
550             blurb => <<'EOT',
551             This program is free software; you can redistribute it and/or
552             modify it under the terms of the GNU Affero General Public
553             License as published by the Free Software Foundation; either
554             version 3 of the License, or (at your option) any later version.
555              
556             This program is distributed in the hope that it will be useful,
557             but WITHOUT ANY WARRANTY; without even the implied warranty of
558             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
559             Affero General Public License for more details.
560              
561             You should have received a copy of the GNU Affero General Public
562             License along with this program. If not, see
563             L.
564             EOT
565             },
566             apache => {
567             license => 'apache',
568             slname => 'apache_2_0',
569             url => 'http://www.apache.org/licenses/LICENSE-2.0',
570             blurb => <<'EOT',
571             Licensed under the Apache License, Version 2.0 (the "License");
572             you may not use this file except in compliance with the License.
573             You may obtain a copy of the License at
574              
575             L
576              
577             Unless required by applicable law or agreed to in writing, software
578             distributed under the License is distributed on an "AS IS" BASIS,
579             WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
580             See the License for the specific language governing permissions and
581             limitations under the License.
582             EOT
583             },
584             qpl => {
585             license => 'qpl',
586             slname => 'qpl_1_0',
587             url => 'http://www.opensource.org/licenses/QPL-1.0',
588             blurb => <<'EOT',
589             This program is distributed under the Q Public License (QPL-1.0):
590             L
591              
592             The Software and this license document are provided AS IS with NO
593             WARRANTY OF ANY KIND, INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY
594             AND FITNESS FOR A PARTICULAR PURPOSE.
595             EOT
596             },
597            
598            
599             };
600              
601 46     46   234 sub _license_record { $LICENSES->{ shift->{license} }; }
602              
603             sub _license_blurb {
604 598     598   748 my $self = shift;
605              
606 598         898 my $record = $self->{license_record};
607             my $license_blurb = defined($record) ?
608             $record->{blurb} :
609 598 50       1190 <<"EOT";
610             This program is released under the following license: $self->{license}
611             EOT
612              
613 598         1382 $license_blurb =~ s/___AUTHOR___/$self->{author}/ge;
  0         0  
614 598         1506 chomp $license_blurb;
615 598         1076 return $license_blurb;
616             }
617              
618             # _create_module: used by create_modules to build each file and put data in it
619              
620             sub _create_module {
621 552     552   728 my $self = shift;
622 552         713 my $module = shift;
623 552         688 my $rtname = shift;
624              
625 552         1546 my @parts = split( /::/, $module );
626 552         1113 my $filepart = (pop @parts) . '.pm';
627 552         1516 my @dirparts = ( $self->{basedir}, 'lib', @parts );
628 552         704 my $SLASH = q{/};
629 552         1378 my $manifest_file = join( $SLASH, 'lib', @parts, $filepart );
630 552 50       973 if ( @dirparts ) {
631 552         4235 my $dir = File::Spec->catdir( @dirparts );
632 552 100       11279 if ( not -d $dir ) {
633 461         1764 local @ARGV = $dir;
634 461         1578 mkpath @ARGV;
635 461         102936 $self->progress( "Created $dir" );
636             }
637             }
638              
639 552         4915 my $module_file = File::Spec->catfile( @dirparts, $filepart );
640              
641 552         3984 $self->{module_file}{$module} = File::Spec->catfile('lib', @parts, $filepart);
642 552         1723 $self->create_file( $module_file, $self->module_guts( $module, $rtname ) );
643 552         2913 $self->progress( "Created $module_file" );
644              
645 552         2023 return $manifest_file;
646             }
647              
648             sub _thisyear {
649 598     598   13529 return (localtime())[5] + 1900;
650             }
651              
652             sub _module_to_pm_file {
653 598     598   793 my $self = shift;
654 598         661 my $module = shift;
655              
656 598         1293 my @parts = split( /::/, $module );
657 598         910 my $pm = pop @parts;
658 598         2982 my $pm_file = File::Spec->catfile( 'lib', @parts, "${pm}.pm" );
659 598         1257 $pm_file =~ s{\\}{/}g; # even on Win32, use forward slash
660              
661 598         1901 return $pm_file;
662             }
663              
664             sub _reference_links {
665             return (
666 598     598   3554 { nickname => 'RT',
667             title => 'CPAN\'s request tracker (report bugs here)',
668             link => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=%s',
669             },
670             { nickname => 'AnnoCPAN',
671             title => 'Annotated CPAN documentation',
672             link => 'http://annocpan.org/dist/%s',
673             },
674             { title => 'CPAN Ratings',
675             link => 'https://cpanratings.perl.org/d/%s',
676             },
677             { title => 'Search CPAN',
678             link => 'https://metacpan.org/release/%s',
679             },
680             );
681             }
682              
683             =head2 create_Makefile_PL( $main_module )
684              
685             This will create the Makefile.PL for the distribution, and will use the module
686             named in I<$main_module> as the main module of the distribution.
687              
688             =cut
689              
690             sub create_Makefile_PL {
691 28     28 1 114 my $self = shift;
692 28         152 my $main_module = shift;
693 28         85 my $builder_name = 'ExtUtils::MakeMaker';
694 28         93 my $output_file =
695             Module::Starter::BuilderSet->new()->file_for_builder($builder_name);
696 28         409 my $fname = File::Spec->catfile( $self->{basedir}, $output_file );
697              
698 28         130 $self->create_file(
699             $fname,
700             $self->Makefile_PL_guts(
701             $main_module,
702             $self->_module_to_pm_file($main_module),
703             ),
704             );
705              
706 28         224 $self->progress( "Created $fname" );
707              
708 28         80 return $output_file;
709             }
710              
711             =head2 create_MI_Makefile_PL( $main_module )
712              
713             This will create a Module::Install Makefile.PL for the distribution, and will
714             use the module named in I<$main_module> as the main module of the distribution.
715              
716             =cut
717              
718             sub create_MI_Makefile_PL {
719 0     0 1 0 my $self = shift;
720 0         0 my $main_module = shift;
721 0         0 my $builder_name = 'Module::Install';
722 0         0 my $output_file =
723             Module::Starter::BuilderSet->new()->file_for_builder($builder_name);
724 0         0 my $fname = File::Spec->catfile( $self->{basedir}, $output_file );
725              
726 0         0 $self->create_file(
727             $fname,
728             $self->MI_Makefile_PL_guts(
729             $main_module,
730             $self->_module_to_pm_file($main_module),
731             ),
732             );
733              
734 0         0 $self->progress( "Created $fname" );
735              
736 0         0 return $output_file;
737             }
738              
739             =head2 Makefile_PL_guts( $main_module, $main_pm_file )
740              
741             This method is called by create_Makefile_PL and returns text used to populate
742             Makefile.PL; I<$main_pm_file> is the filename of the distribution's main
743             module, I<$main_module>.
744              
745             =cut
746              
747             sub Makefile_PL_guts {
748 28     28 1 160 my $self = shift;
749 28         122 my $main_module = shift;
750 28         78 my $main_pm_file = shift;
751              
752 28         161 (my $author = "$self->{author} <$self->{email}>") =~ s/'/\'/g;
753            
754 28 50       116 my $slname = $self->{license_record} ? $self->{license_record}->{slname} : $self->{license};
755              
756 28 50       141 my $warnings = sprintf 'warnings%s;', ($self->{fatalize} ? " FATAL => 'all'" : '');
757              
758 28         337 return <<"HERE";
759             use $self->{minperl};
760             use strict;
761             use $warnings
762             use ExtUtils::MakeMaker;
763              
764             WriteMakefile(
765             NAME => '$main_module',
766             AUTHOR => q{$author},
767             VERSION_FROM => '$main_pm_file',
768             ABSTRACT_FROM => '$main_pm_file',
769             LICENSE => '$slname',
770             PL_FILES => {},
771             MIN_PERL_VERSION => '$self->{minperl}',
772             CONFIGURE_REQUIRES => {
773             'ExtUtils::MakeMaker' => '0',
774             },
775             BUILD_REQUIRES => {
776             'Test::More' => '0',
777             },
778             PREREQ_PM => {
779             #'ABC' => '1.6',
780             #'Foo::Bar::Module' => '5.0401',
781             },
782             dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
783             clean => { FILES => '$self->{distro}-*' },
784             );
785             HERE
786              
787             }
788              
789             =head2 MI_Makefile_PL_guts( $main_module, $main_pm_file )
790              
791             This method is called by create_MI_Makefile_PL and returns text used to populate
792             Makefile.PL; I<$main_pm_file> is the filename of the distribution's main
793             module, I<$main_module>.
794              
795             =cut
796              
797             sub MI_Makefile_PL_guts {
798 0     0 1 0 my $self = shift;
799 0         0 my $main_module = shift;
800 0         0 my $main_pm_file = shift;
801              
802 0         0 my $author = "$self->{author} <$self->{email}>";
803 0         0 $author =~ s/'/\'/g;
804            
805 0 0       0 my $license_url = $self->{license_record} ? $self->{license_record}->{url} : '';
806              
807 0 0       0 my $warnings = sprintf 'warnings%s;', ($self->{fatalize} ? " FATAL => 'all'" : '');
808              
809 0         0 return <<"HERE";
810             use $self->{minperl};
811             use strict;
812             use $warnings
813             use inc::Module::Install;
814              
815             name '$self->{distro}';
816             all_from '$main_pm_file';
817             author q{$author};
818             license '$self->{license}';
819              
820             perl_version '$self->{minperl}';
821              
822             tests_recursive('t');
823              
824             resources (
825             #homepage => 'http://yourwebsitehere.com',
826             #IRC => 'irc://irc.perl.org/#$self->{distro}',
827             license => '$license_url',
828             #repository => 'git://github.com/$self->{author}/$self->{distro}.git',
829             #repository => 'https://bitbucket.org/$self->{author}/$self->{distro}',
830             bugtracker => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=$self->{distro}',
831             );
832              
833             configure_requires (
834             'Module::Install' => '0',
835             );
836              
837             build_requires (
838             'Test::More' => '0',
839             );
840              
841             requires (
842             #'ABC' => '1.6',
843             #'Foo::Bar::Module' => '5.0401',
844             );
845              
846             install_as_cpan;
847             auto_install;
848             WriteAll;
849             HERE
850              
851             }
852              
853             =head2 create_Build_PL( $main_module )
854              
855             This will create the Build.PL for the distribution, and will use the module
856             named in I<$main_module> as the main module of the distribution.
857              
858             =cut
859              
860             sub create_Build_PL {
861 18     18 1 46 my $self = shift;
862 18         38 my $main_module = shift;
863 18         39 my $builder_name = 'Module::Build';
864 18         60 my $output_file =
865             Module::Starter::BuilderSet->new()->file_for_builder($builder_name);
866 18         245 my $fname = File::Spec->catfile( $self->{basedir}, $output_file );
867              
868 18         101 $self->create_file(
869             $fname,
870             $self->Build_PL_guts(
871             $main_module,
872             $self->_module_to_pm_file($main_module),
873             ),
874             );
875              
876 18         125 $self->progress( "Created $fname" );
877              
878 18         58 return $output_file;
879             }
880              
881             =head2 Build_PL_guts( $main_module, $main_pm_file )
882              
883             This method is called by create_Build_PL and returns text used to populate
884             Build.PL; I<$main_pm_file> is the filename of the distribution's main module,
885             I<$main_module>.
886              
887             =cut
888              
889             sub Build_PL_guts {
890 18     18 1 32 my $self = shift;
891 18         29 my $main_module = shift;
892 18         99 my $main_pm_file = shift;
893              
894 18         139 (my $author = "$self->{author} <$self->{email}>") =~ s/'/\'/g;
895              
896 18 50       90 my $slname = $self->{license_record} ? $self->{license_record}->{slname} : $self->{license};
897            
898 18 50       98 my $warnings = sprintf 'warnings%s;', ($self->{fatalize} ? " FATAL => 'all'" : '');
899              
900 18         180 return <<"HERE";
901             use $self->{minperl};
902             use strict;
903             use $warnings
904             use Module::Build;
905              
906             my \$builder = Module::Build->new(
907             module_name => '$main_module',
908             license => '$slname',
909             dist_author => q{$author},
910             dist_version_from => '$main_pm_file',
911             release_status => 'stable',
912             configure_requires => {
913             'Module::Build' => '0',
914             },
915             build_requires => {
916             'Test::More' => '0',
917             },
918             requires => {
919             #'ABC' => '1.6',
920             #'Foo::Bar::Module' => '5.0401',
921             },
922             add_to_cleanup => [ '$self->{distro}-*' ],
923             );
924              
925             \$builder->create_build_script();
926             HERE
927              
928             }
929              
930             =head2 create_Changes( )
931              
932             This method creates a skeletal Changes file.
933              
934             =cut
935              
936             sub create_Changes {
937 46     46 1 93 my $self = shift;
938              
939 46         469 my $fname = File::Spec->catfile( $self->{basedir}, 'Changes' );
940 46         227 $self->create_file( $fname, $self->Changes_guts() );
941 46         321 $self->progress( "Created $fname" );
942              
943 46         165 return 'Changes';
944             }
945              
946             =head2 Changes_guts
947              
948             Called by create_Changes, this method returns content for the Changes file.
949              
950             =cut
951              
952             sub Changes_guts {
953 46     46 1 67 my $self = shift;
954              
955 46         187 return <<"HERE";
956             Revision history for $self->{distro}
957              
958             0.01 Date/time
959             First version, released on an unsuspecting world.
960              
961             HERE
962             }
963              
964             =head2 create_README( $build_instructions )
965              
966             This method creates the distribution's README file.
967              
968             =cut
969              
970             sub create_README {
971 46     46 1 86 my $self = shift;
972 46         87 my $build_instructions = shift;
973              
974 46         507 my $fname = File::Spec->catfile( $self->{basedir}, 'README' );
975 46         233 $self->create_file( $fname, $self->README_guts($build_instructions) );
976 46         372 $self->progress( "Created $fname" );
977              
978 46         135 return 'README';
979             }
980              
981             =head2 README_guts
982              
983             Called by create_README, this method returns content for the README file.
984              
985             =cut
986              
987             sub _README_intro {
988 46     46   82 my $self = shift;
989              
990 46         109 return <<"HERE";
991             The README is used to introduce the module and provide instructions on
992             how to install the module, any machine dependencies it may have (for
993             example C compilers and installed libraries) and any other information
994             that should be provided before the module is installed.
995              
996             A README file is required for CPAN modules since CPAN extracts the README
997             file from a module distribution so that people browsing the archive
998             can use it to get an idea of the module's uses. It is usually a good idea
999             to provide version information here so that people can decide whether
1000             fixes for the module are worth downloading.
1001             HERE
1002             }
1003              
1004             sub _README_information {
1005 46     46   74 my $self = shift;
1006              
1007 46         119 my @reference_links = _reference_links();
1008              
1009 46         96 my $content = "You can also look for information at:\n";
1010              
1011 46         146 foreach my $ref (@reference_links){
1012 184         233 my $title;
1013 184 100       382 $title = "$ref->{nickname}, " if exists $ref->{nickname};
1014 184         233 $title .= $ref->{title};
1015 184         557 my $link = sprintf($ref->{link}, $self->{distro});
1016              
1017 184         523 $content .= qq[
1018             $title
1019             $link
1020             ];
1021             }
1022              
1023 46         203 return $content;
1024             }
1025              
1026             sub _README_license {
1027 46     46   123 my $self = shift;
1028              
1029 46         124 my $year = $self->_thisyear();
1030 46         162 my $license_blurb = $self->_license_blurb();
1031              
1032 46         431 return <<"HERE";
1033             LICENSE AND COPYRIGHT
1034              
1035             Copyright (C) $year $self->{author}
1036              
1037             $license_blurb
1038             HERE
1039             }
1040              
1041             sub README_guts {
1042 46     46 1 89 my $self = shift;
1043 46         79 my $build_instructions = shift;
1044              
1045 46         136 my $intro = $self->_README_intro();
1046 46         133 my $information = $self->_README_information();
1047 46         142 my $license = $self->_README_license();
1048              
1049 46         508 return <<"HERE";
1050             $self->{distro}
1051              
1052             $intro
1053              
1054             INSTALLATION
1055              
1056             $build_instructions
1057              
1058             SUPPORT AND DOCUMENTATION
1059              
1060             After installing, you can find documentation for this module with the
1061             perldoc command.
1062              
1063             perldoc $self->{main_module}
1064              
1065             $information
1066              
1067             $license
1068             HERE
1069             }
1070              
1071             =head2 create_t( @modules )
1072              
1073             This method creates a bunch of *.t files. I<@modules> is a list of all modules
1074             in the distribution.
1075              
1076             =cut
1077              
1078             sub create_t {
1079 46     46 1 104 my $self = shift;
1080 46         191 my @modules = @_;
1081              
1082 46         202 my %t_files = $self->t_guts(@modules);
1083 46         228 my %xt_files = $self->xt_guts(@modules);
1084              
1085 46         78 my @files;
1086 46         159 push @files, map { $self->_create_t('t', $_, $t_files{$_}) } keys %t_files;
  184         396  
1087 46         360 push @files, map { $self->_create_t('xt', $_, $xt_files{$_}) } keys %xt_files;
  46         148  
1088              
1089 46         365 return @files;
1090             }
1091              
1092             =head2 t_guts( @modules )
1093              
1094             This method is called by create_t, and returns a description of the *.t files
1095             to be created.
1096              
1097             The return value is a hash of test files to create. Each key is a filename and
1098             each value is the contents of that file.
1099              
1100             =cut
1101              
1102             sub t_guts {
1103 46     46 1 115 my $self = shift;
1104 46         133 my @modules = @_;
1105              
1106 46         92 my %t_files;
1107 46         117 my $minperl = $self->{minperl};
1108 46 50       326 my $warnings = sprintf 'warnings%s;', ($self->{fatalize} ? " FATAL => 'all'" : '');
1109              
1110 46         220 my $header = <<"EOH";
1111             #!perl -T
1112             use $minperl;
1113             use strict;
1114             use $warnings
1115             use Test::More;
1116              
1117             EOH
1118            
1119 46         208 $t_files{'pod.t'} = $header.<<'HERE';
1120             unless ( $ENV{RELEASE_TESTING} ) {
1121             plan( skip_all => "Author tests not required for installation" );
1122             }
1123              
1124             # Ensure a recent version of Test::Pod
1125             my $min_tp = 1.22;
1126             eval "use Test::Pod $min_tp";
1127             plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
1128              
1129             all_pod_files_ok();
1130             HERE
1131              
1132 46         154 $t_files{'manifest.t'} = $header.<<'HERE';
1133             unless ( $ENV{RELEASE_TESTING} ) {
1134             plan( skip_all => "Author tests not required for installation" );
1135             }
1136              
1137             my $min_tcm = 0.9;
1138             eval "use Test::CheckManifest $min_tcm";
1139             plan skip_all => "Test::CheckManifest $min_tcm required" if $@;
1140              
1141             ok_manifest();
1142             HERE
1143              
1144 46         169 $t_files{'pod-coverage.t'} = $header.<<'HERE';
1145             unless ( $ENV{RELEASE_TESTING} ) {
1146             plan( skip_all => "Author tests not required for installation" );
1147             }
1148              
1149             # Ensure a recent version of Test::Pod::Coverage
1150             my $min_tpc = 1.08;
1151             eval "use Test::Pod::Coverage $min_tpc";
1152             plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
1153             if $@;
1154              
1155             # Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
1156             # but older versions don't recognize some common documentation styles
1157             my $min_pc = 0.18;
1158             eval "use Pod::Coverage $min_pc";
1159             plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
1160             if $@;
1161              
1162             all_pod_coverage_ok();
1163             HERE
1164              
1165 46         99 my $nmodules = @modules;
1166 46         90 my $main_module = $modules[0];
1167             my $use_lines = join(
1168 46         113 "\n", map { qq{ use_ok( '$_' ) || print "Bail out!\\n";} } @modules
  552         1434  
1169             );
1170              
1171 46         392 $t_files{'00-load.t'} = $header.<<"HERE";
1172             plan tests => $nmodules;
1173              
1174             BEGIN {
1175             $use_lines
1176             }
1177              
1178             diag( "Testing $main_module \$${main_module}::VERSION, Perl \$], \$^X" );
1179             HERE
1180              
1181 46         311 return %t_files;
1182             }
1183              
1184             =head2 xt_guts( @modules )
1185              
1186             This method is called by create_t, and returns a description of the author
1187             only *.t files to be created in the xt directory.
1188              
1189             The return value is a hash of test files to create. Each key is a filename and
1190             each value is the contents of that file.
1191              
1192             =cut
1193              
1194             sub xt_guts {
1195 46     46 1 118 my $self = shift;
1196 46         151 my @modules = @_;
1197              
1198 46         66 my %xt_files;
1199 46         105 my $minperl = $self->{minperl};
1200 46 50       167 my $warnings = sprintf 'warnings%s;', ($self->{fatalize} ? " FATAL => 'all'" : '');
1201              
1202 46         148 my $header = <<"EOH";
1203             #!perl -T
1204             use $minperl;
1205             use strict;
1206             use $warnings
1207             use Test::More;
1208              
1209             EOH
1210              
1211 46         79 my $module_boilerplate_tests;
1212             $module_boilerplate_tests .=
1213 46         240 " module_boilerplate_ok('".$self->_module_to_pm_file($_)."');\n" for @modules;
1214              
1215 46         100 my $boilerplate_tests = @modules + 2;
1216 46         357 $xt_files{'boilerplate.t'} = $header.<<"HERE";
1217             plan tests => $boilerplate_tests;
1218              
1219             sub not_in_file_ok {
1220             my (\$filename, \%regex) = \@_;
1221             open( my \$fh, '<', \$filename )
1222             or die "couldn't open \$filename for reading: \$!";
1223              
1224             my \%violated;
1225              
1226             while (my \$line = <\$fh>) {
1227             while (my (\$desc, \$regex) = each \%regex) {
1228             if (\$line =~ \$regex) {
1229             push \@{\$violated{\$desc}||=[]}, \$.;
1230             }
1231             }
1232             }
1233              
1234             if (\%violated) {
1235             fail("\$filename contains boilerplate text");
1236             diag "\$_ appears on lines \@{\$violated{\$_}}" for keys \%violated;
1237             } else {
1238             pass("\$filename contains no boilerplate text");
1239             }
1240             }
1241              
1242             sub module_boilerplate_ok {
1243             my (\$module) = \@_;
1244             not_in_file_ok(\$module =>
1245             'the great new \$MODULENAME' => qr/ - The great new /,
1246             'boilerplate description' => qr/Quick summary of what the module/,
1247             'stub function definition' => qr/function[12]/,
1248             );
1249             }
1250              
1251             TODO: {
1252             local \$TODO = "Need to replace the boilerplate text";
1253              
1254             not_in_file_ok(README =>
1255             "The README is used..." => qr/The README is used/,
1256             "'version information here'" => qr/to provide version information/,
1257             );
1258              
1259             not_in_file_ok(Changes =>
1260             "placeholder date/time" => qr(Date/time)
1261             );
1262              
1263             $module_boilerplate_tests
1264              
1265             }
1266              
1267             HERE
1268              
1269 46         252 return %xt_files;
1270             }
1271              
1272             sub _create_t {
1273 230     230   305 my $self = shift;
1274 230         298 my $directory = shift; # 't' or 'xt'
1275 230         313 my $filename = shift;
1276 230         273 my $content = shift;
1277              
1278 230         471 my @dirparts = ( $self->{basedir}, $directory );
1279 230         1472 my $tdir = File::Spec->catdir( @dirparts );
1280 230 100       3989 if ( not -d $tdir ) {
1281 92         356 local @ARGV = $tdir;
1282 92         356 mkpath();
1283 92         9817 $self->progress( "Created $tdir" );
1284             }
1285              
1286 230         1934 my $fname = File::Spec->catfile( @dirparts, $filename );
1287 230         703 $self->create_file( $fname, $content );
1288 230         1072 $self->progress( "Created $fname" );
1289              
1290 230         1016 return join('/', $directory, $filename );
1291             }
1292              
1293             =head2 create_MB_MANIFEST
1294              
1295             This methods creates a MANIFEST file using Module::Build's methods.
1296              
1297             =cut
1298              
1299             sub create_MB_MANIFEST {
1300 2     2 1 5 my $self = shift;
1301 2         6 $self->create_EUMM_MANIFEST;
1302             }
1303              
1304             =head2 create_MI_MANIFEST
1305              
1306             This method creates a MANIFEST file using Module::Install's methods.
1307              
1308             Currently runs ExtUtils::MakeMaker's methods.
1309              
1310             =cut
1311              
1312             sub create_MI_MANIFEST {
1313 0     0 1 0 my $self = shift;
1314 0         0 $self->create_EUMM_MANIFEST;
1315             }
1316              
1317             =head2 create_EUMM_MANIFEST
1318              
1319             This method creates a MANIFEST file using ExtUtils::MakeMaker's methods.
1320              
1321             =cut
1322              
1323             sub create_EUMM_MANIFEST {
1324 2     2 1 4 my $self = shift;
1325 2         5226 my $orig_dir = cwd();
1326              
1327             # create the MANIFEST in the correct path
1328 2 50       70 chdir $self->{'basedir'} || die "Can't reach basedir: $!\n";
1329              
1330 2         818 require ExtUtils::Manifest;
1331 2         8227 $ExtUtils::Manifest::Quiet = 0;
1332 2         37 ExtUtils::Manifest::mkmanifest();
1333              
1334             # return to our original path, wherever it was
1335 2 50       7457 chdir $orig_dir || die "Can't return to original dir: $!\n";
1336             }
1337              
1338             =head2 create_MANIFEST( $method )
1339              
1340             This method creates the distribution's MANIFEST file. It must be run last,
1341             because all the other create_* functions have been returning the functions they
1342             create.
1343              
1344             It receives a method to run in order to create the MANIFEST file. That way it
1345             can create a MANIFEST file according to the builder used.
1346              
1347             =cut
1348              
1349             sub create_MANIFEST {
1350 2     2 1 5 my ( $self, $manifest_method ) = @_;
1351 2         24 my $fname = File::Spec->catfile( $self->{basedir}, 'MANIFEST' );
1352              
1353 2         10 $self->$manifest_method();
1354 2         93 $self->filter_lines_in_file(
1355             $fname,
1356             qr/^xt\/boilerplate\.t$/,
1357             qr/^ignore\.txt$/,
1358             );
1359              
1360 2         15 $self->progress( "Created $fname" );
1361              
1362 2         20 return 'MANIFEST';
1363             }
1364              
1365             =head2 get_builders( )
1366              
1367             This methods gets the correct builder(s).
1368              
1369             It is called by C, and returns an arrayref with the builders.
1370              
1371             =cut
1372              
1373             sub get_builders {
1374 46     46 1 88 my $self = shift;
1375              
1376             # pass one: pull the builders out of $self->{builder}
1377             my @tmp =
1378 0         0 ref $self->{'builder'} eq 'ARRAY' ? @{ $self->{'builder'} }
1379 46 50       211 : $self->{'builder'};
1380              
1381 46         92 my @builders;
1382 46         103 my $COMMA = q{,};
1383             # pass two: expand comma-delimited builder lists
1384 46         142 foreach my $builder (@tmp) {
1385 46         1046 push( @builders, split( $COMMA, $builder ) );
1386             }
1387              
1388 46         214 return \@builders;
1389             }
1390              
1391             =head2 create_build( )
1392              
1393             This method creates the build file(s) and puts together some build
1394             instructions. The builders currently supported are:
1395              
1396             ExtUtils::MakeMaker
1397             Module::Build
1398             Module::Install
1399              
1400             =cut
1401              
1402             sub create_build {
1403 46     46 1 90 my $self = shift;
1404              
1405             # get the builders
1406 46         113 my @builders = @{ $self->get_builders };
  46         163  
1407 46         541 my $builder_set = Module::Starter::BuilderSet->new();
1408              
1409             # Remove mutually exclusive and unsupported builders
1410 46         222 @builders = $builder_set->check_compatibility( @builders );
1411              
1412             # compile some build instructions, create a list of files generated
1413             # by the builders' create_* methods, and call said methods
1414              
1415 46         140 my @build_instructions;
1416             my @files;
1417 46         0 my $manifest_method;
1418              
1419 46         140 foreach my $builder ( @builders ) {
1420 46 50       125 if ( !@build_instructions ) {
1421 46         82 push( @build_instructions,
1422             'To install this module, run the following commands:'
1423             );
1424             }
1425             else {
1426 0         0 push( @build_instructions,
1427             "Alternatively, to install with $builder, you can ".
1428             "use the following commands:"
1429             );
1430             }
1431 46         133 push( @files, $builder_set->file_for_builder($builder) );
1432 46         240 my @commands = $builder_set->instructions_for_builder($builder);
1433 46         137 push( @build_instructions, join("\n", map { "\t$_" } @commands) );
  184         445  
1434              
1435 46         182 my $build_method = $builder_set->method_for_builder($builder);
1436 46         366 $self->$build_method($self->{main_module});
1437              
1438 46         315 $manifest_method = $builder_set->manifest_method($builder);
1439             }
1440              
1441             return(
1442 46         607 files => [ @files ],
1443             instructions => join( "\n\n", @build_instructions ),
1444             manifest_method => $manifest_method,
1445             );
1446             }
1447              
1448              
1449             =head2 create_ignores()
1450              
1451             This creates a text file for use as MANIFEST.SKIP, .cvsignore,
1452             .gitignore, or whatever you use.
1453              
1454             =cut
1455              
1456             sub create_ignores {
1457 46     46 1 80 my $self = shift;
1458 46         118 my $type = $self->{ignores_type};
1459 46         399 my %names = (
1460             generic => 'ignore.txt',
1461             cvs => '.cvsignore',
1462             git => '.gitignore',
1463             hg => '.hgignore',
1464             manifest => 'MANIFEST.SKIP',
1465             );
1466              
1467             my $create_file = sub {
1468 178     178   249 my $type = shift;
1469 178         341 my $name = $names{$type};
1470 178         1671 my $fname = File::Spec->catfile( $self->{basedir}, $names{$type} );
1471 178         540 $self->create_file( $fname, $self->ignores_guts($type) );
1472 178         891 $self->progress( "Created $fname" );
1473 46         314 };
1474              
1475 46 50       177 if ( ref $type eq 'ARRAY' ) {
    0          
1476 46         59 foreach my $single_type ( @{$type} ) {
  46         129  
1477 178         329 $create_file->($single_type);
1478             }
1479             } elsif ( ! ref $type ) {
1480 0         0 $create_file->($type);
1481             }
1482              
1483 46         443 return; # Not a file that goes in the MANIFEST
1484             }
1485              
1486             =head2 ignores_guts()
1487              
1488             Called by C, this method returns the contents of the
1489             ignore file.
1490              
1491             =cut
1492              
1493             sub ignores_guts {
1494 178     178 1 384 my ($self, $type) = @_;
1495              
1496 178 100       398 my $ms = $self->{manifest_skip} ? "MANIFEST\nMANIFEST.bak\n" : '';
1497 178         811 my $guts = {
1498             generic => $ms.<<"EOF",
1499             Makefile
1500             Makefile.old
1501             Build
1502             Build.bat
1503             META.*
1504             MYMETA.*
1505             .build/
1506             _build/
1507             cover_db/
1508             blib/
1509             inc/
1510             .lwpcookies
1511             .last_cover_stats
1512             nytprof.out
1513             pod2htm*.tmp
1514             pm_to_blib
1515             $self->{distro}-*
1516             $self->{distro}-*.tar.gz
1517             EOF
1518             # make this more restrictive, since MANIFEST tends to be less noticeable
1519             # (also, manifest supports REs.)
1520             manifest => <<'EOF',
1521             # Top-level filter (only include the following...)
1522             ^(?!(?:script|examples|lib|inc|t|xt|maint)/|(?:(?:Makefile|Build)\.PL|README|MANIFEST|Changes|META\.(?:yml|json))$)
1523              
1524             # Avoid version control files.
1525             \bRCS\b
1526             \bCVS\b
1527             ,v$
1528             \B\.svn\b
1529             \b_darcs\b
1530             # (.git or .hg only in top-level, hence it's blocked above)
1531              
1532             # Avoid temp and backup files.
1533             ~$
1534             \.tmp$
1535             \.old$
1536             \.bak$
1537             \..*?\.sw[po]$
1538             \#$
1539             \b\.#
1540              
1541             # avoid OS X finder files
1542             \.DS_Store$
1543              
1544             # ditto for Windows
1545             \bdesktop\.ini$
1546             \b[Tt]humbs\.db$
1547              
1548             # Avoid patch remnants
1549             \.orig$
1550             \.rej$
1551             EOF
1552             };
1553 178         471 $guts->{hg} = $guts->{cvs} = $guts->{git} = $guts->{generic};
1554            
1555 178         570 return $guts->{$type};
1556             }
1557              
1558             =head1 HELPER METHODS
1559              
1560             =head2 verbose
1561              
1562             C tells us whether we're in verbose mode.
1563              
1564             =cut
1565              
1566 1699     1699 1 3619 sub verbose { return shift->{verbose} }
1567              
1568             =head2 create_file( $fname, @content_lines )
1569              
1570             Creates I<$fname>, dumps I<@content_lines> in it, and closes it.
1571             Dies on any error.
1572              
1573             =cut
1574              
1575             sub create_file {
1576 1098     1098 1 1329 my $self = shift;
1577 1098         1223 my $fname = shift;
1578              
1579 1098         2031 my @content = @_;
1580 1098 50       65365 open( my $fh, '>', $fname ) or confess "Can't create $fname: $!\n";
1581 1098         2876 print {$fh} @content;
  1098         5464  
1582 1098 50       27600 close $fh or die "Can't close $fname: $!\n";
1583              
1584 1098         5208 return;
1585             }
1586              
1587             =head2 progress( @list )
1588              
1589             C prints the given progress message if we're in verbose mode.
1590              
1591             =cut
1592              
1593             sub progress {
1594 1699     1699 1 2887 my $self = shift;
1595 1699 50       2867 print @_, "\n" if $self->verbose;
1596              
1597 1699         3013 return;
1598             }
1599              
1600             =head2 filter_lines_in_file( $filename, @compiled_regexes )
1601              
1602             C goes over a file and removes lines with the received
1603             regexes.
1604              
1605             For example, removing t/boilerplate.t in the MANIFEST.
1606              
1607             =cut
1608              
1609             sub filter_lines_in_file {
1610 2     2 1 16 my ( $self, $file, @regexes ) = @_;
1611 2         7 my @read_lines;
1612 2 50       84 open my $fh, '<', $file or die "Can't open file $file: $!\n";
1613 2         46 @read_lines = <$fh>;
1614 2 50       23 close $fh or die "Can't close file $file: $!\n";
1615              
1616 2         8 chomp @read_lines;
1617              
1618 2 50       112 open $fh, '>', $file or die "Can't open file $file: $!\n";
1619 2         19 foreach my $line (@read_lines) {
1620 26         31 my $found;
1621              
1622 26         37 foreach my $regex (@regexes) {
1623 52 100       160 if ( $line =~ $regex ) {
1624 4         8 $found++;
1625             }
1626             }
1627              
1628 26 100       40 $found or print {$fh} "$line\n";
  22         54  
1629             }
1630 2 50       207 close $fh or die "Can't close file $file: $!\n";
1631             }
1632              
1633             =head1 BUGS
1634              
1635             Please report any bugs or feature requests to the bugtracker for this project
1636             on GitHub at: L. I will be
1637             notified, and then you'll automatically be notified of progress on your bug
1638             as I make changes.
1639              
1640             =head1 AUTHOR
1641              
1642             Sawyer X, C<< >>
1643              
1644             Andy Lester, C<< >>
1645              
1646             C.J. Adams-Collier, C<< >>
1647              
1648             =head1 Copyright & License
1649              
1650             Copyright 2005-2009 Andy Lester and C.J. Adams-Collier, All Rights Reserved.
1651              
1652             Copyright 2010 Sawyer X, All Rights Reserved.
1653              
1654             This program is free software; you can redistribute it and/or modify it
1655             under the same terms as Perl itself.
1656              
1657             Please note that these modules are not products of or supported by the
1658             employers of the various contributors to the code.
1659              
1660             =cut
1661              
1662             sub _module_header {
1663 552     552   636 my $self = shift;
1664 552         651 my $module = shift;
1665 552         711 my $rtname = shift;
1666 552 50       2071 my $warnings = sprintf 'warnings%s;', ($self->{fatalize} ? " FATAL => 'all'" : '');
1667              
1668 552         2284 my $content = <<"HERE";
1669             package $module;
1670              
1671             use $self->{minperl};
1672             use strict;
1673             use $warnings
1674              
1675             \=head1 NAME
1676              
1677             $module - The great new $module!
1678              
1679             \=head1 VERSION
1680              
1681             Version 0.01
1682              
1683             \=cut
1684              
1685             our \$VERSION = '0.01';
1686             HERE
1687 552         1091 return $content;
1688             }
1689              
1690             sub _module_bugs {
1691 552     552   689 my $self = shift;
1692 552         649 my $module = shift;
1693 552         636 my $rtname = shift;
1694              
1695 552         1228 my $bug_email = "bug-\L$self->{distro}\E at rt.cpan.org";
1696 552         807 my $bug_link =
1697             "https://rt.cpan.org/NoAuth/ReportBug.html?Queue=$self->{distro}";
1698              
1699 552         1032 my $content = <<"HERE";
1700             \=head1 BUGS
1701              
1702             Please report any bugs or feature requests to C<$bug_email>, or through
1703             the web interface at L<$bug_link>. I will be notified, and then you'll
1704             automatically be notified of progress on your bug as I make changes.
1705              
1706             HERE
1707              
1708 552         976 return $content;
1709             }
1710              
1711             sub _module_support {
1712 552     552   663 my $self = shift;
1713 552         637 my $module = shift;
1714 552         610 my $rtname = shift;
1715              
1716 552         870 my $content = qq[
1717             \=head1 SUPPORT
1718              
1719             You can find documentation for this module with the perldoc command.
1720              
1721             perldoc $module
1722             ];
1723 552         920 my @reference_links = _reference_links();
1724              
1725 552 50       1164 return undef unless @reference_links;
1726 552         1125 $content .= qq[
1727              
1728             You can also look for information at:
1729              
1730             \=over 4
1731             ];
1732              
1733 552         911 foreach my $ref (@reference_links) {
1734 2208         2260 my $title;
1735 2208         3813 my $link = sprintf($ref->{link}, $self->{distro});
1736              
1737 2208 100       3707 $title = "$ref->{nickname}: " if exists $ref->{nickname};
1738 2208         2710 $title .= $ref->{title};
1739 2208         4292 $content .= qq[
1740             \=item * $title
1741              
1742             L<$link>
1743             ];
1744             }
1745 552         723 $content .= qq[
1746             \=back
1747             ];
1748 552         1540 return $content;
1749             }
1750              
1751             sub _module_license {
1752 552     552   774 my $self = shift;
1753              
1754 552         598 my $module = shift;
1755 552         599 my $rtname = shift;
1756              
1757 552         1094 my $license_blurb = $self->_license_blurb();
1758 552         974 my $year = $self->_thisyear();
1759              
1760 552         2344 my $content = qq[
1761             \=head1 LICENSE AND COPYRIGHT
1762              
1763             Copyright $year $self->{author}.
1764              
1765             $license_blurb
1766             ];
1767              
1768 552         1138 return $content;
1769             }
1770              
1771             sub module_guts {
1772 552     552 1 731 my $self = shift;
1773 552         667 my $module = shift;
1774 552         741 my $rtname = shift;
1775              
1776             # Sub-templates
1777 552         938 my $header = $self->_module_header($module, $rtname);
1778 552         1250 my $bugs = $self->_module_bugs($module, $rtname);
1779 552         1130 my $support = $self->_module_support($module, $rtname);
1780 552         1170 my $license = $self->_module_license($module, $rtname);
1781              
1782 552         3591 my $content = <<"HERE";
1783             $header
1784              
1785             \=head1 SYNOPSIS
1786              
1787             Quick summary of what the module does.
1788              
1789             Perhaps a little code snippet.
1790              
1791             use $module;
1792              
1793             my \$foo = $module->new();
1794             ...
1795              
1796             \=head1 EXPORT
1797              
1798             A list of functions that can be exported. You can delete this section
1799             if you don't export anything, such as for a purely object-oriented module.
1800              
1801             \=head1 SUBROUTINES/METHODS
1802              
1803             \=head2 function1
1804              
1805             \=cut
1806              
1807             sub function1 {
1808             }
1809              
1810             \=head2 function2
1811              
1812             \=cut
1813              
1814             sub function2 {
1815             }
1816              
1817             \=head1 AUTHOR
1818              
1819             $self->{author}, C<< <$self->{email_obfuscated}> >>
1820              
1821             $bugs
1822              
1823             $support
1824              
1825             \=head1 ACKNOWLEDGEMENTS
1826              
1827             $license
1828              
1829             \=cut
1830              
1831             1; # End of $module
1832             HERE
1833 552         1677 return $content;
1834             }
1835              
1836             1;
1837              
1838             # vi:et:sw=4 ts=4