File Coverage

blib/lib/App/Sqitch/Command/engine.pm
Criterion Covered Total %
statement 145 145 100.0
branch 30 34 88.2
condition 8 13 61.5
subroutine 28 28 100.0
pod 3 3 100.0
total 214 223 95.9


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