File Coverage

blib/lib/App/Sqitch/Plan/Depend.pm
Criterion Covered Total %
statement 55 56 98.2
branch 29 30 96.6
condition 22 24 91.6
subroutine 17 17 100.0
pod 7 8 87.5
total 130 135 96.3


line stmt bran cond sub pod time code
1              
2             use 5.010;
3 50     50   865 use utf8;
  50         153  
4 50     50   251 use Moo;
  50         114  
  50         277  
5 50     50   1006 use App::Sqitch::Types qw(Str Bool Maybe Plan);
  50         95  
  50         249  
6 50     50   14776 use App::Sqitch::Plan;
  50         150  
  50         354  
7 50     50   41113 use App::Sqitch::X qw(hurl);
  50         129  
  50         1510  
8 50     50   255 use Locale::TextDomain qw(App-Sqitch);
  50         89  
  50         396  
9 50     50   12896 use namespace::autoclean;
  50         98  
  50         349  
10 50     50   8209  
  50         104  
  50         362  
11             our $VERSION = 'v1.3.1'; # VERSION
12              
13             has conflicts => (
14             is => 'ro',
15             isa => Bool,
16             default => 0,
17             );
18              
19             has got_id => (
20             is => 'ro',
21             isa => Bool,
22             required => 1
23             );
24              
25             has got_project => (
26             is => 'ro',
27             isa => Bool,
28             required => 1
29             );
30              
31             has project => (
32             is => 'ro',
33             isa => Maybe[Str],
34             lazy => 1,
35             default => sub {
36             my $self = shift;
37             my $plan = $self->plan;
38              
39             # Local project is the default unless an ID was passed.
40             return $plan->project unless $self->got_id;
41              
42             # Local project is default if passed ID is in plan.
43             return $plan->project if $plan->find( $self->id );
44              
45             # Otherwise, the project is unknown (and external).
46             return undef;
47             }
48             );
49              
50             has change => (
51             is => 'ro',
52             isa => Maybe[Str],
53             );
54              
55             has tag => (
56             is => 'ro',
57             isa => Maybe[Str],
58             );
59              
60             has plan => (
61             is => 'ro',
62             isa => Plan,
63             weak_ref => 1,
64             required => 1,
65             );
66              
67             has id => (
68             is => 'ro',
69             isa => Maybe[Str],
70             lazy => 1,
71             default => sub {
72             my $self = shift;
73             my $plan = $self->plan;
74             my $proj = $self->project // return undef;
75             return undef if $proj ne $plan->project;
76             my $change = $plan->find( $self->key_name ) // hurl plan => __x(
77             'Unable to find change "{change}" in plan {file}',
78             change => $self->key_name,
79             file => $plan->file,
80             );
81             return $change->id;
82             }
83             );
84              
85             has resolved_id => (
86             is => 'rw',
87             isa => Maybe[Str],
88             );
89              
90             has is_external => (
91             is => 'ro',
92             isa => Bool,
93             lazy => 1,
94             default => sub {
95             my $self = shift;
96              
97             # If no project, then it must be external.
98             my $proj = $self->project // return 1;
99              
100             # Just compare to the local project.
101             return $proj eq $self->plan->project ? 0 : 1;
102             },
103             );
104              
105              
106 20 100   20 1 134 my $class = shift;
107 20 100   20 1 137 my $p = @_ == 1 && ref $_[0] ? { %{ +shift } } : { @_ };
108 24 100   24 1 7640 hurl 'Depend object must have either "change", "tag", or "id" defined'
109             unless length($p->{change} // '') || length($p->{tag} // '') || $p->{id};
110              
111 475     475 0 116978 hurl 'Depend object cannot contain both an ID and a tag or change'
112 475 50 33     2285 if $p->{id} && (length($p->{change} // '') || length($p->{tag} // ''));
  0         0  
113              
114 475 100 100     1978 $p->{got_id} = defined $p->{id} ? 1 : 0;
      100        
      100        
      100        
115             $p->{got_project} = defined $p->{project} ? 1 : 0;
116              
117 474 100 100     1109 return $p;
      100        
118             }
119 471 100       1130  
120 471 100       1008 my ( $class, $string ) = @_;
121             my $name_re = Plan->class->name_regex;
122 471         6589 return undef if $string !~ /
123             \A # Beginning of string
124             (?<conflicts>!?) # Optional negation
125             (?:(?<project>$name_re)[:])? # Optional project + :
126 430     430 1 124209 (?: # Followed by...
127 430         1275 (?<id>[0-9a-f]{40}) # SHA1 hash
128 430 100       10950 | # - OR -
129             (?<change>$name_re) # Change name
130             (?:[@](?<tag>$name_re))? # Optional tag
131             | # - OR -
132             (?:[@](?<tag>$name_re))? # Tag
133             ) # ... required
134             \z # End of string
135             /x;
136              
137             return { %+, conflicts => $+{conflicts} ? 1 : 0 };
138             }
139              
140             my $self = shift;
141             my @parts;
142              
143 50 100   50   61687 if (defined (my $change = $self->change)) {
  50         17738  
  50         12648  
  420         9269  
144             push @parts => $change;
145             }
146              
147 817     817 1 6246 if (defined (my $tag = $self->tag)) {
148 817         1095 push @parts => '@' . $tag;
149             }
150 817 100       2119  
151 769         1429 if ( !@parts && defined ( my $id = $self->id ) ) {
152             push @parts, $id;
153             }
154 817 100       1944  
155 262         588 return join '' => @parts;
156             }
157              
158 817 100 100     2017 my $self = shift;
159 16         130 my $proj = $self->project // return $self->key_name;
160             return $self->key_name if $proj eq $self->plan->project;
161             return "$proj:" . $self->key_name;
162 817         3649 }
163              
164             my $self = shift;
165             return ($self->conflicts ? '!' : '') . $self->as_string;
166 507     507 1 10845 }
167 507   100     7679  
168 501 100       16801 1;
169 58         465  
170              
171             =head1 Name
172              
173 142     142 1 8206 App::Sqitch::Plan::Depend - Sqitch dependency specification
174 142 100       504  
175             =head1 Synopsis
176              
177             my $depend = App::Sqitch::Plan::Depend->new(
178             plan => $plan,
179             App::Sqitch::Plan::Depend->parse('!proj:change@tag')
180             );
181              
182             =head1 Description
183              
184             An App::Sqitch::Plan::Line represents a single dependency from the dependency
185             list for a planned change. Is is constructed by L<App::Sqitch::Plan> and
186             included in L<App::Sqitch::Plan::Change> objects C<conflicts> and C<requires>
187             attributes.
188              
189             =head1 Interface
190              
191             =head2 Constructors
192              
193             =head3 C<new>
194              
195             my $depend = App::Sqitch::Plan::Depend->new(%params);
196              
197             Instantiates and returns a App::Sqitch::Plan::Line object. Parameters:
198              
199             =over
200              
201             =item C<plan>
202              
203             The plan with which the dependency is associated. Required.
204              
205             =item C<project>
206              
207             Name of the project. Required.
208              
209             =item C<conflicts>
210              
211             Boolean to indicate whether the dependency is a conflicting dependency.
212              
213             =item C<change>
214              
215             The name of the change.
216              
217             =item C<tag>
218              
219             The name of the tag claimed as the dependency.
220              
221             =item C<id>
222              
223             The ID of a change. Mutually exclusive with C<change> and C<tag>.
224              
225             =back
226              
227             =head3 C<parse>
228              
229             my %params = App::Sqitch::Plan::Depend->parse($string);
230              
231             Parses a dependency specification as extracted from a plan and returns a hash
232             reference of parameters suitable for passing to C<new()>. Returns C<undef> if
233             the string is not a properly-formatted dependency.
234              
235             =head2 Accessors
236              
237             =head3 C<plan>
238              
239             my $plan = $depend->plan;
240              
241             Returns the L<App::Sqitch::Plan> object with which the dependency
242             specification is associated.
243              
244             =head3 C<conflicts>
245              
246             say $depend->as_string, ' conflicts' if $depend->conflicts;
247              
248             Returns true if the dependency is a conflicting dependency, and false if it
249             is not (in which case it is a required dependency).
250              
251             =head3 C<required>
252              
253             say $depend->as_string, ' required' if $depend->required;
254              
255             Returns true if the dependency is a required, and false if it is not (in which
256             case it is a conflicting dependency).
257              
258             =head3 C<type>
259              
260             say $depend->type;
261              
262             Returns a string indicating the type of dependency, either "require" or
263             "conflict".
264              
265             =head3 C<project>
266              
267             my $proj = $depend->project;
268              
269             Returns the name of the project with which the dependency is associated.
270              
271             =head3 C<got_project>
272              
273             Returns true if the C<project> parameter was passed to the constructor with a
274             defined value, and false if it was not passed to the constructor.
275              
276             =head3 C<change>
277              
278             my $change = $depend->change;
279              
280             Returns the name of the change, if any. If C<undef> is returned, the dependency
281             is a tag-only dependency.
282              
283             =head3 C<tag>
284              
285             my $tag = $depend->tag;
286              
287             Returns the name of the tag, if any. If C<undef> is returned, the dependency
288             is a change-only dependency.
289              
290             =head3 C<id>
291              
292             Returns the ID of the change if the dependency was specified as an ID, or if
293             the dependency is a local dependency.
294              
295             =head3 C<got_id>
296              
297             Returns true if the C<id> parameter was passed to the constructor with a
298             defined value, and false if it was not passed to the constructor.
299              
300             =head3 C<resolved_id>
301              
302             Change ID used by the engine when deploying a change. That is, if the
303             dependency is in the database, it will be assigned this ID from the database.
304             If it is not in the database, C<resolved_id> will be undef.
305              
306             =head3 C<is_external>
307              
308             Returns true if the dependency references a change external to the current
309             project, and false if it is part of the current project.
310              
311             =head3 C<is_internal>
312              
313             The opposite of C<is_external()>: returns true if the dependency is in the
314             internal (current) project, and false if not.
315              
316             =head2 Instance Methods
317              
318             =head3 C<key_name>
319              
320             Returns the key name of the dependency, with the change name and/or tag,
321             properly formatted for passing to the C<find()> method of
322             L<App::Sqitch::Plan>. If the dependency was specified as an ID, rather than a
323             change or tag, then the ID will be returned.
324              
325             =head3 C<as_string>
326              
327             Returns the project-qualified key name. That is, if there is a project name,
328             it returns a string with the project name, a colon, and the key name. If there
329             is no project name, the key name is returned.
330              
331             =head3 C<as_plan_string>
332              
333             my $string = $depend->as_string;
334              
335             Returns the full stringification of the dependency, suitable for output to a
336             plan file. That is, the same as C<as_string> unless C<conflicts> returns true,
337             in which case it is prepended with "!".
338              
339             =head1 See Also
340              
341             =over
342              
343             =item L<App::Sqitch::Plan>
344              
345             Class representing a plan.
346              
347             =item L<sqitch>
348              
349             The Sqitch command-line client.
350              
351             =back
352              
353             =head1 Author
354              
355             David E. Wheeler <david@justatheory.com>
356              
357             =head1 License
358              
359             Copyright (c) 2012-2022 iovation Inc., David E. Wheeler
360              
361             Permission is hereby granted, free of charge, to any person obtaining a copy
362             of this software and associated documentation files (the "Software"), to deal
363             in the Software without restriction, including without limitation the rights
364             to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
365             copies of the Software, and to permit persons to whom the Software is
366             furnished to do so, subject to the following conditions:
367              
368             The above copyright notice and this permission notice shall be included in all
369             copies or substantial portions of the Software.
370              
371             THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
372             IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
373             FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
374             AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
375             LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
376             OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
377             SOFTWARE.
378              
379             =cut