File Coverage

blib/lib/Module/New/Command/Basic.pm
Criterion Covered Total %
statement 94 114 82.4
branch 25 52 48.0
condition 13 30 43.3
subroutine 24 26 92.3
pod n/a
total 156 222 70.2


line stmt bran cond sub pod time code
1             package Module::New::Command::Basic;
2            
3 3     3   509 use strict;
  3         4  
  3         79  
4 3     3   11 use warnings;
  3         3  
  3         55  
5 3     3   10 use Carp;
  3         7  
  3         145  
6 3     3   12 use Module::New::Meta;
  3         4  
  3         12  
7 3     3   149 use Module::New::Queue;
  3         14  
  3         3361  
8            
9             functions {
10            
11             set_distname => sub () { Module::New::Queue->register(sub {
12 6     6   8 my ($self, $name) = @_;
13 6 50       10 croak "distribution/main module name is required" unless $name;
14 6         94 Module::New->context->distname( $name );
15 6     6   30 })},
16            
17             guess_root => sub () { Module::New::Queue->register(sub {
18 5     5   8 my $self = shift;
19 5         19 my $context = Module::New->context;
20 5         20 $context->path->guess_root( $context->config('root') );
21 5     5   33 })},
22            
23             set_file => sub () { Module::New::Queue->register(sub {
24 4     4   7 my ($self, $name) = @_;
25            
26 4 50       9 croak "filename is required" unless $name;
27            
28 4         12 my $context = Module::New->context;
29 4         14 my $type = $context->config('type');
30            
31 4 50       11 unless ($type) {
32 4 100 66     61 if ( $name =~ /::/ or $name =~ /\.pm$/ or $name =~ m{^lib/} ) {
    100 66        
    50 66        
    0 33        
33 2         4 $type = 'Module';
34             }
35             elsif ( $name =~ /\.t$/ or $name =~ m{^t/} ) {
36 1         2 $type = 'Test';
37             }
38             elsif ( $name =~ /\.pl/ or $name =~ m{^(?:bin|scripts?)/} ) {
39 1         4 $type = 'Script';
40             }
41             elsif ( $name = /\./ ) {
42 0         0 $type = 'Plain';
43             }
44             }
45 4   50     12 $type ||= 'Module';
46 4         11 $context->config( type => $type );
47            
48 4 100       21 if ( $type =~ /Module$/ ) {
49 2         6 $context->module( $name );
50             }
51             else {
52 2         9 $context->mainfile( $name );
53             }
54 4     4   25 })},
55            
56             create_distdir => sub () { Module::New::Queue->register(sub {
57 6     6   6 my $self = shift;
58            
59 6         47 my $context = Module::New->context;
60            
61 6         13 $context->path->set_root;
62 6 100       17 unless ( $context->config('no_dirs') ) {
63 5         13 my $distname = $context->distname;
64 5         12 my $distdir = $context->path->dir($distname);
65 5 50       147 if ( $distdir->exists ) {
66 0 0       0 if ( $context->config('force') ) {
    0          
67 0         0 $context->path->remove_dir( $distdir, 'absolute' );
68             }
69             elsif ( $context->config('grace') ) {
70             # just skip and do nothing
71             }
72             else {
73 0         0 croak "$distname already exists";
74             }
75             }
76 5         66 $context->path->create_dir($distname);
77 5         131 $context->path->change_dir($distname);
78             }
79             else {
80 1         3 $context->path->change_dir(".");
81             }
82 6         158 $context->path->set_root;
83 6     6   31 })},
84            
85             create_maketool => sub (;$) {
86 6     6   9 my $type = shift;
87             Module::New::Queue->register(sub {
88 6     6   8 my $self = shift;
89            
90 6         61 my $context = Module::New->context;
91 6   100     26 $type ||= $context->config('make') || 'MakeMakerCPANfile';
      33        
92 6 50       12 $type = 'ModuleBuild' if $type eq 'MB';
93 6 50       11 $type = 'MakeMaker' if $type eq 'EUMM';
94            
95 6         18 $context->files->add( $type );
96 6         29 });
97             },
98            
99             create_general_files => sub () { Module::New::Queue->register(sub {
100 6     6   9 my $self = shift;
101            
102 6         14 Module::New->context->files->add(qw( Readme Changes ManifestSkip License ));
103 6     6   24 })},
104            
105             create_tests => sub (;@) {
106 6     6   11 my @files = @_;
107             Module::New::Queue->register(sub {
108 6     6   7 my $self = shift;
109            
110 6         11 my $context = Module::New->context;
111 6 50       13 if ( ref $context->config('test') eq 'ARRAY' ) {
    50          
112 0         0 $context->files->add( @{ Module::New->context->config('test') } );
  0         0  
113             }
114             elsif ( @files ) {
115 0         0 $context->files->add( @files );
116             }
117             else {
118 6         13 $context->files->add(qw( LoadTest PodTest PodCoverageTest ));
119             }
120 6         27 });
121             },
122            
123             create_files => sub (;@) {
124 10     10   21 my @files = @_;
125             Module::New::Queue->register(sub {
126 10     10   16 my $self = shift;
127            
128 10         29 my $context = Module::New->context;
129 10         27 $context->files->add( @files );
130 10 100       24 if ($context->config('xs')) {
131 1         3 $context->files->add('XS');
132 1         2 eval {
133 1         2151 require Devel::PPPort;
134 1         312 Devel::PPPort::WriteFile();
135 1         2018 $context->log( info => "created ppport.h" );
136             };
137 1 50       44 $context->log( warn => $@ ) if $@;
138             }
139 10         30 while ( my $name = $context->files->next ) {
140 59 100       151 if ( $name eq '{ANY_TYPE}' ) {
141 4   50     9 $name = $context->config('type') || 'Module';
142             }
143 59         134 my $file = $context->loader->reload_class( File => $name );
144 59         177 $context->path->create_file( $file->render );
145             }
146 10         197 });
147             },
148            
149             create_manifest => sub () { Module::New::Queue->register(sub {
150 10     10   17 my $self = shift;
151            
152 10         30 my $context = Module::New->context;
153 10 50       27 $context->path->remove_file('MANIFEST') if $context->config('force');
154            
155 10 50       24 local $ENV{PERL_MM_MANIFEST_VERBOSE} = 0 if $context->config('silent');
156            
157 10         461 require ExtUtils::Manifest;
158 10         5736 ExtUtils::Manifest::mkmanifest();
159            
160 10         12434 $context->log( info => 'updated manifest' );
161 10     10   52 })},
162            
163             edit_mainfile => sub (;%) {
164 10     10   24 my %options = @_;
165 10 50 33     51 return if $ENV{HARNESS_ACTIVE} || $INC{'Test/Classy.pm'};
166             Module::New::Queue->register(sub {
167 0     0     my $self = shift;
168            
169 0           my $context = Module::New->context;
170 0 0         return if $options{optional};
171            
172 0   0       my $editor = $context->config('editor') || $ENV{EDITOR};
173 0 0         unless ( $editor ) { carp 'editor is not set'; return; }
  0            
  0            
174 0   0       my $file = $options{file} || $context->mainfile;
175 0           exec( _shell_quote($editor) => _shell_quote($file) );
176 0           });
177             },
178             };
179            
180             sub _shell_quote {
181 0     0     my $str = shift;
182 0 0         return $str unless $str =~ /\s/;
183 0 0         return ( $^O eq 'MSWin32' ) ? qq{"$str"} : qq{'$str'};
184             }
185            
186             1;
187            
188             __END__