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.037;
2             # ABSTRACT: set up a basic global config file
3              
4 4     4   3106 use Dist::Zilla::Pragmas;
  4         10  
  4         29  
5              
6 4     4   30 use Dist::Zilla::App -command;
  4         10  
  4         32  
7              
8 4     4   1195 use namespace::autoclean;
  4         12  
  4         71  
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   1452 use autodie;
  4         33642  
  4         31  
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 (you can leave this blank to be prompted)? ",
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.037
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
191             released in the last two to three years. (That is, if the most recently
192             released version is v5.40, then this module should work on both v5.40 and
193             v5.38.)
194              
195             Although it may work on older versions of perl, no guarantee is made that the
196             minimum required version will not be increased. The version may be increased
197             for any reason, and there is no promise that patches will be accepted to
198             lower the minimum required perl.
199              
200             =head1 AUTHOR
201              
202             Ricardo SIGNES 😏 <cpan@semiotic.systems>
203              
204             =head1 COPYRIGHT AND LICENSE
205              
206             This software is copyright (c) 2026 by Ricardo SIGNES.
207              
208             This is free software; you can redistribute it and/or modify it under
209             the same terms as the Perl 5 programming language system itself.
210              
211             =cut