File Coverage

blib/lib/App/Sqitch/Command/status.pm
Criterion Covered Total %
statement 116 116 100.0
branch 18 22 81.8
condition 8 10 80.0
subroutine 20 20 100.0
pod 5 5 100.0
total 167 173 96.5


line stmt bran cond sub pod time code
1              
2             use 5.010;
3 2     2   1512 use strict;
  2         6  
4 2     2   12 use warnings;
  2         7  
  2         46  
5 2     2   11 use utf8;
  2         3  
  2         41  
6 2     2   13 use Locale::TextDomain qw(App-Sqitch);
  2         4  
  2         8  
7 2     2   64 use App::Sqitch::X qw(hurl);
  2         10  
  2         11  
8 2     2   333 use Moo;
  2         5  
  2         13  
9 2     2   502 use App::Sqitch::Types qw(Str Bool Target);
  2         4  
  2         12  
10 2     2   662 use List::Util qw(max);
  2         4  
  2         18  
11 2     2   1597 use Try::Tiny;
  2         4  
  2         101  
12 2     2   12 use namespace::autoclean;
  2         5  
  2         75  
13 2     2   13  
  2         13  
  2         10  
14             extends 'App::Sqitch::Command';
15             with 'App::Sqitch::Role::ContextCommand';
16             with 'App::Sqitch::Role::ConnectingCommand';
17              
18             our $VERSION = 'v1.3.1'; # VERSION
19              
20             has target_name => (
21             is => 'ro',
22             isa => Str,
23             );
24              
25             has target => (
26             is => 'rw',
27             isa => Target,
28             handles => [qw(engine plan plan_file)],
29             );
30              
31             has show_changes => (
32             is => 'ro',
33             isa => Bool,
34             lazy => 1,
35             default => sub {
36             shift->sqitch->config->get(
37             key => "status.show_changes",
38             as => 'bool',
39             ) // 0;
40             }
41             );
42              
43             has show_tags => (
44             is => 'ro',
45             isa => Bool,
46             lazy => 1,
47             default => sub {
48             shift->sqitch->config->get(
49             key => "status.show_tags",
50             as => 'bool',
51             ) // 0;
52             }
53             );
54              
55             has date_format => (
56             is => 'ro',
57             lazy => 1,
58             isa => Str,
59             default => sub {
60             shift->sqitch->config->get( key => 'status.date_format' ) || 'iso'
61             }
62             );
63              
64             has project => (
65             is => 'ro',
66             isa => Str,
67             lazy => 1,
68             default => sub {
69             my $self = shift;
70             try { $self->plan->project } catch {
71             # Just die on parse and I/O errors.
72             die $_ if try { $_->ident eq 'parse' || $_->ident eq 'io' };
73              
74             # Try to extract a project name from the registry.
75             my $engine = $self->engine;
76             hurl status => __ 'Database not initialized for Sqitch'
77             unless $engine->initialized;
78             my @projs = $engine->registered_projects
79             or hurl status => __ 'No projects registered';
80             hurl status => __x(
81             'Use --project to select which project to query: {projects}',
82             projects => join __ ', ', @projs,
83             ) if @projs > 1;
84             return $projs[0];
85             };
86             },
87             );
88              
89             return qw(
90             project=s
91             target|t=s
92             show-tags
93             show-changes
94             date-format|date=s
95             );
96             }
97              
98             my $self = shift;
99             my ($targets) = $self->parse_args(
100             target => $self->target_name,
101 9     9 1 9808 args => \@_,
102 9         54 );
103              
104             # Warn on multiple targets.
105             my $target = shift @{ $targets };
106             $self->warn(__x(
107             'Too many targets specified; connecting to {target}',
108 9         16 target => $target->name,
  9         17  
109             )) if @{ $targets };
110              
111             # Good to go.
112 9 100       10 $self->target($target);
  9         38  
