File Coverage

blib/lib/App/Sqitch/Command/target.pm
Criterion Covered Total %
statement 143 143 100.0
branch 30 32 93.7
condition 10 10 100.0
subroutine 28 28 100.0
pod 8 8 100.0
total 219 221 99.1


line stmt bran cond sub pod time code
1             package App::Sqitch::Command::target;
2              
3 2     2   1005 use 5.010;
  2         9  
4 2     2   11 use strict;
  2         5  
  2         52  
5 2     2   11 use warnings;
  2         3  
  2         95  
6 2     2   9 use utf8;
  2         4  
  2         19  
7 2     2   45 use Moo;
  2         9  
  2         21  
8 2     2   804 use Types::Standard qw(Str Int HashRef);
  2         4  
  2         35  
9 2     2   5061 use Locale::TextDomain qw(App-Sqitch);
  2         6  
  2         28  
10 2     2   524 use App::Sqitch::X qw(hurl);
  2         6  
  2         26  
11 2     2   1063 use URI::db;
  2         25866  
  2         81  
12 2     2   14 use Try::Tiny;
  2         5  
  2         187  
13 2     2   12 use Path::Class qw(file dir);
  2         9  
  2         170  
14 2     2   14 use List::Util qw(max);
  2         8  
  2         189  
15 2     2   15 use namespace::autoclean;
  2         3  
  2         52  
16 2     2   204 use constant extra_target_keys => qw(uri);
  2         4  
  2         4525  
