File Coverage

blib/lib/Module/Setup/Devel.pm
Criterion Covered Total %
statement 24 106 22.6
branch 0 28 0.0
condition 0 6 0.0
subroutine 8 16 50.0
pod 0 7 0.0
total 32 163 19.6


line stmt bran cond sub pod time code
1             package Module::Setup::Devel;
2 41     41   224 use strict;
  41         76  
  41         1455  
3 41     41   216 use warnings;
  41         62  
  41         1642  
4              
5 41     41   201 use Scalar::Util qw(weaken);
  41         64  
  41         2443  
6 41     41   19912 use YAML ();
  41         270733  
  41         1212  
7              
8 41     41   18447 use Module::Setup::Distribute;
  41         81  
  41         1276  
9              
10 41     41   16606 use Module::Setup::Path::Flavor;
  41         116  
  41         29478  
11              
12             sub new {
13 0     0 0   my($class, $context) = @_;
14 0           my $self = bless { context => $context }, $class;
15 0           weaken $self->{context};
16 0           $self;
17             }
18 0     0 0   sub context { shift->{context} }
19              
20             sub run {
21 0     0 0   my $self = shift;
22              
23 0 0         return $self->test if $self->context->options->{test};
24 0 0         return $self->pack if $self->context->options->{pack};
25              
26 0           $self->create_skeleton;
27             }
28              
29             sub create_skeleton {
30 0     0 0   my $self = shift;
31              
32 0           $self->context->_load_argv( flavor_name => '' );
33 0 0         Carp::croak "flavor class name is required" unless $self->context->options->{flavor_name};
34              
35 0           my $module = $self->context->options->{flavor_name};
36 0           my @pkg = split /::/, $module;
37 0           my $module_path = join '-', @pkg;
38 0           my $base_dir = Module::Setup::Path::Flavor->new($module_path);
39              
40 0           $base_dir->path->subdir('t')->mkpath;
41 0           $base_dir->template->path->subdir('testdir')->mkpath;
42 0           my $fh = $base_dir->template->path->file('testfile.txt')->openw;
43 0           print $fh "hello! $module";
44 0           close $fh;
45              
46 0           $base_dir->create_flavor(+{
47             module_setup_flavor_devel => 1,
48             class => $module,
49             plugins => [],
50             testdata => +{
51             module => 'MyApp',
52             files => [
53             {
54             file => 'testfile.txt',
55             likes => ['hel+o', $module ],
56             },
57             ],
58             dirs => ['testdir'],
59             },
60             });
61             }
62              
63             sub load_config {
64 0     0 0   my $self = shift;
65 0           my $conf = YAML::LoadFile('config.yaml');
66 0 0 0       return unless $conf && ref($conf) eq 'HASH' && $conf->{module_setup_flavor_devel};
      0        
67 0           return $conf;
68             }
69              
70             # make t/all.t && --pack && prove t/*t
71             sub test {
72 0     0 0   my $self = shift;
73              
74 0           my $conf = $self->load_config;
75 0 0         return unless $conf;
76 0           my $distribute = Module::Setup::Distribute->new( $conf->{class}, %{ $self->context->options } );
  0            
77              
78 0           my @files;my @file;
79 0           my $test = $conf->{testdata};
80 0           for my $data (@{ $test->{files} }) {
  0            
81 0 0         push @files, $data unless ref $data;
82 0           my $like;
83 0 0         if (@{ $data->{likes} }) {
  0            
84 0           my @likes = map { "qr/$_/" } map { s{/}{\\/}g; $_ } @{ $data->{likes} };
  0            
  0            
  0            
  0            
85 0           $like = join ', ', @likes;
86             }
87 0           my $str = " file '$data->{file}'";
88 0 0         $str .= " => $like" if $like;
89 0           $str .= ";\n";
90 0           push @file, $str;
91             }
92              
93 0           my @dirs;
94 0           for my $data (@{ $test->{dirs} }) {
  0            
95 0           push @dirs, $data;
96             }
97              
98 0           my $code;
99 0 0         $code .= sprintf(" files qw( %s );\n", @files) if @files;
100 0 0         $code .= join "\n", @file if @file;
101 0 0         $code .= sprintf(" dirs qw( %s );\n", @dirs) if @dirs;
102              
103 0           my $module = 'DevelTestFlavor';
104 0           my $fh = $distribute->target_path->file('t', 'all.t')->openw;
105 0           print $fh <
106             use Module::Setup::Test::Flavor;
107              
108             run_flavor_test {
109             default_dialog;
110             name '$test->{module}';
111             flavor '+$module';
112             $code};
113             TEST__
114 0           close $fh;
115              
116             # create pack
117             {
118 41     41   246 no strict 'refs';
  41         66  
  41         1513  
  0            
119 41     41   187 no warnings 'redefine';
  41         61  
  41         12268  
120              
121 0           my $pack;
122 0     0     local *Module::Setup::stdout = sub { $pack = $_[1] };
  0            
123 0           local $self->context->options->{executable};
124 0           $self->pack($module);
125 0 0         open my $fh, '>', "$module.pm" or die $!;
126 0           print $fh $pack;
127 0           close $fh;
128             }
129              
130             # prove -v
131 0           system 'prove', '-v';
132             }
133              
134             sub pack {
135 0     0 0   my $self = shift;
136              
137 0           my $conf = $self->load_config;
138 0 0         return unless $conf;
139              
140 0           my $class;
141 0 0         if (@_) {
142 0           $class = shift;
143             } else {
144 0           $class = $conf->{class};
145             }
146              
147 0           $self->context->options->{flavor_dir} = '.';
148 0           $self->context->options->{flavor} = $class;
149 0           $self->context->options->{module} = $class;
150 0           $self->context->pack_flavor;
151             }
152              
153             1;
154              
155             __END__