File Coverage

blib/lib/App/Sqitch/Command/init.pm
Criterion Covered Total %
statement 94 94 100.0
branch 30 32 93.7
condition 7 13 53.8
subroutine 16 16 100.0
pod 2 2 100.0
total 149 157 94.9


line stmt bran cond sub pod time code
1             package App::Sqitch::Command::init;
2              
3 2     2   59419 use 5.010;
  2         8  
4 2     2   15 use strict;
  2         4  
  2         42  
5 2     2   9 use warnings;
  2         6  
  2         56  
6 2     2   29 use utf8;
  2         5  
  2         12  
7 2     2   49 use Moo;
  2         4  
  2         14  
8 2     2   855 use App::Sqitch::Types qw(URI Maybe);
  2         11  
  2         26  
9 2     2   1758 use Locale::TextDomain qw(App-Sqitch);
  2         4  
  2         16  
10 2     2   398 use App::Sqitch::X qw(hurl);
  2         13  
  2         37  
11 2     2   575 use List::MoreUtils qw(natatime);
  2         5  
  2         31  
12 2     2   2260 use Path::Class;
  2         10  
  2         94  
13 2     2   17 use App::Sqitch::Plan;
  2         5  
  2         41  
14 2     2   12 use namespace::autoclean;
  2         10  
  2         14  
15 2     2   146 use constant extra_target_keys => qw(engine target);
  2         4  
  2         2304  
