File Coverage

blib/lib/Dist/Zilla/App/Command/setup.pm
Criterion Covered Total %
statement 12 62 19.3
branch 0 28 0.0
condition 0 6 0.0
subroutine 4 14 28.5
pod 4 4 100.0
total 20 114 17.5


line stmt bran cond sub pod time code
1             package Dist::Zilla::App::Command::setup 6.030;
2             # ABSTRACT: set up a basic global config file
3              
4 4     4   2796 use Dist::Zilla::Pragmas;
  4         10  
  4         27  
5              
6 4     4   34 use Dist::Zilla::App -command;
  4         11  
  4         42  
7              
8 4     4   1160 use namespace::autoclean;
  4         17  
  4         32  
9              
10             #pod =head1 SYNOPSIS
11             #pod
12             #pod $ dzil setup
13             #pod Enter your name> Ricardo Signes
14             #pod ...
15             #pod
16             #pod Dist::Zilla looks for per-user configuration in F<~/.dzil/config.ini>. This
17             #pod command prompts the user for some basic information that can be used to produce
18             #pod the most commonly needed F<config.ini> sections.
19             #pod
20             #pod B<WARNING>: PAUSE account details are stored within config.ini in plain text.
21             #pod
22             #pod =cut
23              
24 4     4   1520 use autodie;
  4         29868  
  4         28  
25              
26 0     0 1   sub abstract { 'set up a basic global config file' }
27              
28             sub description {
29 0     0 1   "This command will run through a short interactive process to set up\n" .
30             "a basic Dist::Zilla configuration in ~/.dzil/config.ini"
31             }
32              
33             sub validate_args {
34 0     0 1   my ($self, $opt, $args) = @_;
35              
36 0 0         $self->usage_error('too many arguments') if @$args != 0;
37             }
38              
39             sub execute {
40 0     0 1   my ($self, $opt, $arg) = @_;
41              
42 0           my $chrome = $self->app->chrome;
43              
44 0           require Dist::Zilla::Util;
45 0           my $config_root = Dist::Zilla::Util->_global_config_root;
46              
47 0 0 0       if (
48             -d $config_root
49             and
50 0 0         my @files = grep { -f and $_->basename =~ /\Aconfig\.[^.]+\z/ }
51             $config_root->children
52             ) {
53 0           $chrome->logger->log_fatal([
54             "per-user configuration files already exist in %s: %s",
55             "$config_root",
56             join(q{, }, @files),
57             ]);
58              
59 0 0         return unless $chrome->prompt_yn("Continue anyway?", { default => 0 });
60             }
61              
62             my $realname = $chrome->prompt_str(
63             "What's your name? ",
64 0 0   0     { check => sub { defined $_[0] and $_[0] =~ /\S/ } },
65 0           );
66              
67             my $email = $chrome->prompt_str(
68             "What's your email address? ",
69 0 0   0     { check => sub { defined $_[0] and $_[0] =~ /\A\S+\@\S+\z/ } },
70 0           );
71              
72             my $c_holder = $chrome->prompt_str(
73             "Who, by default, holds the copyright on your code? ",
74             {
75 0 0   0     check => sub { defined $_[0] and $_[0] =~ /\S/ },
76 0           default => $realname,
77             },
78             );
79              
80             my $license = $chrome->prompt_str(
81             "What license will you use by default (Perl_5, BSD, etc.)? ",
82             {
83             default => 'Perl_5',
84             check => sub {
85 0     0     my $str = String::RewritePrefix->rewrite(
86             { '' => 'Software::License::', '=' => '' },
87             $_[0],
88             );
89              
90 0   0       return Params::Util::_CLASS($str) && eval "require $str; 1";
91             },
92             },
93 0           );
94              
95 0           my %pause;
96              
97 0 0         if (
98             $chrome->prompt_yn(
99             '
100             * WARNING - Your account details will be stored in plain text *
101             Do you want to enter your PAUSE account details? ',
102             { default => 0 },
103             )
104             ) {
105 0           my $default_pause;
106 0 0         if ($email =~ /\A(.+?)\@cpan\.org\z/i) {
107 0           $default_pause = uc $1;
108             }
109              
110             $pause{username} = $chrome->prompt_str(
111             "What is your PAUSE id? ",
112             {
113 0 0   0     check => sub { defined $_[0] and $_[0] =~ /\A\w+\z/ },
114 0           default => $default_pause,
115             },
116             );
117              
118             $pause{password} = $chrome->prompt_str(
119             "What is your PAUSE password? ",
120             {
121 0     0     check => sub { length $_[0] },
122 0           noecho => 1,
123             },
124             );
125             }
126              
127 0 0         $config_root->mkpath unless -d $config_root;
128 0 0         $config_root->child('profiles')->mkpath
129             unless -d $config_root->child('profiles');
130              
131 0           my $umask = umask;
132 0           umask( $umask | 077 ); # this file might contain PAUSE pw; make it go-r
133 0           open my $fh, '>:encoding(UTF-8)', $config_root->child('config.ini');
134              
135 0           $fh->print("[%User]\n");
136 0           $fh->print("name = $realname\n");
137 0           $fh->print("email = $email\n\n");
138              
139 0           $fh->print("[%Rights]\n");
140 0           $fh->print("license_class = $license\n");
141 0           $fh->print("copyright_holder = $c_holder\n\n");
142              
143 0 0         if (keys %pause) {
144 0           $fh->print("[%PAUSE]\n");
145 0           $fh->print("username = $pause{username}\n");
146 0 0         if (length $pause{password}) {
147 0           $fh->print("password = $pause{password}\n");
148             }
149 0           $fh->print("\n");
150             }
151              
152 0           close $fh;
153              
154 0           umask $umask;
155              
156 0           $self->log("config.ini file created!");
157             }
158              
159             1;
160              
161             __END__
162              
163             =pod
164              
165             =encoding UTF-8
166              
167             =head1 NAME
168              
169             Dist::Zilla::App::Command::setup - set up a basic global config file
170              
171             =head1 VERSION
172              
173             version 6.030
174              
175             =head1 SYNOPSIS
176              
177             $ dzil setup
178             Enter your name> Ricardo Signes
179             ...
180              
181             Dist::Zilla looks for per-user configuration in F<~/.dzil/config.ini>. This
182             command prompts the user for some basic information that can be used to produce
183             the most commonly needed F<config.ini> sections.
184              
185             B<WARNING>: PAUSE account details are stored within config.ini in plain text.
186              
187             =head1 PERL VERSION
188              
189             This module should work on any version of perl still receiving updates from
190             the Perl 5 Porters. This means it should work on any version of perl released
191             in the last two to three years. (That is, if the most recently released
192             version is v5.40, then this module should work on both v5.40 and v5.38.)
193              
194             Although it may work on older versions of perl, no guarantee is made that the
195             minimum required version will not be increased. The version may be increased
196             for any reason, and there is no promise that patches will be accepted to lower
197             the minimum required perl.
198              
199             =head1 AUTHOR
200              
201             Ricardo SIGNES 😏 <cpan@semiotic.systems>
202              
203             =head1 COPYRIGHT AND LICENSE
204              
205             This software is copyright (c) 2023 by Ricardo SIGNES.
206              
207             This is free software; you can redistribute it and/or modify it under
208             the same terms as the Perl 5 programming language system itself.
209              
210             =cut