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