File Coverage

blib/lib/ExtUtils/ModuleMaker/StandardText.pm
Criterion Covered Total %
statement 163 172 94.7
branch 40 52 76.9
condition 3 3 100.0
subroutine 33 33 100.0
pod 25 26 96.1
total 264 286 92.3


line stmt bran cond sub pod time code
1             package ExtUtils::ModuleMaker::StandardText;
2 18     18   111 use strict;
  18         28  
  18         390  
3 18     18   65 use warnings;
  18         29  
  18         674  
4             our $VERSION = "0.63";
5 18         690 use ExtUtils::ModuleMaker::Licenses::Standard qw(
6             Get_Standard_License
7             Verify_Standard_License
8 18     18   79 );
  18         24  
9 18         559 use ExtUtils::ModuleMaker::Licenses::Local qw(
10             Get_Local_License
11             Verify_Local_License
12 18     18   101 );
  18         34  
13 18     18   73 use File::Path;
  18         27  
  18         709  
14 18     18   73 use File::Spec;
  18         33  
  18         334  
15 18     18   60 use Carp;
  18         26  
  18         34182  
16              
17             =head1 NAME
18              
19             ExtUtils::ModuleMaker::StandardText - Methods used within ExtUtils::ModuleMaker
20              
21             =head1 DESCRIPTION
22              
23             The methods described below are 'quasi-private' methods which are called by
24             the publicly available methods of ExtUtils::ModuleMaker and
25             ExtUtils::ModuleMaker::Interactive. They are 'quasi-private' in the sense
26             that they are not intended to be called by the everyday user of
27             ExtUtils::ModuleMaker. Nothing prevents a user from calling these
28             methods, but they are documented here primarily so that users
29             writing plug-ins for ExtUtils::ModuleMaker's standard text will know what methods
30             need to be subclassed.
31              
32             The methods below are called in C
33             but not in that same package's C. For methods called in
34             C, please see ExtUtils::ModuleMaker::Initializers.
35              
36             The descriptions below are presented in hierarchical order rather than
37             alphabetically. The order is that of ''how close to the surface can a
38             particular method called?'', where 'surface' means being called within
39             C.
40             So methods called within C are described before
41             methods which are only called within other quasi-private methods. Some of the
42             methods described are also called within ExtUtils::ModuleMaker::Interactive
43             methods. And some quasi-private methods are called within both public and
44             other quasi-private methods. Within each heading, methods are presented more
45             or less as they are first called within the public or higher-order
46             quasi-private methods.
47              
48             Happy subclassing!
49              
50             =head1 METHODS
51              
52             =head2 Methods Called within C
53              
54             =head3 C
55              
56             Usage : $self->create_base_directory within complete_build()
57             Purpose : Create the directory where all the files will be created.
58             Returns : $DIR = directory name where the files will live
59             Argument : n/a
60             Comment : $self keys Base_Dir, COMPACT, NAME. Calls method create_directory.
61              
62             =cut
63              
64             sub create_base_directory {
65 82     82 1 120 my $self = shift;
66              
67             $self->{Base_Dir} = File::Spec->rel2abs(
68 82 100       2287 join( ( $self->{COMPACT} ) ? q{-} : q{/}, split( /::/, $self->{NAME} ) )
69             );
70              
71 82         346 $self->create_directory( $self->{Base_Dir} );
72             }
73              
74             =head3 C
75              
76             Usage : create_directory( [ I ] )
77             in complete_build; create_base_directory; create_pm_basics
78             Purpose : Creates directory(ies) requested.
79             Returns : n/a
80             Argument : Reference to an array holding list of directories to be created.
81             Comment : Essentially a wrapper around File::Path::mkpath. Will use
82             values in $self keys VERBOSE and PERMISSIONS to provide
83             2nd and 3rd arguments to mkpath if requested.
84             Comment : Adds to death message in event of failure.
85              
86             =cut
87              
88             sub create_directory {
89 342     342 1 506 my $self = shift;
90              
91 342         36484 return mkpath( \@_, $self->{VERBOSE}, $self->{PERMISSIONS} );
92 0         0 $self->death_message( [ "Can't create a directory: $!" ] );
93             }
94              
95             =head3 C
96              
97             Usage : $self->print_file($filename, $filetext) within complete_build()
98             Purpose : Adds the file being created to MANIFEST, then prints text to new
99             file. Logs file creation under verbose. Adds info for
100             death_message in event of failure.
101             Returns : n/a
102             Argument : 2 arguments: filename and text to be printed
103             Comment :
104              
105             =cut
106              
107             sub print_file {
108 679     679 1 1280 my ( $self, $filename, $filetext ) = @_;
109              
110 679 100       1331 push( @{ $self->{MANIFEST} }, $filename )
  597         1377  
111             unless ( $filename eq 'MANIFEST' );
112 679         2026 $self->log_message( qq{writing file '$filename'});
113              
114 679         5673 my $file = File::Spec->catfile( $self->{Base_Dir}, $filename );
115 679 50       31318 open my $FILE, '>', $file or
116             $self->death_message( [ qq{Could not write '$filename', $!} ] );
117 679         5723 print $FILE $filetext;
118 679 50       16775 close $FILE or
119             $self->death_message( [ qq{Unable to close after writing, $!} ] );
120             }
121              
122             =head2 Methods Called within C as an Argument to C
123              
124             =head3 C
125              
126             Usage : $self->text_README() within complete_build()
127             Purpose : Build README
128             Returns : String holding text of README
129             Argument : n/a
130             Throws : n/a
131             Comment : This method is a likely candidate for alteration in a subclass
132              
133             =cut
134              
135             sub text_README {
136 82     82 1 157 my $self = shift;
137 82         357 my %README_text = (
138             eumm_instructions => <<'END_OF_MAKE',
139             perl Makefile.PL
140             make
141             make test
142             make install
143             END_OF_MAKE
144             mb_instructions => <<'END_OF_BUILD',
145             perl Build.PL
146             ./Build
147             ./Build test
148             ./Build install
149             END_OF_BUILD
150             readme_top => <<'END_OF_TOP',
151              
152             If this is still here it means the programmer was too lazy to create the readme file.
153              
154             You can create it now by using the command shown above from this directory.
155              
156             At the very least you should be able to use this set of instructions
157             to install the module...
158              
159             END_OF_TOP
160             readme_bottom => <<'END_OF_BOTTOM',
161              
162             If you are on a windows box you should use 'nmake' rather than 'make'.
163             END_OF_BOTTOM
164             );
165              
166 82         208 my $pod2textline = "pod2text $self->{NAME}.pm > README\n";
167             my $build_instructions =
168             ( $self->{BUILD_SYSTEM} eq 'ExtUtils::MakeMaker' )
169             ? $README_text{eumm_instructions}
170 82 100       222 : $README_text{mb_instructions};
171             return $pod2textline .
172             $README_text{readme_top} .
173             $build_instructions .
174 82         400 $README_text{readme_bottom};
175             }
176              
177             =head3 C
178              
179             Usage : $self->text_Todo() within complete_build()
180             Purpose : Composes text for Todo file
181             Returns : String with text of Todo file
182             Argument : n/a
183             Throws : n/a
184             Comment : This method is a likely candidate for alteration in a subclass
185             Comment : References $self key NAME
186              
187             =cut
188              
189             sub text_Todo {
190 81     81 1 147 my $self = shift;
191              
192 81         206 my $text = <
193             TODO list for Perl module $self->{NAME}
194              
195             - Nothing yet
196              
197              
198             EOF
199              
200 81         223 return $text;
201             }
202              
203             =head3 C
204              
205             Usage : $self->text_Changes($only_in_pod) within complete_build;
206             block_pod()
207             Purpose : Composes text for Changes file
208             Returns : String holding text for Changes file
209             Argument : $only_in_pod: True value to get only a HISTORY section for POD
210             False value to get whole Changes file
211             Throws : n/a
212             Comment : This method is a likely candidate for alteration in a subclass
213             Comment : Accesses $self keys NAME, VERSION, timestamp, eumm_version
214              
215             =cut
216              
217             sub text_Changes {
218 82     82 1 179 my ( $self, $only_in_pod ) = @_;
219              
220 82         106 my $text_of_Changes;
221              
222 82 100       162 unless ($only_in_pod) {
223 78         275 $text_of_Changes = <
224             Revision history for Perl module $self->{NAME}
225              
226             $self->{VERSION} $self->{timestamp}
227             - original version; created by ExtUtils::ModuleMaker $self->{eumm_version}
228              
229              
230             EOF
231             }
232             else {
233 4         11 $text_of_Changes = <
234             $self->{VERSION} $self->{timestamp}
235             - original version; created by ExtUtils::ModuleMaker $self->{eumm_version}
236             EOF
237             }
238              
239 82         237 return $text_of_Changes;
240             }
241              
242             =head3 C
243              
244             Usage : $self->text_test within complete_build($testnum, $module)
245             Purpose : Composes text for a test for each pm file being requested in
246             call to EU::MM
247             Returns : String holding complete text for a test file.
248             Argument : Two arguments: $testnum and $module
249             Throws : n/a
250             Comment : This method is a likely candidate for alteration in a subclass
251             Will make a test with or without a checking for method new.
252              
253             =cut
254              
255             sub text_test {
256 89     89 1 187 my ( $self, $testfilename, $module ) = @_;
257              
258 89         225 my $name = $self->process_attribute( $module, 'NAME' );
259 89         219 my $neednew = $self->process_attribute( $module, 'NEED_NEW_METHOD' );
260              
261 89         127 my %test_file_texts;
262 89         340 $test_file_texts{neednew} = <
263             # -*- perl -*-
264              
265             # $testfilename - check module loading and create testing directory
266              
267             use Test::More tests => 2;
268              
269             BEGIN { use_ok( '$module->{NAME}' ); }
270              
271             my \$object = ${name}->new ();
272             isa_ok (\$object, '$module->{NAME}');
273              
274              
275             MFNN
276              
277 89         202 $test_file_texts{zeronew} = <
278             # -*- perl -*-
279              
280             # $testfilename - check module loading and create testing directory
281              
282             use Test::More tests => 1;
283              
284             BEGIN { use_ok( '$module->{NAME}' ); }
285              
286              
287             MFZN
288              
289             return $neednew ? $test_file_texts{neednew}
290 89 100       298 : $test_file_texts{zeronew};
291             }
292              
293             sub text_test_multi {
294 2     2 0 6 my ( $self, $testfilename, $pmfilesref ) = @_;
295 2         3 my @pmfiles = @{$pmfilesref};
  2         4  
296              
297 2         6 my $top = <
298             # -*- perl -*-
299              
300             # $testfilename - check module loading and create testing directory
301             END_OF_TOP
302              
303 2         4 my $number_line = q{use Test::More tests => } . scalar(@pmfiles) . q{;};
304              
305 2         3 my $begin_block = "BEGIN {\n";
306 2         5 foreach my $f (@pmfiles) {
307 8         13 $begin_block .= " use_ok( '$f->{NAME}' );\n";
308             }
309 2         5 $begin_block .= "}\n";
310              
311 2         5 my $text_of_test_file = join("\n", (
312             $top,
313             $number_line,
314             $begin_block,
315             )
316             );
317 2         5 return $text_of_test_file;
318             }
319              
320             =head3 C
321              
322             Usage : $self->text_Makefile() within complete_build()
323             Purpose : Build Makefile
324             Returns : String holding text of Makefile
325             Argument : n/a
326             Throws : n/a
327             Comment : This method is a likely candidate for alteration in a subclass
328              
329             =cut
330              
331             sub text_Makefile {
332 79     79 1 131 my $self = shift;
333 79         122 my %escaped = ();
334 79         172 for my $k (qw| NAME FILE AUTHOR EMAIL ABSTRACT |) {
335 395         564 my $v = $self->{$k};
336 395         769 ($escaped{$k} = $v) =~ s{'}{\\'}g;
337             }
338              
339 79         298 my $text_of_Makefile = <
340             use ExtUtils::MakeMaker;
341             use strict;
342             use warnings;
343              
344             # Call 'perldoc ExtUtils::MakeMaker' for details of how to influence
345             # the contents of the Makefile that is written.
346              
347             my %WriteMakefileArgs = (
348             NAME => '$escaped{NAME}',
349             VERSION_FROM => '$escaped{FILE}',
350             AUTHOR => '$escaped{AUTHOR} ($escaped{EMAIL})',
351             ABSTRACT => '$escaped{ABSTRACT}',
352             INSTALLDIRS => (\$] < 5.011 ? 'perl' : 'site'),
353             PREREQ_PM => {
354             'Test::Simple' => 0.44,
355             },
356             ( eval { ExtUtils::MakeMaker->VERSION(6.46) } ? () : ( META_MERGE => {
357             'meta-spec' => { version => 2 },
358             dynamic_config => 1,
359             #resources => {
360             # homepage => undef,
361             # repository => {
362             # url => undef,
363             # web => undef,
364             # type => undef,
365             # },
366             # bugtracker => {
367             # web => undef,
368             # },
369             #},
370             })),
371             );
372              
373             WriteMakefile(\%WriteMakefileArgs);
374             END_OF_MAKEFILE_TEXT
375              
376 79         209 return $text_of_Makefile;
377             }
378              
379             =head3 C
380              
381             Usage : $self->text_Buildfile() within complete_build()
382             Purpose : Composes text for a Buildfile for Module::Build
383             Returns : String holding text for Buildfile
384             Argument : n/a
385             Throws : n/a
386             Comment : This method is a likely candidate for alteration in a subclass,
387             e.g., respond to improvements in Module::Build
388             Comment : References $self keys NAME and LICENSE
389              
390             =cut
391              
392             sub text_Buildfile {
393 3     3 1 5 my $self = shift;
394              
395             # As of 0.15, Module::Build only allows a few licenses
396 3 50       19 my $license_line = 1 if $self->{LICENSE} =~ /^(?:perl|gpl|artistic)$/;
397              
398 3         8 my $text_of_Buildfile = <
399             use Module::Build;
400             # See perldoc Module::Build for details of how this works
401              
402             Module::Build->new
403             ( module_name => '$self->{NAME}',
404             EOF
405              
406 3 50       7 if ($license_line) {
407              
408 3         8 $text_of_Buildfile .= <
409             license => '$self->{LICENSE}',
410             EOF
411              
412             }
413              
414 3         6 $text_of_Buildfile .= <
415             )->create_build_script;
416             EOF
417              
418 3         8 return $text_of_Buildfile;
419              
420             }
421              
422             =head3 C
423              
424             Usage : $self->text_proxy_makefile() within complete_build()
425             Purpose : Composes text for proxy makefile
426             Returns : String holding text for proxy makefile
427             Argument : n/a
428             Throws : n/a
429             Comment : This method is a likely candidate for alteration in a subclass
430              
431             =cut
432              
433             sub text_proxy_makefile {
434 2     2 1 3 my $self = shift;
435              
436             # This comes directly from the docs for Module::Build::Compat
437 2         4 my $text_of_proxy = <<'EOF';
438             unless (eval "use Module::Build::Compat 0.02; 1" ) {
439             print "This module requires Module::Build to install itself.\n";
440              
441             require ExtUtils::MakeMaker;
442             my $yn = ExtUtils::MakeMaker::prompt
443             (' Install Module::Build from CPAN?', 'y');
444              
445             if ($yn =~ /^y/i) {
446             require Cwd;
447             require File::Spec;
448             require CPAN;
449              
450             # Save this 'cause CPAN will chdir all over the place.
451             my $cwd = Cwd::cwd();
452             my $makefile = File::Spec->rel2abs($0);
453              
454             CPAN::Shell->install('Module::Build::Compat');
455              
456             chdir $cwd or die "Cannot chdir() back to $cwd: $!";
457             exec $^X, $makefile, @ARGV; # Redo now that we have Module::Build
458             } else {
459             warn " *** Cannot install without Module::Build. Exiting ...\n";
460             exit 1;
461             }
462             }
463             Module::Build::Compat->run_build_pl(args => \@ARGV);
464             Module::Build::Compat->write_makefile();
465             EOF
466              
467 2         4 return $text_of_proxy;
468             }
469              
470             =head3 C
471              
472             Usage : $self->text_MANIFEST_SKIP() within complete_build()
473             Purpose : Composes text for MANIFEST.SKIP file
474             Returns : String with text of MANIFEST.SKIP file
475             Argument : n/a
476             Throws : n/a
477             Comment : References $self key NAME
478             Comment : Originally adapted from David Golden's ExtUtils::ModuleMaker::TT
479             Comment : Updated to reflect ExtUtils::Manifest 1.70
480             (distributed with Perl 5.26) plus travis and appveyor
481             configuration files
482              
483             =cut
484              
485             sub text_MANIFEST_SKIP {
486 1     1 1 4 my $self = shift;
487              
488 1         2 my $text_of_SKIP = <<'END_OF_SKIP';
489             # Avoid version control files.
490             \bRCS\b
491             \bCVS\b
492             \bSCCS\b
493             ,v$
494             \B\.svn\b
495             \B\.git\b
496             \B\.gitignore\b
497             \b_darcs\b
498             \B\.cvsignore$
499              
500             # Avoid VMS specific MakeMaker generated files
501             \bDescrip.MMS$
502             \bDESCRIP.MMS$
503             \bdescrip.mms$
504              
505             # Avoid Makemaker generated and utility files.
506             \bMANIFEST\.bak
507             \bMakefile$
508             \bblib/
509             \bMakeMaker-\d
510             \bpm_to_blib\.ts$
511             \bpm_to_blib$
512             \bblibdirs\.ts$ # 6.18 through 6.25 generated this
513             \b_eumm/ # 7.05_05 and above
514              
515             # Avoid Module::Build generated and utility files.
516             \bBuild$
517             \b_build/
518             \bBuild.bat$
519             \bBuild.COM$
520             \bBUILD.COM$
521             \bbuild.com$
522              
523             # and Module::Build::Tiny generated files
524             \b_build_params$
525              
526             # Avoid temp and backup files.
527             ~$
528             \.old$
529             \#$
530             \b\.#
531             \.bak$
532             \.tmp$
533             \.#
534             \.rej$
535             \..*\.sw.?$
536              
537             # Avoid OS-specific files/dirs
538             # Mac OSX metadata
539             \B\.DS_Store
540             # Mac OSX SMB mount metadata files
541             \B\._
542              
543             # Avoid Devel::Cover and Devel::CoverX::Covered files.
544             \bcover_db\b
545             \bcovered\b
546              
547             # Avoid prove files
548             \B\.prove$
549              
550             # Avoid MYMETA files
551             ^MYMETA\.
552              
553             # Avoid travis-ci.org file
554             ^\.travis.yml
555              
556             # Avoid appveyor.com file
557             ^\.appveyor.yml
558             END_OF_SKIP
559              
560 1         3 return $text_of_SKIP;
561             }
562              
563             =head3 C
564              
565             Usage : $self->text_pod_coverage_test() within complete_build()
566             Purpose : Composes text for t/pod-coverage.t
567             Returns : String with text of t/pod-coverage.t
568             Argument : n/a
569             Throws : n/a
570             Comment : Adapted from Andy Lester's Module::Starter
571             Comment : I don't think of much of this metric, but Andy and Damian do,
572             so if you want it you set INCLUDE_POD_COVERAGE_TEST => 1
573              
574             =cut
575              
576             sub text_pod_coverage_test {
577 1     1 1 3 my $self = shift;
578              
579 1         2 my $text_of_pod_coverage_test = <<'END_OF_POD_COVERAGE_TEST';
580             #!perl -T
581              
582             use Test::More;
583             eval "use Test::Pod::Coverage 1.04";
584             plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage"
585             if $@;
586             all_pod_coverage_ok();
587             END_OF_POD_COVERAGE_TEST
588              
589 1         3 return $text_of_pod_coverage_test;
590             }
591              
592             =head3 C
593              
594             Usage : $self->text_pod_test() within complete_build()
595             Purpose : Composes text for t/pod.t
596             Returns : String with text of t/pod.t
597             Argument : n/a
598             Throws : n/a
599             Comment : Adapted from Andy Lester's Module::Starter
600             Comment : I don't think of much of this metric, but Andy and Damian do,
601             so if you want it you set INCLUDE_POD_TEST => 1
602              
603             =cut
604              
605             sub text_pod_test {
606 1     1 1 2 my $self = shift;
607              
608 1         2 my $text_of_pod_test = <<'END_OF_POD_TEST';
609             #!perl -T
610              
611             use Test::More;
612             eval "use Test::Pod 1.14";
613             plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
614             all_pod_files_ok();
615             END_OF_POD_TEST
616              
617 1         4 return $text_of_pod_test;
618             }
619              
620             =head3 C
621              
622             Usage : $self->text_pm_file($module) within complete_build()
623             Purpose : Composes a string holding all elements for a pm file
624             Returns : String holding text for a pm file
625             Argument : $module: pointer to the module being built
626             (as there can be more than one module built by EU::MM);
627             for the primary module it is a pointer to $self
628              
629             =cut
630              
631             sub text_pm_file {
632 97     97 1 162 my $self = shift;
633 97         124 my $module = shift;
634              
635 97         246 my $text_of_pm_file = $self->block_begin($module);
636              
637 97 100 100     202 $text_of_pm_file .= (
638             (
639             (
640             ( $self->process_attribute( $module, 'NEED_POD' ) )
641             && ( $self->process_attribute( $module, 'NEED_NEW_METHOD' ) )
642             )
643             ? $self->block_subroutine_header($module)
644             : q{}
645             )
646             );
647              
648 97 100       191 $text_of_pm_file .= (
649             ( $self->process_attribute( $module, 'NEED_NEW_METHOD' ) )
650             ? $self->block_new_method()
651             : q{}
652             );
653              
654 97 100       174 $text_of_pm_file .= (
655             ( $self->process_attribute( $module, 'INCLUDE_FILE_IN_PM' ) )
656             ? $self->block_include_file_in_pm()
657             : q{}
658             );
659              
660 97 100       206 $text_of_pm_file .= (
661             ( $self->process_attribute( $module, 'NEED_POD' ) )
662             ? $self->block_pod($module)
663             : q{}
664             );
665              
666 97         322 $text_of_pm_file .= $self->block_final();
667 97         321 return ($module, $text_of_pm_file);
668             }
669              
670             =head2 Methods Called within C
671              
672             =head3 C
673              
674             Usage : $self->block_begin($module) within text_pm_file()
675             Purpose : Composes the standard code for top of a Perl pm file
676             Returns : String holding code for top of pm file
677             Argument : $module: pointer to the module being built
678             (as there can be more than one module built by EU::MM);
679             for the primary module it is a pointer to $self
680             Throws : n/a
681             Comment : This method is a likely candidate for alteration in a subclass,
682             e.g., you don't need Exporter-related code if you're building
683             an OO-module.
684             Comment : References $self keys NAME and (indirectly) VERSION
685              
686             =cut
687              
688             sub block_begin {
689 97     97 1 176 my ( $self, $module ) = @_;
690 97         258 my $version = $self->process_attribute( $module, 'VERSION' );
691 97         240 my $package_line = "package $module->{NAME};\n";
692 97         144 my $Id_line = q{#$Id#} . "\n";
693 97         134 my $strict_line = "use strict;\n";
694 97         148 my $warnings_line = "use warnings;\n"; # not included in standard version
695 97         166 my $begin_block = <<"END_OF_BEGIN";
696              
697             BEGIN {
698             use Exporter ();
699             use vars qw(\$VERSION \@ISA \@EXPORT \@EXPORT_OK \%EXPORT_TAGS);
700             \$VERSION = '$version';
701             \@ISA = qw(Exporter);
702             #Give a hoot don't pollute, do not export more than needed by default
703             \@EXPORT = qw();
704             \@EXPORT_OK = qw();
705             \%EXPORT_TAGS = ();
706             }
707              
708             END_OF_BEGIN
709             # my $text =
710             # $package_line .
711             # $strict_line .
712             # # $warnings_line .
713             # $begin_block;
714 97         125 my $text = $package_line;
715 97 100       190 $text .= $Id_line if $self->{INCLUDE_ID_LINE};
716 97         175 $text .= $strict_line;
717 97 100       208 $text .= $warnings_line if $self->{INCLUDE_WARNINGS};
718 97         174 $text .= $begin_block;
719 97         180 return $text;
720             }
721              
722             =head3 C
723              
724             Usage : $self->process_attribute($module, @keys)
725             within block_begin(), text_test(),
726             text_pm_file(), block_pod(), complete_build()
727             Purpose :
728             For the particular .pm file now being processed (value of the
729             NAME key of the first argument: $module), see if there exists a
730             key whose name is the second argument. If so, return it.
731             Otherwise, return the value of the key by that name in the
732             EU::MM object. If we have a two-level hash (currently only in
733             License_Parts, process down to that level.
734             Arguments : First argument is a reference to an anonymous hash which has at
735             least one element with key NAME and value of the module being
736             processed. Second is an array of key names, although in all but
737             one case it's a single-element (NAME) array.
738             Comment : [The method's name is very opaque and not self-documenting.
739             Function of the code is not easily evident. Rename? Refactor?]
740              
741             =cut
742              
743             sub process_attribute {
744 1142     1142 1 1763 my ( $self, $module, @keys ) = @_;
745              
746 1142 100       1638 if ( scalar(@keys) == 1 ) {
747             return ( $module->{ $keys[0] } )
748 1047 100       3141 if ( exists( ( $module->{ $keys[0] } ) ) );
749 129         241 return ( $self->{ $keys[0] } );
750             }
751             else { # only alternative currently possible is @keys == 2
752             return ( $module->{ $keys[0] }{ $keys[1] } )
753 95 100       288 if ( exists( ( $module->{ $keys[0] }{ $keys[1] } ) ) );
754 15         28 return ( $self->{ $keys[0] }{ $keys[1] } );
755             }
756             }
757              
758             =head3 C
759              
760             Usage : $self->block_subroutine_header($module) within text_pm_file()
761             Purpose : Composes an inline comment for pm file (much like this inline
762             comment) which documents purpose of a subroutine
763             Returns : String containing text for inline comment
764             Argument : $module: pointer to the module being built
765             (as there can be more than one module built by EU::MM);
766             for the primary module it is a pointer to $self
767             Throws : n/a
768             Comment : This method is a likely candidate for alteration in a subclass
769             E.g., some may prefer this info to appear in POD rather than
770             inline comments.
771              
772             =cut
773              
774             sub block_subroutine_header {
775 94     94 1 165 my ( $self, $module ) = @_;
776 94         150 my $text_of_subroutine_pod = <
777              
778             #################### subroutine header begin ####################
779              
780             ====head2 sample_function
781              
782             Usage : How to use this function/method
783             Purpose : What it does
784             Returns : What it returns
785             Argument : What it wants to know
786             Throws : Exceptions and other anomolies
787             Comment : This is a sample subroutine header.
788             : It is polite to include more pod and fewer comments.
789              
790             See Also :
791              
792             ====cut
793              
794             #################### subroutine header end ####################
795              
796             EOFBLOCK
797              
798 94         498 $text_of_subroutine_pod =~ s/\n ====/\n=/g;
799 94         219 return $text_of_subroutine_pod;
800             }
801              
802             =head3 C
803              
804             Usage : $self->block_new_method() within text_pm_file()
805             Purpose : Build 'new()' method as part of a pm file
806             Returns : String holding sub new.
807             Argument : $module: pointer to the module being built
808             (as there can be more than one module built by EU::MM);
809             for the primary module it is a pointer to $self
810             Throws : n/a
811             Comment : This method is a likely candidate for alteration in a subclass,
812             e.g., pass a single hash-ref to new() instead of a list of
813             parameters.
814              
815             =cut
816              
817             sub block_new_method {
818 94     94 1 174 my $self = shift;
819 94         191 return <<'EOFBLOCK';
820              
821             sub new
822             {
823             my ($class, %parameters) = @_;
824              
825             my $self = bless ({}, ref ($class) || $class);
826              
827             return $self;
828             }
829              
830             EOFBLOCK
831             }
832              
833             =head3 C
834              
835             Usage : $self->block_include_file_in_pm() within text_pm_file()
836             Purpose : Include text from an arbitrary file on disk in .pm file,
837             e.g., subroutine stubs you want in each of several extra
838             modules.
839             Returns : String holding text of arbitrary file.
840             Argument : $module: pointer to the module being built
841             (as there can be more than one module built by EU::MM);
842             for the primary module it is a pointer to $self
843             Throws : n/a
844             Comment : References $self->{INCLUDE_FILE_IN_PM}, whose value must be a
845             path to a single, readable file
846              
847             =cut
848              
849             sub block_include_file_in_pm {
850 4     4 1 7 my ( $self, $module ) = @_;
851 4         7 my $arb = $self->{INCLUDE_FILE_IN_PM};
852 4 50       118 open my $ARB, '<', $arb or croak "Could not open $arb for inclusion: $!";
853 4         29 my $text_included = do { local $/; <$ARB> };
  4         15  
  4         77  
854 4 50       34 close $ARB or croak "Could not close $arb after reading: $!";
855 4         19 return $text_included;
856             }
857              
858             =head3 C
859              
860             Usage : $self->block_pod($module) inside text_pm_file()
861             Purpose : Compose the main POD section within a pm file
862             Returns : String holding main POD section
863             Argument : $module: pointer to the module being built
864             (as there can be more than one module built by EU::MM);
865             for the primary module it is a pointer to $self
866             Throws : n/a
867             Comment : This method is a likely candidate for alteration in a subclass
868             Comment : In StandardText formulation, contains the following components:
869             warning about stub documentation needing editing
870             pod wrapper top
871             NAME - ABSTRACT
872             SYNOPSIS
873             DESCRIPTION
874             USAGE
875             BUGS
876             SUPPORT
877             HISTORY (as requested)
878             AUTHOR
879             COPYRIGHT
880             SEE ALSO
881             pod wrapper bottom
882              
883             =cut
884              
885             sub block_pod {
886 95     95 1 161 my ( $self, $module ) = @_;
887              
888 95         146 my $name = $self->process_attribute( $module, 'NAME' );
889 95         224 my $abstract = $self->process_attribute( $module, 'ABSTRACT' );
890 95         178 my $synopsis = qq{ use $name;\n blah blah blah\n};
891 95         158 my $description = <
892             Stub documentation for this module was created by ExtUtils::ModuleMaker.
893             It looks like the author of the extension was negligent enough
894             to leave the stub unedited.
895              
896             Blah blah blah.
897             END_OF_DESC
898 95         209 my $author_composite = $self->process_attribute( $module, 'COMPOSITE' );
899 95         264 my $copyright = $self->process_attribute( $module, 'LicenseParts', 'COPYRIGHT');
900 95         172 my $see_also = q{perl(1).};
901              
902             my $text_of_pod = join(
903             q{},
904             $self->pod_section( NAME => $name .
905             ( (defined $abstract) ? qq{ - $abstract} : q{} )
906             ),
907             $self->pod_section( SYNOPSIS => $synopsis ),
908             $self->pod_section( DESCRIPTION => $description ),
909             $self->pod_section( USAGE => q{} ),
910             $self->pod_section( BUGS => q{} ),
911             $self->pod_section( SUPPORT => q{} ),
912             (
913             ( $self->{CHANGES_IN_POD} )
914 95 50       370 ? $self->pod_section(
    100          
915             HISTORY => $self->text_Changes('only pod')
916             )
917             : q{}
918             ),
919             $self->pod_section( AUTHOR => $author_composite),
920             $self->pod_section( COPYRIGHT => $copyright),
921             $self->pod_section( 'SEE ALSO' => $see_also),
922             );
923              
924 95         330 return $self->pod_wrapper($text_of_pod);
925             }
926              
927             =head3 C
928              
929             Usage : $self->block_final() within text_pm_file()
930             Purpose : Compose code and comment that conclude a pm file and guarantee
931             that the module returns a true value
932             Returns : String containing code and comment concluding a pm file
933             Argument : $module: pointer to the module being built
934             (as there can be more than one module built by EU::MM);
935             for the primary module it is a pointer to $self
936             Throws : n/a
937             Comment : This method is a likely candidate for alteration in a subclass,
938             e.g., some may not want the comment line included.
939              
940             =cut
941              
942              
943             sub block_final {
944 97     97 1 267 my $self = shift;
945 97         234 return <
946              
947             1;
948             # The preceding line will help the module return a true value
949              
950             EOFBLOCK
951             }
952              
953             =head2 All Other Methods
954              
955             =head3 C
956              
957             Usage : $self->death_message( [ I ] )
958             in validate_values; create_directory; print_file
959             Purpose : Croaks with error message composed from elements in the list
960             passed by reference as argument
961             Returns : [ To come. ]
962             Argument : Reference to an array holding list of error messages accumulated
963             Comment : Different functioning in modulemaker interactive mode
964              
965             =cut
966              
967             sub death_message {
968 9     9 1 10 my $self = shift;
969 9         9 my $errorref = shift;
970 9         10 my @errors = @{$errorref};
  9         27  
971              
972             croak( join "\n", @errors, q{}, $self->{USAGE_MESSAGE} )
973 9 50       595 unless $self->{INTERACTIVE};
974 0         0 my %err = map {$_, 1} @errors;
  0         0  
975 0 0       0 delete $err{'NAME is required'} if $err{'NAME is required'};
976 0         0 @errors = keys %err;
977 0 0       0 if (@errors) {
978 0         0 print( join "\n",
979             'Oops, there are the following errors:', @errors, q{} );
980 0         0 return 1;
981             } else {
982 0         0 return;
983             }
984             }
985              
986             =head3 C
987              
988             Usage : $self->log_message( $message ) in print_file;
989             Purpose : Prints log_message (currently, to STDOUT) if $self->{VERBOSE}
990             Returns : n/a
991             Argument : Scalar holding message to be logged
992             Comment :
993              
994             =cut
995              
996             sub log_message {
997 679     679 1 1009 my ( $self, $message ) = @_;
998 679 100       1642 print "$message\n" if $self->{VERBOSE};
999             }
1000              
1001             =head3 C
1002              
1003             Usage : $self->pod_section($heading, $content) within
1004             block_pod()
1005             Purpose : When writing POD sections, you have to 'escape'
1006             the POD markers to prevent the compiler from treating
1007             them as real POD. This method 'unescapes' them and puts header
1008             and closer around individual POD headings within pm file.
1009             Arguments : Variables holding POD section name and text of POD section.
1010              
1011             =cut
1012              
1013             sub pod_section {
1014 859     859 1 1222 my ( $self, $heading, $content ) = @_;
1015 859         1530 my $text_of_pod_section = <
1016              
1017             ====head1 $heading
1018              
1019             $content
1020             END_OF_SECTION
1021              
1022 859         1822 $text_of_pod_section =~ s/\n ====/\n=/g;
1023 859         1933 return $text_of_pod_section;
1024             }
1025              
1026             =head3 C
1027              
1028             Usage : $self->pod_wrapper($string) within block_pod()
1029             Purpose : When writing POD sections, you have to 'escape'
1030             the POD markers to prevent the compiler from treating
1031             them as real POD. This method 'unescapes' them and puts header
1032             and closer around main POD block in pm file, along with warning
1033             about stub documentation.
1034             Argument : String holding text of POD which has been built up
1035             within block_pod().
1036             Comment : $head and $tail inside pod_wrapper() are optional and, in a
1037             subclass, could be redefined as empty strings;
1038             but $cutline is mandatory as it supplies the last =cut
1039              
1040             =cut
1041              
1042             sub pod_wrapper {
1043 95     95 1 166 my ( $self, $podtext ) = @_;
1044 95         130 my $head = <<'END_OF_HEAD';
1045              
1046             #################### main pod documentation begin ###################
1047             ## Below is the stub of documentation for your module.
1048             ## You better edit it!
1049              
1050             END_OF_HEAD
1051 95         154 my $cutline = <<'END_OF_CUT';
1052              
1053             ====cut
1054              
1055             END_OF_CUT
1056 95         177 my $tail = <<'END_OF_TAIL';
1057             #################### main pod documentation end ###################
1058              
1059             END_OF_TAIL
1060              
1061 95         221 $cutline =~ s/\n ====/\n=/g;
1062 95         422 return join( q{},
1063             $head, # optional
1064             $podtext, # required
1065             $cutline, # required
1066             $tail # optional
1067             );
1068             }
1069              
1070             =head1 SEE ALSO
1071              
1072             F, F.
1073              
1074             =cut
1075              
1076             1;
1077              
1078