line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package App::Sqitch::Command::rework; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
966
|
use 5.010; |
|
2
|
|
|
|
|
10
|
|
4
|
2
|
|
|
2
|
|
11
|
use strict; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
53
|
|
5
|
2
|
|
|
2
|
|
15
|
use warnings; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
65
|
|
6
|
2
|
|
|
2
|
|
12
|
use utf8; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
13
|
|
7
|
2
|
|
|
2
|
|
68
|
use Locale::TextDomain qw(App-Sqitch); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
15
|
|
8
|
2
|
|
|
2
|
|
425
|
use App::Sqitch::X qw(hurl); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
47
|
|
9
|
2
|
|
|
2
|
|
1714
|
use File::Copy; |
|
2
|
|
|
|
|
4734
|
|
|
2
|
|
|
|
|
136
|
|
10
|
2
|
|
|
2
|
|
17
|
use Moo; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
13
|
|
11
|
2
|
|
|
2
|
|
796
|
use App::Sqitch::Types qw(Str ArrayRef Bool Maybe); |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
23
|
|
12
|
2
|
|
|
2
|
|
2317
|
use namespace::autoclean; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
16
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
extends 'App::Sqitch::Command'; |
15
|
|
|
|
|
|
|
with 'App::Sqitch::Role::ContextCommand'; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
our $VERSION = 'v1.4.0'; # VERSION |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
has change_name => ( |
20
|
|
|
|
|
|
|
is => 'ro', |
21
|
|
|
|
|
|
|
isa => Maybe[Str], |
22
|
|
|
|
|
|
|
); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
has requires => ( |
25
|
|
|
|
|
|
|
is => 'ro', |
26
|
|
|
|
|
|
|
isa => ArrayRef[Str], |
27
|
|
|
|
|
|
|
default => sub { [] }, |
28
|
|
|
|
|
|
|
); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
has conflicts => ( |
31
|
|
|
|
|
|
|
is => 'ro', |
32
|
|
|
|
|
|
|
isa => ArrayRef[Str], |
33
|
|
|
|
|
|
|
default => sub { [] }, |
34
|
|
|
|
|
|
|
); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
has all => ( |
37
|
|
|
|
|
|
|
is => 'ro', |
38
|
|
|
|
|
|
|
isa => Bool, |
39
|
|
|
|
|
|
|
default => 0 |
40
|
|
|
|
|
|
|
); |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
has note => ( |
43
|
|
|
|
|
|
|
is => 'ro', |
44
|
|
|
|
|
|
|
isa => ArrayRef[Str], |
45
|
|
|
|
|
|
|
default => sub { [] }, |
46
|
|
|
|
|
|
|
); |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
has open_editor => ( |
49
|
|
|
|
|
|
|
is => 'ro', |
50
|
|
|
|
|
|
|
isa => Bool, |
51
|
|
|
|
|
|
|
lazy => 1, |
52
|
|
|
|
|
|
|
default => sub { |
53
|
|
|
|
|
|
|
my $self = shift; |
54
|
|
|
|
|
|
|
return $self->sqitch->config->get( |
55
|
|
|
|
|
|
|
key => 'rework.open_editor', |
56
|
|
|
|
|
|
|
as => 'bool', |
57
|
|
|
|
|
|
|
) // $self->sqitch->config->get( |
58
|
|
|
|
|
|
|
key => 'add.open_editor', |
59
|
|
|
|
|
|
|
as => 'bool', |
60
|
|
|
|
|
|
|
) // 0; |
61
|
|
|
|
|
|
|
}, |
62
|
|
|
|
|
|
|
); |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub options { |
65
|
|
|
|
|
|
|
return qw( |
66
|
|
|
|
|
|
|
change-name|change|c=s |
67
|
|
|
|
|
|
|
requires|r=s@ |
68
|
|
|
|
|
|
|
conflicts|x=s@ |
69
|
|
|
|
|
|
|
all|a! |
70
|
|
|
|
|
|
|
note|n|m=s@ |
71
|
|
|
|
|
|
|
open-editor|edit|e! |
72
|
|
|
|
|
|
|
); |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
sub configure { |
76
|
|
|
|
|
|
|
my ( $class, $config, $opt ) = @_; |
77
|
|
|
|
|
|
|
# Just keep the options. |
78
|
|
|
|
|
|
|
return $opt; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub execute { |
82
|
12
|
|
|
12
|
1
|
44215
|
my $self = shift; |
83
|
12
|
|
|
|
|
211
|
my ($name, $targets, $changes) = $self->parse_args( |
84
|
|
|
|
|
|
|
names => [$self->change_name], |
85
|
|
|
|
|
|
|
all => $self->all, |
86
|
|
|
|
|
|
|
args => \@_, |
87
|
|
|
|
|
|
|
no_changes => 1, |
88
|
|
|
|
|
|
|
); |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
# Check if the name is identified as a change. |
91
|
11
|
|
0
|
|
|
88
|
$name ||= shift @{ $changes } || $self->usage; |
|
|
|
33
|
|
|
|
|
92
|
|
|
|
|
|
|
|
93
|
11
|
|
|
|
|
33
|
my $note = join "\n\n", => @{ $self->note }; |
|
11
|
|
|
|
|
99
|
|
94
|
11
|
|
|
|
|
54
|
my ($first_change, %reworked, @files, %seen); |
95
|
|
|
|
|
|
|
|
96
|
11
|
|
|
|
|
26
|
for my $target (@{ $targets }) { |
|
11
|
|
|
|
|
56
|
|
97
|
16
|
|
|
|
|
839
|
my $plan = $target->plan; |
98
|
16
|
|
|
|
|
2407
|
my $file = $plan->file; |
99
|
16
|
|
100
|
|
|
5495
|
my $spec = $reworked{$file} ||= { scripts => [] }; |
100
|
16
|
|
|
|
|
681
|
my ($prev, $reworked); |
101
|
16
|
100
|
|
|
|
71
|
if ($prev = $spec->{prev}) { |
102
|
|
|
|
|
|
|
# Need a dupe for *this* target so script names are right. |
103
|
1
|
|
|
|
|
43
|
$reworked = ref($prev)->new( |
104
|
|
|
|
|
|
|
plan => $plan, |
105
|
|
|
|
|
|
|
name => $name, |
106
|
|
|
|
|
|
|
); |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
# Copy the rework tags to the previous instance in this plan. |
109
|
1
|
|
|
|
|
361
|
my $new_prev = $spec->{prev} = $plan->get( |
110
|
|
|
|
|
|
|
$name . [$plan->last_tagged_change->tags]->[-1]->format_name |
111
|
|
|
|
|
|
|
); |
112
|
1
|
|
|
|
|
17
|
$new_prev->add_rework_tags($prev->rework_tags); |
113
|
1
|
|
|
|
|
48
|
$prev = $new_prev; |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
} else { |
116
|
|
|
|
|
|
|
# Rework it. |
117
|
15
|
|
|
|
|
178
|
$reworked = $spec->{change} = $plan->rework( |
118
|
|
|
|
|
|
|
name => $name, |
119
|
|
|
|
|
|
|
requires => $self->requires, |
120
|
|
|
|
|
|
|
conflicts => $self->conflicts, |
121
|
|
|
|
|
|
|
note => $note, |
122
|
|
|
|
|
|
|
); |
123
|
13
|
|
66
|
|
|
114
|
$first_change ||= $reworked; |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
# Get the latest instance of the change. |
126
|
13
|
|
|
|
|
109
|
$prev = $spec->{prev} = $plan->get( |
127
|
|
|
|
|
|
|
$name . [$plan->last_tagged_change->tags]->[-1]->format_name |
128
|
|
|
|
|
|
|
); |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
# Record the files to be copied to the previous change name. |
132
|
14
|
|
|
|
|
134
|
push @{ $spec->{scripts} } => map { |
133
|
39
|
100
|
|
|
|
579
|
push @files => $_->[0] if -e $_->[0]; |
134
|
39
|
|
|
|
|
1865
|
$_; |
135
|
|
|
|
|
|
|
} grep { |
136
|
14
|
|
|
|
|
56
|
!$seen{ $_->[0] }++; |
|
42
|
|
|
|
|
2203
|
|
137
|
|
|
|
|
|
|
} ( |
138
|
|
|
|
|
|
|
[ $reworked->deploy_file, $prev->deploy_file ], |
139
|
|
|
|
|
|
|
[ $reworked->revert_file, $prev->revert_file ], |
140
|
|
|
|
|
|
|
[ $reworked->verify_file, $prev->verify_file ], |
141
|
|
|
|
|
|
|
); |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
# Replace the revert file with the previous deploy file. |
144
|
13
|
|
|
|
|
1520
|
push @{ $spec->{scripts} } => [ |
145
|
|
|
|
|
|
|
$reworked->deploy_file, |
146
|
|
|
|
|
|
|
$reworked->revert_file, |
147
|
|
|
|
|
|
|
$prev->revert_file, |
148
|
14
|
100
|
|
|
|
110
|
] unless $seen{$prev->revert_file}++; |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
# Make sure we have a note. |
152
|
9
|
|
|
|
|
878
|
$note = $first_change->request_note( |
153
|
|
|
|
|
|
|
for => __ 'rework', |
154
|
|
|
|
|
|
|
scripts => \@files, |
155
|
|
|
|
|
|
|
); |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
# Time to write everything out. |
158
|
9
|
|
|
|
|
62
|
for my $target (@{ $targets }) { |
|
9
|
|
|
|
|
38
|
|
159
|
14
|
|
|
|
|
1302
|
my $plan = $target->plan; |
160
|
14
|
|
|
|
|
322
|
my $file = $plan->file; |
161
|
14
|
100
|
|
|
|
144
|
my $spec = delete $reworked{$file} or next; |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
# Copy the files for this spec. |
164
|
13
|
|
|
|
|
363
|
$self->_copy(@{ $_ }) for @{ $spec->{scripts } }; |
|
13
|
|
|
|
|
57
|
|
|
52
|
|
|
|
|
241
|
|
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
# We good, write the plan file back out. |
167
|
13
|
|
|
|
|
243
|
$plan->write_to( $plan->file ); |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
# Let the user know. |
170
|
|
|
|
|
|
|
$self->info(__x( |
171
|
|
|
|
|
|
|
'Added "{change}" to {file}.', |
172
|
|
|
|
|
|
|
change => $spec->{change}->format_op_name_dependencies, |
173
|
13
|
|
|
|
|
83
|
file => $plan->file, |
174
|
|
|
|
|
|
|
)); |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
# Now tell them what to do. |
178
|
9
|
|
|
|
|
1709
|
$self->info(__n( |
179
|
|
|
|
|
|
|
'Modify this file as appropriate:', |
180
|
|
|
|
|
|
|
'Modify these files as appropriate:', |
181
|
|
|
|
|
|
|
scalar @files, |
182
|
|
|
|
|
|
|
)); |
183
|
9
|
|
|
|
|
1083
|
$self->info(" * $_") for @files; |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
# Let 'em at it. |
186
|
9
|
100
|
|
|
|
2828
|
if ($self->open_editor) { |
187
|
1
|
|
|
|
|
36
|
my $sqitch = $self->sqitch; |
188
|
1
|
|
|
|
|
32
|
$sqitch->shell( $sqitch->editor . ' ' . $sqitch->quote_shell(@files) ); |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
|
191
|
9
|
|
|
|
|
3862
|
return $self; |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
sub _copy { |
195
|
52
|
|
|
52
|
|
138
|
my ( $self, $src, $dest, $orig ) = @_; |
196
|
52
|
|
66
|
|
|
307
|
$orig ||= $src; |
197
|
52
|
100
|
|
|
|
404
|
if (!-e $orig) { |
198
|
6
|
|
|
|
|
256
|
$self->debug(__x( |
199
|
|
|
|
|
|
|
'Skipped {dest}: {src} does not exist', |
200
|
|
|
|
|
|
|
dest => $dest, |
201
|
|
|
|
|
|
|
src => $orig, |
202
|
|
|
|
|
|
|
)); |
203
|
6
|
|
|
|
|
1183
|
return; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
# Create the directory for the file, if it does not exist. |
207
|
46
|
|
|
|
|
2284
|
$self->_mkpath($dest->dir->stringify); |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
# Stringify to work around bug in File::Copy warning on 5.10.0. |
210
|
46
|
50
|
|
|
|
241
|
File::Copy::syscopy "$src", "$dest" or hurl rework => __x( |
211
|
|
|
|
|
|
|
'Cannot copy {src} to {dest}: {error}', |
212
|
|
|
|
|
|
|
src => $src, |
213
|
|
|
|
|
|
|
dest => $dest, |
214
|
|
|
|
|
|
|
error => $!, |
215
|
|
|
|
|
|
|
); |
216
|
|
|
|
|
|
|
|
217
|
46
|
|
|
|
|
20103
|
$self->debug(__x( |
218
|
|
|
|
|
|
|
'Copied {src} to {dest}', |
219
|
|
|
|
|
|
|
dest => $dest, |
220
|
|
|
|
|
|
|
src => $src, |
221
|
|
|
|
|
|
|
)); |
222
|
46
|
|
|
|
|
10581
|
return $orig; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
1; |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
__END__ |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=head1 Name |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
App::Sqitch::Command::rework - Rework a Sqitch change |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
=head1 Synopsis |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
my $cmd = App::Sqitch::Command::rework->new(%params); |
236
|
|
|
|
|
|
|
$cmd->execute; |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=head1 Description |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
Reworks a change. This will result in the copying of the existing deploy, |
241
|
|
|
|
|
|
|
revert, and verify scripts for the change to preserve the earlier instances of |
242
|
|
|
|
|
|
|
the change. |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=head1 Interface |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
=head2 Class Methods |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
=head3 C<options> |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
my @opts = App::Sqitch::Command::rework->options; |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
Returns a list of L<Getopt::Long> option specifications for the command-line |
253
|
|
|
|
|
|
|
options for the C<rework> command. |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
=head3 C<configure> |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
my $params = App::Sqitch::Command::rework->configure( |
258
|
|
|
|
|
|
|
$config, |
259
|
|
|
|
|
|
|
$options, |
260
|
|
|
|
|
|
|
); |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
Processes the configuration and command options and returns a hash suitable |
263
|
|
|
|
|
|
|
for the constructor. |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
=head2 Attributes |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
=head3 C<change_name> |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
The name of the change to be reworked. |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
=head3 C<note> |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
Text of the change note. |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
=head3 C<requires> |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
List of required changes. |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
=head3 C<conflicts> |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
List of conflicting changes. |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
=head3 C<all> |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
Boolean indicating whether or not to run the command against all plans in the |
286
|
|
|
|
|
|
|
project. |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
=head2 Instance Methods |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
=head3 C<execute> |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
$rework->execute($command); |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
Executes the C<rework> command. |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
=head1 See Also |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
=over |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
=item L<sqitch-rework> |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
Documentation for the C<rework> command to the Sqitch command-line client. |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
=item L<sqitch> |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
The Sqitch command-line client. |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
=back |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
=head1 Author |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
David E. Wheeler <david@justatheory.com> |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
=head1 License |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
Copyright (c) 2012-2023 iovation Inc., David E. Wheeler |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
Permission is hereby granted, free of charge, to any person obtaining a copy |
319
|
|
|
|
|
|
|
of this software and associated documentation files (the "Software"), to deal |
320
|
|
|
|
|
|
|
in the Software without restriction, including without limitation the rights |
321
|
|
|
|
|
|
|
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell |
322
|
|
|
|
|
|
|
copies of the Software, and to permit persons to whom the Software is |
323
|
|
|
|
|
|
|
furnished to do so, subject to the following conditions: |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
The above copyright notice and this permission notice shall be included in all |
326
|
|
|
|
|
|
|
copies or substantial portions of the Software. |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR |
329
|
|
|
|
|
|
|
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, |
330
|
|
|
|
|
|
|
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE |
331
|
|
|
|
|
|
|
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER |
332
|
|
|
|
|
|
|
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, |
333
|
|
|
|
|
|
|
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE |
334
|
|
|
|
|
|
|
SOFTWARE. |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
=cut |