File Coverage

blib/lib/App/Sqitch/Command/rework.pm
Criterion Covered Total %
statement 82 82 100.0
branch 13 14 92.8
condition 7 14 50.0
subroutine 12 12 100.0
pod 1 1 100.0
total 115 123 93.5


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