File Coverage

blib/lib/App/Sqitch/Command/tag.pm
Criterion Covered Total %
statement 62 62 100.0
branch 8 10 80.0
condition n/a
subroutine 12 12 100.0
pod 1 1 100.0
total 83 85 97.6


line stmt bran cond sub pod time code
1              
2             use 5.010;
3 3     3   755 use strict;
  3         10  
4 3     3   16 use warnings;
  3         6  
  3         149  
5 3     3   15 use utf8;
  3         7  
  3         114  
6 3     3   16 use Moo;
  3         7  
  3         24  
7 3     3   77 use App::Sqitch::X qw(hurl);
  3         4  
  3         19  
8 3     3   1066 use Types::Standard qw(Str ArrayRef Maybe Bool);
  3         6  
  3         35  
9 3     3   952 use Locale::TextDomain qw(App-Sqitch);
  3         19  
  3         32  
10 3     3   2959 use List::Util qw(first);
  3         7  
  3         27  
11 3     3   591 use namespace::autoclean;
  3         6  
  3         179  
12 3     3   16  
  3         11  
  3         175  
13             extends 'App::Sqitch::Command';
14             with 'App::Sqitch::Role::ContextCommand';
15              
16             our $VERSION = 'v1.3.1'; # VERSION
17              
18             has tag_name => (
19             is => 'ro',
20             isa => Maybe[Str],
21             );
22              
23             has change_name => (
24             is => 'ro',
25             isa => Maybe[Str],
26             );
27              
28             has all => (
29             is => 'ro',
30             isa => Bool,
31             default => 0
32             );
33              
34             has note => (
35             is => 'ro',
36             isa => ArrayRef[Str],
37             default => sub { [] },
38             );
39              
40             return qw(
41             tag-name|tag|t=s
42             change-name|change|c=s
43             all|a!
44             note|n|m=s@
45             );
46             }
47              
48             my ( $class, $config, $opt ) = @_;
49             # Just keep options.
50             return $opt;
51             }
52              
53             my $self = shift;
54             my ($name, $change, $targets) = $self->parse_args(
55             names => [$self->tag_name, $self->change_name],
56             all => $self->all,
57 12     12 1 6830 args => \@_,
58 12         89 no_changes => 1,
59             );
60              
61             if (defined $name) {
62             my $note = join "\n\n" => @{ $self->note };
63             my (%seen, @plans, @tags);
64             for my $target (@{ $targets }) {
65 11 100       152 next if $seen{$target->plan_file}++;
66 8         12 my $plan = $target->plan;
  8         38  
67 8         12 push @tags => $plan->tag(
68 8         24 name => $name,
  8         19  
69 11 100       322 change => $change,
70 9         2914 note => $note,
71 9         936 );
72             push @plans => $plan;
73             }
74              
75             # Make sure we have a note.
76 9         18 $note = $tags[0]->request_note(for => __ 'tag');
77              
78             # We good, write the plan files back out.
79             for my $plan (@plans) {
80 8         153 my $tag = shift @tags;
81             $tag->note($note);
82             $plan->write_to( $plan->file );
83 8         48 $self->info(__x(
84 9         194 'Tagged "{change}" with {tag} in {file}',
85 9         140 change => $tag->change->format_name,
86 9         147 tag => $tag->format_name,
87 9         52 file => $plan->file,
88             ));
89             }
90             } else {
91             # Check for missing name.
92             if (@_) {
93             if (my $target = first { my $n = $_->name; first { $_ eq $n } @_ } @{ $targets }) {
94             # Name conflicts with a target.
95             hurl tag => __x(
96 3 100       10 'Name "{name}" identifies a target; use "--tag {name}" to use it for the tag name',
97 1 50   1   6 name => $target->name,
  1         5  
  1         8  
  1         6  
  1         6  
98             );
99 1         4 }
100             }
101              
102             # Show unique tags.
103             my %seen;
104             for my $target (@{ $targets }) {
105             my $plan = $target->plan;
106             for my $tag ($plan->tags) {
107 2         3 my $name = $tag->format_name;
108 2         4 $self->info($name) unless $seen{$name}++;
  2         3  
109 2         32 }
110 2         208 }
111 3         48 }
112 3 50       85  
113             return $self;
114             }
115              
116             1;
117 10         1814  
118              
119             =head1 Name
120              
121             App::Sqitch::Command::tag - Add or list tags in Sqitch plans
122              
123             =head1 Synopsis
124              
125             my $cmd = App::Sqitch::Command::tag->new(%params);
126             $cmd->execute;
127              
128             =head1 Description
129              
130             Tags a Sqitch change. The tag will be added to the last change in the plan.
131              
132             =head1 Interface
133              
134             =head2 Attributes
135              
136             =head3 C<tag_name>
137              
138             The name of the tag to add.
139              
140             =head3 C<change_name>
141              
142             The name of the change to tag.
143              
144             =head3 C<all>
145              
146             Boolean indicating whether or not to run the command against all plans in the
147             project.
148              
149             =head3 C<note>
150              
151             Text of the tag note.
152              
153             =head2 Instance Methods
154              
155             =head3 C<execute>
156              
157             $tag->execute($command);
158              
159             Executes the C<tag> command.
160              
161             =head1 See Also
162              
163             =over
164              
165             =item L<sqitch-tag>
166              
167             Documentation for the C<tag> command to the Sqitch command-line client.
168              
169             =item L<sqitch>
170              
171             The Sqitch command-line client.
172              
173             =back
174              
175             =head1 Author
176              
177             David E. Wheeler <david@justatheory.com>
178              
179             =head1 License
180              
181             Copyright (c) 2012-2022 iovation Inc., David E. Wheeler
182              
183             Permission is hereby granted, free of charge, to any person obtaining a copy
184             of this software and associated documentation files (the "Software"), to deal
185             in the Software without restriction, including without limitation the rights
186             to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
187             copies of the Software, and to permit persons to whom the Software is
188             furnished to do so, subject to the following conditions:
189              
190             The above copyright notice and this permission notice shall be included in all
191             copies or substantial portions of the Software.
192              
193             THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
194             IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
195             FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
196             AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
197             LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
198             OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
199             SOFTWARE.
200              
201             =cut