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   1840 use strict;
  2         9  
4 2     2   12 use warnings;
  2         4  
  2         43  
5 2     2   8 use utf8;
  2         3  
  2         60  
6 2     2   11 use Locale::TextDomain qw(App-Sqitch);
  2         4  
  2         11  
7 2     2   50 use App::Sqitch::X qw(hurl);
  2         4  
  2         15  
8 2     2   372 use Moo;
  2         5  
  2         17  
9 2     2   638 use App::Sqitch::Types qw(Str Bool Target);
  2         5  
  2         14  
10 2     2   705 use List::Util qw(max);
  2         4  
  2         21  
11 2     2   1727 use Try::Tiny;
  2         5  
  2         109  
12 2     2   12 use namespace::autoclean;
  2         3  
  2         91  
13 2     2   13  
  2         4  
  2         14  
14             extends 'App::Sqitch::Command';
15             with 'App::Sqitch::Role::ContextCommand';
16             with 'App::Sqitch::Role::ConnectingCommand';
17              
18             our $VERSION = 'v1.3.0'; # 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 8604 args => \@_,
102 9         44 );
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         14 target => $target->name,
  9         18  
109             )) if @{ $targets };
110              
111             # Good to go.
112 9 100       15 $self->target($target);
  9         23  
113             my $engine = $target->engine;
114              
115 9         285 # Where are we?
116 9         520 $self->comment( __x 'On database {db}', db => $engine->destination );
117              
118             # Exit with status 1 on no state, probably not expected.
119 9         1575 my $state = try {
120             $engine->current_state( $self->project )
121             } catch {
122             # Just die on parse and I/O errors.
123 9     9   498 die $_ if try { $_->ident eq 'parse' || $_->ident eq 'io' };
124              
125             # Hrm. Maybe not initialized?
126 1 0   1   41 die $_ if $engine->initialized;
  1 50       30  
127             hurl status => __x(
128             'Database {db} has not been initialized for Sqitch',
129 1 50       17 db => $engine->registry_destination
130 1         8 );
131             };
132              
133             hurl {
134 9         1365 ident => 'status',
135             message => __ 'No changes deployed',
136 8 100       461 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         26 my $plan_proj = try { $target->plan->project };
147 7         725 if (defined $plan_proj && $self->project eq $plan_proj ) {
148             $self->emit_status($state);
149 7     7   710 } else {
  7         253  
150 7 100 66     425 # If we have no access to the project plan, we can't emit the status.
151 5         47 $self->comment('');
152             $self->emit(__x(
153             'Status unknown. Use --plan-file to assess "{project}" status',
154 2         61 project => $self->project,
155 2         82 ));
156             }
157              
158             return $self;
159             }
160              
161 7         296 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 3178 $self->comment(__x(
189             'Change: {change_id}',
190             change_id => $state->{change_id},
191             ));
192 10         34 $self->comment(__x(
193             'Name: {change}',
194             change => $state->{change},
195             ));
196 10         1142 if (my @tags = @{ $state->{tags}} ) {
197             $self->comment(__nx(
198             'Tag: {tags}',
199             'Tags: {tags}',
200 10         994 @tags,
201 10 100       923 tags => join(__ ', ', @tags),
  10         44  
202 9         33 ));
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         1229 name => $state->{committer_name},
214             email=> $state->{committer_email},
215             ));
216             return $self;
217             }
218              
219             my $iter = shift;
220 10         2159 my @res;
221 10         1196 while (my $row = $iter->()) {
222             push @res => $row;
223             }
224             return \@res;
225 5     5   582 }
226 5         7  
227 5         10 my $self = shift;
228 8         33 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 4100  
235 10 100       152 # Find the longest change name.
236             my $len = max map { length $_->{change} } @{ $changes };
237             my $format = $self->date_format;
238 2         40  
239 2         33 # Emit each change.
240 2         54 $self->comment(sprintf(
  2         9  
241             ' %s%s - %s - %s <%s>',
242             $_->{change},
243 2         144 ((' ') x ($len - length $_->{change})) || '',
  4         12  
  2         4  
244 2         30 $_->{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     140  
  2         18  
255             # Emit the header.
256 2         312 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 6539 unless (@{ $tags }) {
261 11 100       176 $self->comment(__ 'Tags: None.');
262             return $self;
263             }
264 3         61  
265 3         49 $self->comment(__n 'Tag:', 'Tags:', @{ $tags });
266              
267             # Find the longest tag name.
268 3 100       87 my $len = max map { length $_->{tag} } @{ $tags };
  3         11  
269 1         4 my $format = $self->date_format;
270 1         79  
271             # Emit each tag.
272             $self->comment(sprintf(
273 2         5 ' %s%s - %s - %s <%s>',
  2         6  
274             $_->{tag},
275             ((' ') x ($len - length $_->{tag})) || '',
276 2         141 $_->{committed_at}->as_string( format => $format ),
  4         11  
  2         5  
277 2         29 $_->{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     145  
  2         18  
288             my $idx = $plan->index_of( $state->{change_id} ) // do {
289 2         320 $self->vent(__x(
290             'Cannot find this change in {file}',
291             file => $self->plan_file
292             ));
293 9     9 1 1429 hurl status => __ 'Make sure you are connected to the proper '
294 9         128 . 'database for this project.';
295 9         434 };
296              
297 9   66     245 # 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         201 'Undeployed change:',
303             'Undeployed changes:',
304             $plan->count - ( $idx + 1 )
305             ));
306             $plan->position($idx);
307 8 100       24 while ( my $change = $plan->next ) {
308 1         5 $self->emit( ' * ', $change->format_name_with_tags );
309             }
310 7         20 }
311             return $self;
312             }
313              
314             1;
315 7         649  
316 7         216  
317 13         32 =head1 Name
318              
319             App::Sqitch::Command::status - Display status information about Sqitch
320 8         115  
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