113             my $engine = $target->engine;
114              
115 9         286 # Where are we?
116 9         503 $self->comment( __x 'On database {db}', db => $engine->destination );
117              
118             # Exit with status 1 on no state, probably not expected.
119 9         1570 my $state = try {
120             $engine->current_state( $self->project )
121             } catch {
122             # Just die on parse and I/O errors.
123 9     9   477 die $_ if try { $_->ident eq 'parse' || $_->ident eq 'io' };
124              
125             # Hrm. Maybe not initialized?
126 1 0   1   27 die $_ if $engine->initialized;
  1 50       29  
127             hurl status => __x(
128             'Database {db} has not been initialized for Sqitch',
129 1 50       18 db => $engine->registry_destination
130 1         7 );
131             };
132              
133             hurl {
134 9         1244 ident => 'status',
135             message => __ 'No changes deployed',
136 8 100       503 exitval => 1,
137             } unless $state;
138              
139             # Emit the state basics.
140             $self->emit_state($state);
141              
142             # Emit changes and tags, if required.
143 7         21 $self->emit_changes;
144             $self->emit_tags;
145              
146 7         22 my $plan_proj = try { $target->plan->project };
147 7         715 if (defined $plan_proj && $self->project eq $plan_proj ) {
148             $self->emit_status($state);
149 7     7   684 } else {
  7         254  
150 7 100 66     410 # If we have no access to the project plan, we can't emit the status.
151 5         51 $self->comment('');
152             $self->emit(__x(
153             'Status unknown. Use --plan-file to assess "{project}" status',
154 2         43 project => $self->project,
155 2         78 ));
156             }
157              
158             return $self;
159             }
160              
161 7         280 my ( $class, $config, $opt ) = @_;
162              
163             # Make sure the date format is valid.
164             if (my $format = $opt->{date_format}
165             || $config->get(key => 'status.date_format')
166             ) {
167             require App::Sqitch::DateTime;
168             App::Sqitch::DateTime->validate_as_string_format($format);
169             }
170              
171             # Set boolean options from config.
172             for my $key (qw(show_changes show_tags)) {
173             next if exists $opt->{$key};
174             my $val = $config->get(key => "status.$key", as => 'bool') // next;
175             $opt->{$key} = $val;
176             }
177              
178             my $ret = $class->SUPER::configure( $config, $opt );
179             $ret->{target_name} = delete $ret->{target} if exists $ret->{target};
180             return $ret;
181             }
182              
183             my ( $self, $state ) = @_;
184             $self->comment(__x(
185             'Project: {project}',
186             project => $state->{project},
187             ));
188 10     10 1 3409 $self->comment(__x(
189             'Change: {change_id}',
190             change_id => $state->{change_id},
191             ));
192 10         35 $self->comment(__x(
193             'Name: {change}',
194             change => $state->{change},
195             ));
196 10         1099 if (my @tags = @{ $state->{tags}} ) {
197             $self->comment(__nx(
198             'Tag: {tags}',
199             'Tags: {tags}',
200 10         988 @tags,
201 10 100       917 tags => join(__ ', ', @tags),
  10         50  
202 9         28 ));
203             }
204              
205             $self->comment(__x(
206             'Deployed: {date}',
207             date => $state->{committed_at}->as_string(
208             format => $self->date_format
209             ),
210             ));
211             $self->comment(__x(
212             'By: {name} <{email}>',
213 10         1217 name => $state->{committer_name},
214             email=> $state->{committer_email},
215             ));
216             return $self;
217             }
218              
219             my $iter = shift;
220 10         2675 my @res;
221 10         1153 while (my $row = $iter->()) {
222             push @res => $row;
223             }
224             return \@res;
225 5     5   552 }
226 5         11  
227 5         11 my $self = shift;
228 8         29 return $self unless $self->show_changes;
229              
230 5         20 # Emit the header.
231             my $changes = _all $self->engine->current_changes( $self->project );
232             $self->comment('');
233             $self->comment(__n 'Change:', 'Changes:', @{ $changes });
234 10     10 1 5000  
235 10 100       157 # Find the longest change name.
236             my $len = max map { length $_->{change} } @{ $changes };
237             my $format = $self->date_format;
238 2         40  
239 2         34 # Emit each change.
240 2         53 $self->comment(sprintf(
  2         8  
241             ' %s%s - %s - %s <%s>',
242             $_->{change},
243 2         142 ((' ') x ($len - length $_->{change})) || '',
  4         13  
  2         4  
244 2         28 $_->{committed_at}->as_string( format => $format ),
245             $_->{committer_name},
246             $_->{committer_email},
247             )) for @{ $changes };
248              
249             return $self;
250             }
251              
252             my $self = shift;
253             return $self unless $self->show_tags;
254 2   100     139  
  2         17  
255             # Emit the header.
256 2         417 my $tags = _all $self->engine->current_tags( $self->project );
257             $self->comment('');
258              
259             # If no tags, say so and return.
260 11     11 1 7658 unless (@{ $tags }) {
261 11 100       181 $self->comment(__ 'Tags: None.');
262             return $self;
263             }
264 3         58  
265 3         50 $self->comment(__n 'Tag:', 'Tags:', @{ $tags });
266              
267             # Find the longest tag name.
268 3 100       78 my $len = max map { length $_->{tag} } @{ $tags };
  3         8  
