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   923 use 5.010;
  2         8  
4 2     2   12 use strict;
  2         9  
  2         424  
5 2     2   13 use warnings;
  2         10  
  2         92  
6 2     2   16 use utf8;
  2         5  
  2         32  
7 2     2   68 use Moo;
  2         4  
  2         29  
8 2     2   1076 use Types::Standard qw(Str Int HashRef);
  2         5  
  2         55  
9 2     2   2617 use Locale::TextDomain qw(App-Sqitch);
  2         4  
  2         35  
10 2     2   707 use App::Sqitch::X qw(hurl);
  2         7  
  2         42  
11 2     2   884 use Try::Tiny;
  2         7  
  2         185  
12 2     2   514 use URI::db;
  2         17538  
  2         88  
13 2     2   16 use Path::Class qw(file dir);
  2         5  
  2         196  
14 2     2   14 use List::Util qw(max first);
  2         13  
  2         206  
15 2     2   25 use namespace::autoclean;
  2         14  
  2         138  
16 2     2   264 use constant extra_target_keys => qw(target);
  2         4  
  2         4547  
17              
18             extends 'App::Sqitch::Command';
19             with 'App::Sqitch::Role::TargetConfigCommand';
20              
21             our $VERSION = 'v1.4.0'; # VERSION
22              
23             sub _chk_engine($) {
24 11     11   53 my $engine = shift;
25             hurl engine => __x(
26             'Unknown engine "{engine}"', engine => $engine
27 11 100   48   193 ) unless first { $engine eq $_ } App::Sqitch::Command::ENGINES;
  48         147  
28             }
29              
30             sub configure {
31             # No config; engine config is actually engines.
32             return {};
33             }
34              
35             sub execute {
36 21     21 1 24793 my ( $self, $action ) = (shift, shift);
37 21   100     78 $action ||= 'list';
38 21         69 $action =~ s/-/_/g;
39 21 100       124 my $meth = $self->can($action) or $self->usage(__x(
40             'Unknown action "{action}"',
41             action => $action,
42             ));
43              
44 20         88 return $self->$meth(@_);
45             }
46              
47             sub list {
48 3     3   3284 my $self = shift;
49 3         25 my $sqitch = $self->sqitch;
50 3         21 my $rx = join '|' => App::Sqitch::Command::ENGINES;
51 3         112 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       1073 my $format = $sqitch->options->{verbosity} ? "%1\$s\t%2\$s" : '%1$s';
55 3         25 for my $key (sort keys %engines) {
56 10         124 my ($engine) = $key =~ /engine[.]([^.]+)/;
57 10         85 $sqitch->emit(sprintf $format, $engine, $engines{$key})
58             }
59              
60 3         47 return $self;
61             }
62              
63             sub _target {
64 10     10   4042 my ($self, $engine, $name) = @_;
65 10   100     95 my $target = $self->properties->{target} || $name || return;
66              
67 8 100       79 if ($target =~ /:/) {
68             # It's URI. Return it if it uses the proper engine.
69 7         131 my $uri = URI::db->new($target, 'db:');
70 7 100       6685 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         350 return $uri->as_string;
76             }
77              
78             # Otherwise, it needs to be a known target from the config.
79 1 50       31 return $target if $self->sqitch->config->get(key => "target.$target.uri");
80 1         224 hurl engine => __x(
81             'Unknown target "{target}"',
82             target => $target
83             );
84             }
85              
86             sub add {
87 6     6   13046 my ($self, $engine, $target) = @_;
88 6 100       26 $self->usage unless $engine;
89 5         32 _chk_engine $engine;
90              
91 5         42 my $key = "engine.$engine";
92 5         178 my $config = $self->sqitch->config;
93              
94 5 100       78 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         573 my $vars = $self->config_params($key);
101 4   66     13 unshift @{ $vars } => {
  4         24  
102             key => "$key.target",
103             value => $self->_target($engine, $target) || "db:$engine:",
104             };
105              
106             # Make it so.
107 3         235 $config->group_set( $config->local_file, $vars );
108 3         39761 $target = $self->config_target(
109             name => $target,
110             engine => $engine,
111             );
112 3         807 $self->write_plan(target => $target);
113 3         39 $self->make_directories_for($target);
114             }
115              
116             sub alter {
117 7     7 1 33864 my ($self, $engine) = @_;
118 7 100       34 $self->usage unless $engine;
119 6         45 _chk_engine $engine;
120              
121 5         39 my $key = "engine.$engine";
122 5         204 my $config = $self->sqitch->config;
123 5         98 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     54 command => "add $engine " . ($props->{target} || "db:$engine:"),
129             ) unless $config->get( key => "engine.$engine.target");
130              
131 3 100       548 if (my $targ = $props->{target}) {
132 2 50       37 $props->{target} = $self->_target($engine, $targ) or hurl engine => __(
133             'Cannot unset an engine target'
134             );
135             }
136              
137             # Make it so.
138 2         309 $config->group_set( $config->local_file, $self->config_params($key) );
139 2         41046 $self->make_directories_for( $self->config_target( engine => $engine) );
140             }
141              
142 2     2 1 8 sub rm { shift->remove(@_) }
143             sub remove {
144 4     4   6855 my ($self, $engine) = @_;
145 4 100       38 $self->usage unless $engine;
146              
147 3         136 my $config = $self->sqitch->config;
148             try {
149 3     3   398 $config->rename_section(
150             from => "engine.$engine",
151             filename => $config->local_file,
152             );
153             } catch {
154 1 50   1   3264 die $_ unless /No such section/;
155 1         12 hurl engine => __x(
156             'Unknown engine "{engine}"',
157             engine => $engine,
158             );
159 3         111 };
160             try {
161 2     2   121 $config->rename_section(
162             from => "engine.$engine.variables",
163             filename => $config->local_file,
164             );
165             } catch {
166 1 50   1   2854 die $_ unless /No such section/;
167 2         8075 };
168 2         3480 return $self;
169             }
170              
171             sub show {
172 3     3   7380 my ($self, @names) = @_;
173 3 100       39 return $self->list unless @names;
174 2         27 my $sqitch = $self->sqitch;
175 2         59 my $config = $sqitch->config;
176              
177             # Set up labels.
178 2         37 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         652 my $len = max map { length } values %label_for;
  20         82  
192 2         42 $_ .= ': ' . ' ' x ($len - length $_) for values %label_for;
193              
194             # Header labels.
195 2         12 $label_for{script_dirs} = __('Script Directories') . ':';
196 2         97 $label_for{reworked_dirs} = __('Reworked Script Directories') . ':';
197 2         88 $label_for{variables} = __('Variables') . ':';
198 2         73 $label_for{no_variables} = __('No Variables');
199              
200 2         84 require App::Sqitch::Target;
201 2         17 for my $engine (@names) {
202 4   33     144 my $target = App::Sqitch::Target->new(
203             $self->target_params,
204             name => $config->get(key => "engine.$engine.target") || "db:$engine",
205             );
206              
207 4         606 $self->emit("* $engine");
208 4         198 $self->emit(' ', $label_for{target}, $target->target);
209 4         199 $self->emit(' ', $label_for{registry}, $target->registry);
210 4         563 $self->emit(' ', $label_for{client}, $target->client);
211 4         1113 $self->emit(' ', $label_for{top_dir}, $target->top_dir);
212 4         1777 $self->emit(' ', $label_for{plan_file}, $target->plan_file);
213 4         868 $self->emit(' ', $label_for{extension}, $target->extension);
214 4         1266 $self->emit(' ', $label_for{script_dirs});
215 4         193 $self->emit(' ', $label_for{deploy}, $target->deploy_dir);
216 4         1040 $self->emit(' ', $label_for{revert}, $target->revert_dir);
217 4         845 $self->emit(' ', $label_for{verify}, $target->verify_dir);
218 4         842 $self->emit(' ', $label_for{reworked_dirs});
219 4         192 $self->emit(' ', $label_for{reworked}, $target->reworked_dir);
220 4         496 $self->emit(' ', $label_for{deploy}, $target->reworked_deploy_dir);
221 4         811 $self->emit(' ', $label_for{revert}, $target->reworked_revert_dir);
222 4         915 $self->emit(' ', $label_for{verify}, $target->reworked_verify_dir);
223 4         945 my $vars = $target->variables;
224 4 100       113 if (%{ $vars }) {
  4         12  
225 1         3 my $len = max map { length } keys %{ $vars };
  3         20  
  1         6  
226 1         25 $self->emit(' ', $label_for{variables});
227             $self->emit(" $_: " . (' ' x ($len - length $_)) . $vars->{$_})
228 1         33 for sort { lc $a cmp lc $b } keys %{ $vars };
  3         39  
  1         18  
229             } else {
230 3         56 $self->emit(' ', $label_for{no_variables});
231             }
232             }
233              
234 2         240 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-2023 iovation Inc., David E. Wheeler
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