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
|
|
|
|
|
|
|
|