269 1         4 my $format = $self->date_format;
270 1         73  
271             # Emit each tag.
272             $self->comment(sprintf(
273 2         4 ' %s%s - %s - %s <%s>',
  2         7  
274             $_->{tag},
275             ((' ') x ($len - length $_->{tag})) || '',
276 2         140 $_->{committed_at}->as_string( format => $format ),
  4         11  
  2         5  
277 2         27 $_->{committer_name},
278             $_->{committer_email},
279             )) for @{ $tags };
280              
281             return $self;
282             }
283              
284             my ( $self, $state ) = @_;
285             my $plan = $self->plan;
286             $self->comment('');
287 2   100     140  
  2         18  
288             my $idx = $plan->index_of( $state->{change_id} ) // do {
289 2         415 $self->vent(__x(
290             'Cannot find this change in {file}',
291             file => $self->plan_file
292             ));
293 9     9 1 1551 hurl status => __ 'Make sure you are connected to the proper '
294 9         132 . 'database for this project.';
295 9         440 };
296              
297 9   66     254 # Say something about our current state.
298 1         17 if ( $idx == $plan->count - 1 ) {
299             $self->emit( __ 'Nothing to deploy (up-to-date)' );
300             } else {
301             $self->emit(__n(
302 1         211 'Undeployed change:',
303             'Undeployed changes:',
304             $plan->count - ( $idx + 1 )
305             ));
306             $plan->position($idx);
307 8 100       33 while ( my $change = $plan->next ) {
308 1         4 $self->emit( ' * ', $change->format_name_with_tags );
309             }
310 7         21 }
311             return $self;
312             }
313              
314             1;
315 7         609  
316 7         187  
317 13         38 =head1 Name
318              
319             App::Sqitch::Command::status - Display status information about Sqitch
320 8         112  
321             =head1 Synopsis
322              
323             my $cmd = App::Sqitch::Command::status->new(%params);
324             $cmd->execute;
325              
326             =head1 Description
327              
328             If you want to know how to use the C<status> command, you probably want to be
329             reading C<sqitch-status>. But if you really want to know how the C<status> command
330             works, read on.
331              
332             =head1 Interface
333              
334             =head2 Attributes
335              
336             =head3 C<target_name>
337              
338             The name or URI of the database target as specified by the C<--target> option.
339              
340             =head3 C<target>
341              
342             An L<App::Sqitch::Target> object from which to read the status. Must be
343             instantiated by C<execute()>.
344              
345             =head2 Instance Methods
346              
347             =head3 C<execute>
348              
349             $status->execute;
350              
351             Executes the status command. The current state of the target database will be
352             compared to the plan in order to show where things stand.
353              
354             =head3 C<emit_changes>
355              
356             $status->emit_changes;
357              
358             Emits a list of deployed changes if C<show_changes> is true.
359              
360             =head3 C<emit_tags>
361              
362             $status->emit_tags;
363              
364             Emits a list of deployed tags if C<show_tags> is true.
365              
366             =head3 C<emit_state>
367              
368             $status->emit_state($state);
369              
370             Emits the current state of the target database. Pass in a state hash as
371             returned by L<App::Sqitch::Engine> C<current_state()>.
372              
373             =head3 C<emit_status>
374              
375             $status->emit_state($state);
376              
377             Emits information about the current status of the target database compared to
378             the plan. Pass in a state hash as returned by L<App::Sqitch::Engine>
379             C<current_state()>. Throws an exception if the current state's change cannot
380             be found in the plan.
381              
382             =head1 See Also
383              
384             =over
385              
386             =item L<sqitch-status>
387              
388             Documentation for the C<status> command to the Sqitch command-line client.
389              
390             =item L<sqitch>
391              
392             The Sqitch command-line client.
393              
394             =back
395              
396             =head1 Author
397              
398             David E. Wheeler <david@justatheory.com>
399              
400             =head1 License
401              
402             Copyright (c) 2012-2022 iovation Inc., David E. Wheeler
403              
404             Permission is hereby granted, free of charge, to any person obtaining a copy
405             of this software and associated documentation files (the "Software"), to deal
406             in the Software without restriction, including without limitation the rights
407             to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
408             copies of the Software, and to permit persons to whom the Software is
409             furnished to do so, subject to the following conditions:
410              
411             The above copyright notice and this permission notice shall be included in all
412             copies or substantial portions of the Software.
413              
414             THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
415             IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
416             FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
417             AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
418             LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
419             OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
420             SOFTWARE.
421              
422             =cut