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   976 use 5.010;
  2         9  
4 2     2   19 use strict;
  2         6  
  2         63  
5 2     2   10 use warnings;
  2         13  
  2         92  
6 2     2   15 use utf8;
  2         9  
  2         34  
7 2     2   79 use Moo;
  2         12  
  2         26  
8 2     2   1161 use Types::Standard qw(Str Int HashRef);
  2         9  
  2         58  
9 2     2   3056 use Locale::TextDomain qw(App-Sqitch);
  2         11  
  2         35  
10 2     2   777 use App::Sqitch::X qw(hurl);
  2         7  
  2         23  
11 2     2   1396 use URI::db;
  2         18020  
  2         62  
12 2     2   18 use Try::Tiny;
  2         6  
  2         164  
13 2     2   16 use Path::Class qw(file dir);
  2         4  
  2         172  
14 2     2   20 use List::Util qw(max);
  2         11  
  2         201  
15 2     2   17 use namespace::autoclean;
  2         7  
  2         129  
16 2     2   245 use constant extra_target_keys => qw(uri);
  2         9  
  2         4432  
17              
18             extends 'App::Sqitch::Command';
19             with 'App::Sqitch::Role::TargetConfigCommand';
20              
21             our $VERSION = 'v1.4.0'; # VERSION
22              
23             sub configure {
24             # No config; target config is actually targets.
25             return {};
26             }
27              
28             sub execute {
29 15     15 1 20603 my ( $self, $action ) = (shift, shift);
30 15   100     56 $action ||= 'list';
31 15         44 $action =~ s/-/_/g;
32 15 100       97 my $meth = $self->can($action) or $self->usage(__x(
33             'Unknown action "{action}"',
34             action => $action,
35             ));
36 14         45 return $self->$meth(@_);
37             }
38              
39             sub list {
40 3     3 1 3848 my $self = shift;
41 3         34 my $sqitch = $self->sqitch;
42 3         108 my %targets = $sqitch->config->get_regexp(key => qr/^target[.][^.]+[.]uri$/);
43              
44             # Make it verbose if --verbose was passed at all.
45 3 100       985 my $format = $sqitch->options->{verbosity} ? "%1\$s\t%2\$s" : '%1$s';
46 3         29 for my $key (sort keys %targets) {
47 12         142 my ($target) = $key =~ /target[.]([^.]+)/;
48 12         96 $sqitch->emit(sprintf $format, $target, $targets{$key});
49             }
50              
51 3         59 return $self;
52             }
53              
54             sub add {
55 8     8 1 18100 my ($self, $name, $uri) = @_;
56 8 100 100     127 $self->usage unless $name && $uri;
57              
58 6         50 my $key = "target.$name";
59 6         233 my $config = $self->sqitch->config;
60              
61 6 100       139 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         767 my $vars = $self->config_params($key);
68 5         17 unshift @{ $vars } => {
  5         499  
69             key => "$key.uri",
70             value => URI::db->new($uri, 'db:')->as_string,
71             };
72              
73             # Make it so.
74 5         2057 $config->group_set( $config->local_file, $vars );
75 5         52483 my $target = $self->config_target(name => $name);
76 5         1404 $self->write_plan(target => $target);
77 5         70 $self->make_directories_for( $target );
78 5         123 return $self;
79             }
80              
81             sub alter {
82 5     5 1 13060 my ($self, $target) = @_;
83 5 100       56 $self->usage unless $target;
84              
85 4         36 my $key = "target.$target";
86 4         257 my $config = $self->sqitch->config;
87 4         65 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     46 command => "add $target " . ($props->{uri} || '$uri'),
93             ) unless $config->get( key => "target.$target.uri");
94              
95             # Make it so.
96 2         485 $config->group_set( $config->local_file, $self->config_params($key) );
97 2         49827 $self->make_directories_for( $self->config_target(name => $target) );
98             }
99              
100 2     2 1 15 sub rm { shift->remove(@_) }
101             sub remove {
102 5     5 1 9209 my ($self, $name) = @_;
103 5 100       39 $self->usage unless $name;
104 4 100       35 if ( my @deps = $self->_dependencies($name) ) {
105 1         44 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         28 $self->_rename($name);
112             }
113              
114             sub rename {
115 6     6 1 70500 my ($self, $old, $new) = @_;
116 6 100 100     102 $self->usage unless $old && $new;
117 4 100       23 if ( my @deps = $self->_dependencies($old) ) {
118 1         38 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         29 $self->_rename($old, $new);
125             }
126              
127             sub _dependencies {
128 8     8   32 my ($self, $name) = @_;
129 8         328 my %depends = $self->sqitch->config->get_regexp(
130             key => qr/^(?:core|engine[.][^.]+)[.]target$/
131             );
132 8         2105 return grep { $depends{$_} eq $name } sort keys %depends;
  12         108  
133             }
134              
135             sub _rename {
136 6     6   33 my ($self, $old, $new) = @_;
137 6         509 my $config = $self->sqitch->config;
138              
139             try {
140 6 100   6   872 $config->rename_section(
141             from => "target.$old",
142             ($new ? (to => "target.$new") : ()),
143             filename => $config->local_file,
144             );
145             } catch {
146 2 50   2   8098 die $_ unless /No such section/;
147 2         44 hurl target => __x(
148             'Unknown target "{target}"',
149             target => $old,
150             );
151 6         275 };
152             try {
153 4 100   4   268 $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   7130 die $_ unless /No such section/;
160 4         18629 };
161 4         8305 return $self;
162             }
163              
164             sub show {
165 6     6 1 26576 my ($self, @names) = @_;
166 6 100       53 return $self->list unless @names;
167 5         34 my $sqitch = $self->sqitch;
168 5         160 my $config = $sqitch->config;
169              
170 5         88 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         1590 my $len = max map { length } values %label_for;
  50         141  
184 5         79 $_ .= ': ' . ' ' x ($len - length $_) for values %label_for;
185              
186             # Header labels.
187 5         27 $label_for{script_dirs} = __('Script Directories') . ':';
188 5         186 $label_for{reworked_dirs} = __('Reworked Script Directories') . ':';
189 5         178 $label_for{variables} = __('Variables') . ':';
190 5         158 $label_for{no_variables} = __('No Variables');
191              
192 5         173 require App::Sqitch::Target;
193 5         19 for my $name (@names) {
194 7         160 my $target = App::Sqitch::Target->new(
195             $self->target_params,
196             name => $name,
197             );
198 7         887 $self->emit("* $name");
199 7         300 $self->emit(' ', $label_for{uri}, $target->uri->as_string);
200 7         539 $self->emit(' ', $label_for{registry}, $target->registry);
201 7         1386 $self->emit(' ', $label_for{client}, $target->client);
202 7         1160 $self->emit(' ', $label_for{top_dir}, $target->top_dir);
203 7         3043 $self->emit(' ', $label_for{plan_file}, $target->plan_file);
204 7         2132 $self->emit(' ', $label_for{extension}, $target->extension);
205 7         2314 $self->emit(' ', $label_for{script_dirs});
206 7         345 $self->emit(' ', $label_for{deploy}, $target->deploy_dir);
207 7         1732 $self->emit(' ', $label_for{revert}, $target->revert_dir);
208 7         1486 $self->emit(' ', $label_for{verify}, $target->verify_dir);
209 7         1504 $self->emit(' ', $label_for{reworked_dirs});
210 7         322 $self->emit(' ', $label_for{reworked}, $target->reworked_dir);
211 7         807 $self->emit(' ', $label_for{deploy}, $target->reworked_deploy_dir);
212 7         1475 $self->emit(' ', $label_for{revert}, $target->reworked_revert_dir);
213 7         1656 $self->emit(' ', $label_for{verify}, $target->reworked_verify_dir);
214 7         1594 my $vars = $target->variables;
215 7 100       217 if (%{ $vars }) {
  7         22  
216 1         9 my $len = max map { length } keys %{ $vars };
  3         12  
  1         12  
217 1         32 $self->emit(' ', $label_for{variables});
218             $self->emit(" $_: " . (' ' x ($len - length $_)) . $vars->{$_})
219 1         35 for sort { lc $a cmp lc $b } keys %{ $vars };
  2         37  
  1         16  
220             } else {
221 6         113 $self->emit(' ', $label_for{no_variables});
222             }
223             }
224              
225 5         409 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-2023 iovation Inc., David E. Wheeler
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