/usr/share/perl5/Module/Starter/App.pm is in libmodule-starter-perl 1.620+dfsg-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 | package Module::Starter::App;
=head1 NAME
Module::Starter::App - the code behind the command line program
=cut
use warnings;
use strict;
our $VERSION = '1.62';
use Path::Class;
use Getopt::Long;
use Pod::Usage;
use Carp qw( croak );
sub _config_file {
my $self = shift;
my $configdir = $ENV{'MODULE_STARTER_DIR'} || '';
if ( !$configdir && $ENV{'HOME'} ) {
$configdir = dir( $ENV{'HOME'}, '.module-starter' );
}
return file( $configdir, 'config' );
}
sub _config_read {
my $self = shift;
my $filename = $self->_config_file;
return unless -e $filename;
open( my $config_file, '<', $filename )
or die "couldn't open config file $filename: $!\n";
my %config;
while (<$config_file>) {
chomp;
next if /\A\s*\Z/sm;
if (/\A(\w+):\s*(.+)\Z/sm) { $config{$1} = $2; }
}
return $self->_config_multi_process(%config);
}
sub _config_multi_process {
my ( $self, %config ) = @_;
# The options that accept multiple arguments must be set to an arrayref
foreach my $key (qw( builder ignores_type modules plugins )) {
$config{$key} = [ split /(?:\s*,\s*|\s+)/, (ref $config{$key} ? join(',', @{$config{$key}}) : $config{$key}) ] if $config{$key};
$config{$key} = [] unless exists $config{$key};
}
return %config;
}
sub _process_command_line {
my ( $self, %config ) = @_;
$config{'argv'} = [ @ARGV ];
pod2usage(2) unless @ARGV;
GetOptions(
'class=s' => \$config{class},
'plugin=s@' => \$config{plugins},
'dir=s' => \$config{dir},
'distro=s' => \$config{distro},
'module=s@' => \$config{modules},
'builder=s@' => \$config{builder},
'ignores=s@' => \$config{ignores_type},
eumm => sub { push @{$config{builder}}, 'ExtUtils::MakeMaker' },
mb => sub { push @{$config{builder}}, 'Module::Build' },
mi => sub { push @{$config{builder}}, 'Module::Install' },
'author=s' => \$config{author},
'email=s' => \$config{email},
'license=s' => \$config{license},
'minperl=s' => \$config{minperl},
force => \$config{force},
verbose => \$config{verbose},
version => sub {
require Module::Starter;
print "module-starter v$Module::Starter::VERSION\n";
exit 1;
},
help => sub { pod2usage(1); },
) or pod2usage(2);
if (@ARGV) {
pod2usage(
-msg => "Unparseable arguments received: " . join(',', @ARGV),
-exitval => 2,
);
}
$config{class} ||= 'Module::Starter';
$config{builder} = ['ExtUtils::MakeMaker'] unless $config{builder};
return %config;
}
=head2 run
Module::Starter::App->run;
This is equivalent to running F<module-starter>. Its behavior is still subject
to change.
=cut
sub run {
my $self = shift;
my %config = $self->_config_read;
%config = $self->_process_command_line(%config);
%config = $self->_config_multi_process(%config);
eval "require $config{class};";
croak "Could not load starter class $config{class}: $@" if $@;
$config{class}->import( @{ $config{'plugins'} } );
my $starter = $config{class}->new( %config );
$starter->postprocess_config;
$starter->pre_create_distro;
$starter->create_distro;
$starter->post_create_distro;
$starter->pre_exit;
return 1;
}
1;
|