17              
18             extends 'App::Sqitch::Command';
19             with 'App::Sqitch::Role::TargetConfigCommand';
20              
21             our $VERSION = 'v1.6.1'; # VERSION
22              
23             sub configure {
24             # No config; target config is actually targets.
25             return {};
26             }
27              
28             sub execute {
29 15     15 1 19439 my ( $self, $action ) = (shift, shift);
30 15   100     68 $action ||= 'list';
31 15         41 $action =~ s/-/_/g;
32 15 100       107 my $meth = $self->can($action) or $self->usage(__x(
33             'Unknown action "{action}"',
34             action => $action,
35             ));
36 14         51 return $self->$meth(@_);
37             }
38              
39             sub list {
40 3     3 1 2779 my $self = shift;
41 3         23 my $sqitch = $self->sqitch;
42 3         120 my %targets = $sqitch->config->get_regexp(key => qr/^target[.][^.]+[.]uri$/);
43              
44             # Make it verbose if --verbose was passed at all.
45 3 100       899 my $format = $sqitch->options->{verbosity} ? "%1\$s\t%2\$s" : '%1$s';
46 3         22 for my $key (sort keys %targets) {
47 12         134 my ($target) = $key =~ /target[.]([^.]+)/;
48 12         95 $sqitch->emit(sprintf $format, $target, $targets{$key});
49             }
50              
51 3         41 return $self;
52             }
53              
54             sub add {
55 8     8 1 15131 my ($self, $name, $uri) = @_;
56 8 100 100     90 $self->usage unless $name && $uri;
57              
58 6         23 my $key = "target.$name";
59 6         336 my $config = $self->sqitch->config;
60              
61 6 100       111 hurl target => __x(
62             'Target "{target}" already exists',
63             target => $name
64             ) if $config->get( key => "$key.uri");
65              
66             # Put together the URI and other config variables.
67 5         833 my $vars = $self->config_params($key);
68 5         15 unshift @{ $vars } => {
  5         97  
69             key => "$key.uri",
70             value => URI::db->new($uri, 'db:')->as_string,
71             };
72              
73             # Make it so.
74 5         1736 $config->group_set( $config->local_file, $vars );
75 5         54085 my $target = $self->config_target(name => $name);
76 5         1343 $self->write_plan(target => $target);
77 5         48 $self->make_directories_for( $target );
78 5         138 return $self;
79             }
80              
81             sub alter {
82 5     5 1 8282 my ($self, $target) = @_;
83 5 100       31 $self->usage unless $target;
84              
85 4         11 my $key = "target.$target";
86 4         151 my $config = $self->sqitch->config;
87 4         39 my $props = $self->properties;
88              
89             hurl target => __x(
90             'Missing Target "{target}"; use "{command}" to add it',
91             target => $target,
92 4 100 100     30 command => "add $target " . ($props->{uri} || '$uri'),
93             ) unless $config->get( key => "target.$target.uri");
94              
95             # Make it so.
96 2         432 $config->group_set( $config->local_file, $self->config_params($key) );
97 2         24763 $self->make_directories_for( $self->config_target(name => $target) );
98             }
99              
100 2     2 1 10 sub rm { shift->remove(@_) }
101             sub remove {
102 5     5 1 11380 my ($self, $name) = @_;
103 5 100       41 $self->usage unless $name;
104 4 100       48 if ( my @deps = $self->_dependencies($name) ) {
105 1         64 hurl target => __x(
106             q{Cannot rename target "{target}" because it's referenced by: {engines}},
107             target => $name,
108             engines => join ', ', @deps
109             );
110             }
111 3         35 $self->_rename($name);
112             }
113              
114             sub rename {
115 6     6 1 76504 my ($self, $old, $new) = @_;
116 6 100 100     78 $self->usage unless $old && $new;
117 4 100       36 if ( my @deps = $self->_dependencies($old) ) {
118 1         30 hurl target => __x(
119             q{Cannot rename target "{target}" because it's referenced by: {engines}},
120             target => $old,
121             engines => join ', ', @deps
122             );
123             }
124 3         27 $self->_rename($old, $new);
125             }
126              
127             sub _dependencies {
128 8     8   41 my ($self, $name) = @_;
129 8         479 my %depends = $self->sqitch->config->get_regexp(
130             key => qr/^(?:core|engine[.][^.]+)[.]target$/
131             );
132 8         2778 return grep { $depends{$_} eq $name } sort keys %depends;
  12         118  
133             }
134              
135             sub _rename {
136 6     6   30 my ($self, $old, $new) = @_;
137 6         281 my $config = $self->sqitch->config;
138              
139             try {
140 6 100   6   836 $config->rename_section(
141             from => "target.$old",
142             ($new ? (to => "target.$new") : ()),
143             filename => $config->local_file,
144             );
145             } catch {
146 2 50   2   7948 die $_ unless /No such section/;
147 2         44 hurl target => __x(
148             'Unknown target "{target}"',
149             target => $old,
150             );
151 6         239 };
152             try {
153 4 100   4   376 $config->rename_section(
154             from => "target.$old.variables",
155             ($new ? (to => "target.$new.variables") : ()),
156             filename => $config->local_file,
157             );
158             } catch {
159 2 50   2   6919 die $_ unless /No such section/;
160 4         20045 };
161 4         9155 return $self;
162             }
163              
164             sub show {
165 6     6 1 29303 my ($self, @names) = @_;
166 6 100       62 return $self->list unless @names;
167 5         43 my $sqitch = $self->sqitch;
168 5         227 my $config = $sqitch->config;
169              
170 5         83 my %label_for = (
171             uri => __('URI'),
172             registry => __('Registry'),
173             client => __('Client'),
174             top_dir => __('Top Directory'),
175             plan_file => __('Plan File'),
176             extension => __('Extension'),
177             revert => ' ' . __ 'Revert',
178             deploy => ' ' . __ 'Deploy',
179             verify => ' ' . __ 'Verify',
180             reworked => ' ' . __ 'Reworked',
181             );
182              
183 5         1416 my $len = max map { length } values %label_for;
  50         150  
184 5         76 $_ .= ': ' . ' ' x ($len - length $_) for values %label_for;
185              
186             # Header labels.
187 5         28 $label_for{script_dirs} = __('Script Directories') . ':';
188 5         167 $label_for{reworked_dirs} = __('Reworked Script Directories') . ':';
189 5         125 $label_for{variables} = __('Variables') . ':';
190 5         110 $label_for{no_variables} = __('No Variables');
191              
192 5         194 require App::Sqitch::Target;
193 5         33 for my $name (@names) {
194 7         160 my $target = App::Sqitch::Target->new(
195             $self->target_params,
196             name => $name,
197             );
198 7         997 $self->emit("* $name");
199 7         343 $self->emit(' ', $label_for{uri}, $target->uri->as_string);
200 7         560 $self->emit(' ', $label_for{registry}, $target->registry);
201 7         1479 $self->emit(' ', $label_for{client}, $target->client);
202 7         1179 $self->emit(' ', $label_for{top_dir}, $target->top_dir);
203 7         2596 $self->emit(' ', $label_for{plan_file}, $target->plan_file);
204 7         2191 $self->emit(' ', $label_for{extension}, $target->extension);
205 7         2383 $self->emit(' ', $label_for{script_dirs});
206 7         311 $self->emit(' ', $label_for{deploy}, $target->deploy_dir);
207 7         1679 $self->emit(' ', $label_for{revert}, $target->revert_dir);
208 7         1431 $self->emit(' ', $label_for{verify}, $target->verify_dir);
209 7         1474 $self->emit(' ', $label_for{reworked_dirs});
210 7         317 $self->emit(' ', $label_for{reworked}, $target->reworked_dir);
211 7         722 $self->emit(' ', $label_for{deploy}, $target->reworked_deploy_dir);
212 7         1442 $self->emit(' ', $label_for{revert}, $target->reworked_revert_dir);
213 7         1667 $self->emit(' ', $label_for{verify}, $target->reworked_verify_dir);
214 7         1472 my $vars = $target->variables;
215 7 100       210 if (%{ $vars }) {
  7         23  
216 1         2 my $len = max map { length } keys %{ $vars };
  3         8  
  1         3  
217 1         15 $self->emit(' ', $label_for{variables});
218             $self->emit(" $_: " . (' ' x ($len - length $_)) . $vars->{$_})
219 1         25 for sort { lc $a cmp lc $b } keys %{ $vars };
  2         22  
  1         6  
220             } else {
221 6         109 $self->emit(' ', $label_for{no_variables});
222             }
223             }
224              
225 5         407 return $self;
226             }
227              
228             1;
229              
230             __END__
231              
232             =head1 Name
233              
234             App::Sqitch::Command::target - Add, modify, or list Sqitch target databases
235              
236             =head1 Synopsis
237              
238             my $cmd = App::Sqitch::Command::target->new(%params);
239             $cmd->execute;
240              
241             =head1 Description
242              
243             Manages Sqitch targets, which are stored in the local configuration file.
244              
245             =head1 Interface
246              
247             =head3 Class Methods
248              
249             =head3 C<extra_target_keys>
250              
251             Returns a list of additional option keys to be specified via options.
252              
253             =head2 Instance Methods
254              
255             =head2 Attributes
256              
257             =head3 C<properties>
258              
259             Hash of property values to set.
260              
261             =head3 C<verbose>
262              
263             Verbosity.
264              
265             =head3 C<execute>
266              
267             $target->execute($command);
268              
269             Executes the C<target> command.
270              
271             =head3 C<add>
272              
273             Implements the C<add> action.
274              
275             =head3 C<alter>
276              
277             Implements the C<alter> action.
278              
279             =head3 C<list>
280              
281             Implements the C<list> action.
282              
283             =head3 C<remove>
284              
285             =head3 C<rm>
286              
287             Implements the C<remove> action.
288              
289             =head3 C<rename>
290              
291             Implements the C<rename> action.
292              
293             =head3 C<show>
294              
295             Implements the C<show> action.
296              
297             =head1 See Also
298              
299             =over
300              
301             =item L<sqitch-target>
302              
303             Documentation for the C<target> command to the Sqitch command-line client.
304              
305             =item L<sqitch>
306              
307             The Sqitch command-line client.
308              
309             =back
310              
311             =head1 Author
312              
313             David E. Wheeler <david@justatheory.com>
314              
315             =head1 License
316              
317             Copyright (c) 2012-2026 David E. Wheeler, 2012-2021 iovation Inc.
318              
319             Permission is hereby granted, free of charge, to any person obtaining a copy
320             of this software and associated documentation files (the "Software"), to deal
321             in the Software without restriction, including without limitation the rights
322             to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
323             copies of the Software, and to permit persons to whom the Software is
324             furnished to do so, subject to the following conditions:
325              
326             The above copyright notice and this permission notice shall be included in all
327             copies or substantial portions of the Software.
328              
329             THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
330             IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
331             FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
332             AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
333             LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
334             OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
335             SOFTWARE.
336              
337             =cut