16              
17             extends 'App::Sqitch::Command';
18             with 'App::Sqitch::Role::TargetConfigCommand';
19              
20             our $VERSION = 'v1.4.0'; # VERSION
21              
22             sub execute {
23 1     1 1 3466 my ( $self, $project ) = @_;
24 1         6 $self->_validate_project($project);
25 1         17 $self->write_config;
26 1         15 my $target = $self->config_target;
27 1         105 $self->write_plan(
28             project => $project,
29             uri => $self->uri,
30             target => $target,
31             );
32 1         55 $self->make_directories_for($target);
33 1         17 return $self;
34             }
35              
36             has uri => (
37             is => 'ro',
38             isa => Maybe[URI],
39             );
40              
41             sub options {
42             return qw(uri=s);
43             }
44              
45             sub _validate_project {
46 13     13   36259 my ( $self, $project ) = @_;
47 13 100       41 $self->usage unless $project;
48 12         58 my $name_re = 'App::Sqitch::Plan'->name_regex;
49 12 100       256 hurl init => __x(
50             qq{invalid project name "{project}": project names must not }
51             . 'begin with punctuation, contain "@", ":", "#", or blanks, or end in '
52             . 'punctuation or digits following punctuation',
53             project => $project
54             ) unless $project =~ /\A$name_re\z/;
55             }
56              
57             sub configure {
58             my ( $class, $config, $opt ) = @_;
59              
60             if ( my $uri = $opt->{uri} ) {
61             require URI;
62             $opt->{uri} = 'URI'->new($uri);
63             }
64              
65             return $opt;
66             }
67              
68             sub write_config {
69 12     12 1 16743 my $self = shift;
70 12         133 my $sqitch = $self->sqitch;
71 12         570 my $config = $sqitch->config;
72 12         324 my $file = $config->local_file;
73 12 100       1630 if ( -f $file ) {
74              
75             # Do nothing? Update config?
76 1         83 return $self;
77             }
78              
79 11         374 my ( @vars, @comments );
80              
81             # Get the props, and make sure the target can find the engine.
82 11         65 my $props = $self->properties;
83 11         113 my $target = $self->config_target;
84              
85             # Write the engine from --engine or core.engine.
86 11   100     1950 my $ekey = $props->{engine} || $target->engine_key;
87 11 100       611 if ($ekey) {
88 7         77 push @vars => {
89             key => "core.engine",
90             value => $ekey,
91             };
92             }
93             else {
94 4         17 push @comments => "\tengine = ";
95             }
96              
97             # Add core properties.
98 11         80 for my $name (qw(
99             plan_file
100             top_dir
101             )) {
102             # Set properties passed on the command-line.
103 22 100       223 if ( my $val = $props->{$name} ) {
104 3         40 push @vars => {
105             key => "core.$name",
106             value => $val,
107             };
108             }
109             else {
110 19   50     681 my $val //= $target->$name // '';
      33        
111 19         6625 push @comments => "\t$name = $val";
112             }
113             }
114              
115             # Add script options passed to the init command. No comments if not set.
116 11         244 for my $attr (qw(
117             extension
118             deploy_dir
119             revert_dir
120             verify_dir
121             reworked_dir
122             reworked_deploy_dir
123             reworked_revert_dir
124             reworked_verify_dir
125             )) {
126             push @vars => { key => "core.$attr", value => $props->{$attr} }
127 88 100       260 if defined $props->{$attr};
128             }
129              
130             # Add variables.
131 11 100       61 if (my $vars = $props->{variables}) {
132             push @vars => map {{
133             key => "core.variables.$_",
134 2         18 value => $vars->{$_},
135 1         3 }} keys %{ $vars };
  1         9  
136             }
137              
138             # Emit them.
139 11 100       50 if (@vars) {
140 10         130 $config->group_set( $file => \@vars );
141             }
142             else {
143 1         5 unshift @comments => '[core]';
144             }
145              
146             # Emit the comments.
147 11 100       20853 $config->add_comment(
148             filename => $file,
149             indented => 1,
150             comment => join "\n" => @comments,
151             ) if @comments;
152              
153 11 100       10676 if ($ekey) {
154             # Write out the engine.$engine section.
155 7         72 my $config_key = "engine.$ekey";
156 7         43 @comments = @vars = ();
157              
158 7         29 for my $key (qw(target registry client)) {
159             # Was it passed as an option?
160 21 100       106 if ( my $val = $props->{$key} ) {
161 4         39 push @vars => {
162             key => "$config_key.$key",
163             value => $val,
164             };
165             # We're good on this one.
166 4         21 next;
167             }
168              
169             # No value, but add it as a comment, possibly with a default.
170 17   33     474 my $def = $target->$key
      50        
171             // $config->get( key => "$config_key.$key" )
172             // '';
173 17         1791 push @comments => "\t$key = $def";
174             }
175              
176 7 100       81 if (@vars) {
177             # Emit them.
178 2 50       43 $config->group_set( $file => \@vars ) if @vars;
179             }
180             else {
181             # Still want the section, emit it as a comment.
182 5         34 unshift @comments => qq{[engine "$ekey"]};
183             }
184              
185             # Emit the comments.
186 7 100       6596 $config->add_comment(
187             filename => $file,
188             indented => 1,
189             comment => join "\n" => @comments,
190             ) if @comments;
191             }
192              
193             # Is there are target?
194 11 100       5839 if (my $target_name = $props->{target}) {
195             # If it's a named target, add it to the configuration.
196 1 50       24 $config->set(
197             filename => $file,
198             key => "target.$target_name.uri",
199             value => $target->uri,
200             ) if $target_name !~ /:/
201             }
202              
203 11         130 $self->info( __x 'Created {file}', file => $file );
204 11         2979 return $self;
205             }
206              
207             1;
208              
209             __END__
210              
211             =head1 Name
212              
213             App::Sqitch::Command::init - Initialize a Sqitch project
214              
215             =head1 Synopsis
216              
217             my $cmd = App::Sqitch::Command::init->new(%params);
218             $cmd->execute;
219              
220             =head1 Description
221              
222             This command creates the files and directories for a new Sqitch project -
223             basically a F<sqitch.conf> file and directories for deploy and revert
224             scripts.
225              
226             =head1 Interface
227              
228             =head2 Class Methods
229              
230             =head3 C<options>
231              
232             my @opts = App::Sqitch::Command::init->options;
233              
234             Returns a list of L<Getopt::Long> option specifications for the command-line
235             options for the C<config> command.
236              
237             =head3 C<extra_target_keys>
238              
239             Returns a list of additional option keys to be specified via options.
240              
241             =head2 Attributes
242              
243             =head3 C<uri>
244              
245             URI for the project.
246              
247             =head3 C<properties>
248              
249             Hash of property values to set.
250              
251             =head2 Instance Methods
252              
253             =head3 C<execute>
254              
255             $init->execute($project);
256              
257             Executes the C<init> command.
258              
259             =head3 C<write_config>
260              
261             $init->write_config;
262              
263             Writes out the configuration file. Called by C<execute()>.
264              
265             =head1 Author
266              
267             David E. Wheeler <david@justatheory.com>
268              
269             =head1 License
270              
271             Copyright (c) 2012-2023 iovation Inc., David E. Wheeler
272              
273             Permission is hereby granted, free of charge, to any person obtaining a copy
274             of this software and associated documentation files (the "Software"), to deal
275             in the Software without restriction, including without limitation the rights
276             to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
277             copies of the Software, and to permit persons to whom the Software is
278             furnished to do so, subject to the following conditions:
279              
280             The above copyright notice and this permission notice shall be included in all
281             copies or substantial portions of the Software.
282              
283             THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
284             IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
285             FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
286             AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
287             LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
288             OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
289             SOFTWARE.
290              
291             =cut
292