File Coverage

blib/lib/Dist/Man/App.pm
Criterion Covered Total %
statement 41 59 69.4
branch 11 28 39.2
condition 4 10 40.0
subroutine 8 12 66.6
pod 1 1 100.0
total 65 110 59.0


line stmt bran cond sub pod time code
1             package Dist::Man::App;
2              
3             =head1 NAME
4              
5             Dist::Man::App - the code behind the command line program
6              
7             =cut
8              
9 1     1   60021 use warnings;
  1         12  
  1         29  
10 1     1   5 use strict;
  1         2  
  1         29  
11              
12             our $VERSION = '0.0.8';
13              
14 1     1   659 use Getopt::Long;
  1         10677  
  1         5  
15 1     1   778 use Pod::Usage;
  1         41934  
  1         114  
16 1     1   8 use Carp qw( croak );
  1         1  
  1         655  
17              
18             sub _config_read {
19 1     1   1 my $filename = shift;
20              
21 1 50       45 return unless -e $filename;
22              
23 0 0       0 open( my $config_file, '<', $filename )
24             or die "couldn't open config file $filename: $!\n";
25              
26 0         0 my %config;
27 0         0 while (<$config_file>) {
28 0         0 chomp;
29 0 0       0 next if /\A\s*\Z/sm;
30 0 0       0 if (/\A(\w+):\s*(.+)\Z/sm) { $config{$1} = $2; }
  0         0  
31             }
32 0         0 return %config;
33             }
34              
35             =head2 run
36              
37             Dist::Man::App->run;
38              
39             This is equivalent to running F. Its behavior is still subject
40             to change.
41              
42             =cut
43              
44             sub run
45             {
46 1   50 1 1 94 my $configdir = $ENV{MODULE_STARTER_DIR} || '';
47 1 50 33     7 if ( !$configdir && $ENV{HOME} ) {
48 1         3 $configdir = "$ENV{HOME}/.perl-dist-man";
49             }
50              
51 1         4 my %config = _config_read( "$configdir/config" );
52              
53             # The options that accept multiple arguments must be set to an
54             # arrayref
55              
56 1 50       4 $config{plugins} = [ split /(?:\s*,\s*|\s+)/, $config{plugins} ] if $config{plugins};
57 1 50       3 $config{builder} = [ split /(?:\s*,\s*|\s+)/, $config{builder} ] if $config{builder};
58              
59 1         3 foreach my $key ( qw( plugins modules builder ) ){
60 3 50       11 $config{$key} = [] unless exists $config{$key};
61             }
62              
63 1 50       3 pod2usage(2) unless @ARGV;
64 1         3 my $operation = shift(@ARGV);
65              
66             GetOptions(
67             'class=s' => \$config{class},
68             'plugin=s' => $config{plugins},
69             'dir=s' => \$config{dir},
70             'distro=s' => \$config{distro},
71             'module=s' => $config{modules},
72             'builder=s' => $config{builder},
73 0     0   0 eumm => sub { push @{$config{builder}}, 'ExtUtils::MakeMaker' },
  0         0  
74 1     1   1012 mb => sub { push @{$config{builder}}, 'Module::Build' },
  1         3  
75 0     0   0 mi => sub { push @{$config{builder}}, 'Module::Install' },
  0         0  
76              
77             'author=s' => \$config{author},
78             'email=s' => \$config{email},
79             'license=s' => \$config{license},
80             force => \$config{force},
81             verbose => \$config{verbose},
82             version =>
83             sub {
84 0     0   0 require Dist::Man;
85 0         0 print "pl-dist-man v$Dist::Man::VERSION\n";
86 0         0 exit 1;
87             },
88 0     0   0 help => sub { pod2usage(1); },
89 1 50       19 ) or pod2usage(2);
90              
91 1 50       707 if (@ARGV) {
92 0         0 pod2usage(
93             -msg => "Unparseable arguments received: " . join(',', @ARGV),
94             -exitval => 2,
95             );
96             }
97              
98              
99 1   50     6 $config{class} ||= 'Dist::Man';
100              
101 1 50       19 $config{builder} = ['ExtUtils::MakeMaker'] unless @{$config{builder}};
  1         5  
102              
103 1         55 eval "require $config{class};";
104 1 50       5 croak "invalid manager class $config{class}: $@" if $@;
105 1         3 $config{class}->import(@{$config{plugins}});
  1         6  
106              
107 1 50 33     5 if (! ( ($operation eq "setup") || ($operation eq "create") ) )
108             {
109 0         0 pod2usage(
110             -msg => "Not a valid operation - '$operation'",
111             -exitval => 2,
112             );
113             }
114              
115 1         10 $config{class}->create_distro( %config );
116              
117 1         13 print "Created manager directories and files\n";
118             }
119              
120             1;