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