File Coverage

blib/lib/Dist/Man/Simple.pm
Criterion Covered Total %
statement 298 323 92.2
branch 27 44 61.3
condition 3 7 42.8
subroutine 45 47 95.7
pod 25 25 100.0
total 398 446 89.2


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