File Coverage

blib/lib/App/Sqitch/Plan/Line.pm
Criterion Covered Total %
statement 64 65 98.4
branch 12 14 85.7
condition 6 10 60.0
subroutine 16 16 100.0
pod 7 8 87.5
total 105 113 92.9


line stmt bran cond sub pod time code
1             package App::Sqitch::Plan::Line;
2              
3 50     50   29038 use 5.010;
  50         186  
4 50     50   336 use utf8;
  50         110  
  50         284  
5 50     50   1196 use namespace::autoclean;
  50         118  
  50         334  
6 50     50   3050 use Moo;
  50         118  
  50         311  
7 50     50   16421 use App::Sqitch::Types qw(Str Plan);
  50         150  
  50         425  
8 50     50   38687 use App::Sqitch::X qw(hurl);
  50         124  
  50         442  
9 50     50   15047 use Locale::TextDomain qw(App-Sqitch);
  50         195  
  50         398  
10              
11             our $VERSION = 'v1.4.0'; # VERSION
12              
13             has name => (
14             is => 'ro',
15             isa => Str,
16             required => 1,
17             );
18              
19             has operator => (
20             is => 'ro',
21             isa => Str,
22             default => '',
23             );
24              
25             has lspace => (
26             is => 'ro',
27             isa => Str,
28             default => '',
29             );
30              
31             has rspace => (
32             is => 'rwp',
33             isa => Str,
34             default => '',
35             );
36              
37             has lopspace => (
38             is => 'ro',
39             isa => Str,
40             default => '',
41             );
42              
43             has ropspace => (
44             is => 'ro',
45             isa => Str,
46             default => '',
47             );
48              
49             has note => (
50             is => 'rw',
51             isa => Str,
52             default => '',
53             );
54              
55             after note => sub {
56             my $self = shift;
57             $self->_set_rspace(' ') if $_[0] && !$self->rspace;
58             };
59              
60             has plan => (
61             is => 'ro',
62             isa => Plan,
63             weak_ref => 1,
64             required => 1,
65             handles => [qw(sqitch project uri target)],
66             );
67              
68             my %escape = (
69             "\n" => '\\n',
70             "\r" => '\\r',
71             '\\' => '\\\\',
72             );
73              
74             my %unescape = reverse %escape;
75              
76             sub BUILDARGS {
77 2577     2577 0 933572 my $class = shift;
78 2577 50 33     20311 my $p = @_ == 1 && ref $_[0] ? { %{ +shift } } : { @_ };
  0         0  
79 2577 100       7582 if (my $note = $p->{note}) {
80             # Trim and then encode newlines.
81 562         1912 $note =~ s/\A\s+//;
82 562         2090 $note =~ s/\s+\z//;
83 562         1384 $note =~ s/(\\[\\nr])/$unescape{$1}/g;
84 562         1146 $p->{note} = $note;
85 562 100 100     3164 $p->{rspace} //= ' ' if $note && $p->{name};
      66        
86             }
87 2577         43901 return $p;
88             }
89              
90             sub request_note {
91 3     3 1 1015 my ( $self, %p ) = @_;
92 3   50     78 my $note = $self->note // '';
93 3 100       38 return $note if $note =~ /\S/;
94              
95             # Edit in a file.
96 2         15 require File::Temp;
97 2         20 my $tmp = File::Temp->new;
98 2     1   1509 binmode $tmp, ':utf8_strict';
  1         9  
  1         3  
  1         8  
99 2         1120 ( my $prompt = $self->note_prompt(%p) ) =~ s/^/# /gms;
100 2         187 $tmp->print( "\n", $prompt, "\n" );
101 2         50 $tmp->close;
102              
103 2         1552 my $sqitch = $self->sqitch;
104 2         108 $sqitch->shell( $sqitch->editor . ' ' . $sqitch->quote_shell($tmp) );
105              
106 2 50       1413 open my $fh, '<:utf8_strict', $tmp or hurl add => __x(
107             'Cannot open {file}: {error}',
108             file => $tmp,
109             error => $!
110             );
111              
112 2         159 $note = join '', grep { $_ !~ /^\s*#/ } <$fh>;
  6         44  
113 2 100       17 hurl {
114             ident => 'plan',
115             message => __ 'Aborting due to empty note',
116             exitval => 1,
117             } unless $note =~ /\S/;
118              
119             # Trim the note.
120 1         4 $note =~ s/\A\v+//;
121 1         8 $note =~ s/\v+\z//;
122              
123             # Set the note.
124 1         30 $self->note($note);
125 1         70 return $note;
126             }
127              
128             sub note_prompt {
129 5     5 1 2596 my ( $self, %p ) = @_;
130             __x(
131             "Write a {command} note.\nLines starting with '#' will be ignored.",
132             command => $p{for}
133 5         23 );
134             }
135              
136             sub format_name {
137 2285     2285 1 105360 shift->name;
138             }
139              
140             sub format_operator {
141 455     455 1 682 my $self = shift;
142 455         2729 join '', $self->lopspace, $self->operator, $self->ropspace;
143             }
144              
145             sub format_content {
146 317     317 1 482 my $self = shift;
147 317         734 join '', $self->format_operator, $self->format_name;
148             }
149              
150             sub format_note {
151 423     423 1 10738 my $note = shift->note;
152 423 100       4003 return '' unless length $note;
153 107         419 $note =~ s/([\r\n\\])/$escape{$1}/g;
154 107         769 return "# $note";
155             }
156              
157             sub as_string {
158 315     315 1 8807 my $self = shift;
159 315         1271 return $self->lspace
160             . $self->format_content
161             . $self->rspace
162             . $self->format_note;
163             }
164              
165             1;
166              
167             __END__
168              
169             =head1 Name
170              
171             App::Sqitch::Plan::Line - Sqitch deployment plan line
172              
173             =head1 Synopsis
174              
175             my $plan = App::Sqitch::Plan->new( sqitch => $sqitch );
176             for my $line ($plan->lines) {
177             say $line->as_string;
178             }
179              
180             =head1 Description
181              
182             An App::Sqitch::Plan::Line represents a single line from a Sqitch plan file.
183             Each object managed by an L<App::Sqitch::Plan> object is derived from this
184             class. This is actually an abstract base class. See
185             L<App::Sqitch::Plan::Change>, L<App::Sqitch::Plan::Tag>, and
186             L<App::Sqitch::Plan::Blank> for concrete subclasses.
187              
188             =head1 Interface
189              
190             =head2 Constructors
191              
192             =head3 C<new>
193              
194             my $plan = App::Sqitch::Plan::Line->new(%params);
195              
196             Instantiates and returns a App::Sqitch::Plan::Line object. Parameters:
197              
198             =over
199              
200             =item C<plan>
201              
202             The L<App::Sqitch::Plan> object with which the line is associated.
203              
204             =item C<name>
205              
206             The name of the line. Should be empty for blank lines. Tags names should
207             not include the leading C<@>.
208              
209             =item C<lspace>
210              
211             The white space from the beginning of the line, if any.
212              
213             =item C<lopspace>
214              
215             The white space to the left of the operator, if any.
216              
217             =item C<operator>
218              
219             An operator, if any.
220              
221             =item C<ropspace>
222              
223             The white space to the right of the operator, if any.
224              
225             =item C<rspace>
226              
227             The white space after the name until the end of the line or the start of a
228             note.
229              
230             =item C<note>
231              
232             A note. Does not include the leading C<#>, but does include any white space
233             immediate after the C<#> when the plan file is parsed.
234              
235             =back
236              
237             =head2 Accessors
238              
239             =head3 C<plan>
240              
241             my $plan = $line->plan;
242              
243             Returns the plan object with which the line object is associated.
244              
245             =head3 C<name>
246              
247             my $name = $line->name;
248              
249             Returns the name of the line. Returns an empty string if there is no name.
250              
251             =head3 C<lspace>
252              
253             my $lspace = $line->lspace.
254              
255             Returns the white space from the beginning of the line, if any.
256              
257             =head3 C<rspace>
258              
259             my $rspace = $line->rspace.
260              
261             Returns the white space after the name until the end of the line or the start
262             of a note.
263              
264             =head3 C<note>
265              
266             my $note = $line->note.
267              
268             Returns the note. Does not include the leading C<#>, but does include any
269             white space immediate after the C<#> when the plan file is parsed. Returns the
270             empty string if there is no note.
271              
272             =head2 Instance Methods
273              
274             =head3 C<format_name>
275              
276             my $formatted_name = $line->format_name;
277              
278             Returns the name of the line properly formatted for output. For
279             L<tags|App::Sqitch::Plan::Tag>, it's the name with a leading C<@>. For all
280             other lines, it is simply the name.
281              
282             =head3 C<format_operator>
283              
284             my $formatted_operator = $line->format_operator;
285              
286             Returns the formatted representation of the operator. This is just the
287             operator an its associated white space. If neither the operator nor its white
288             space exists, an empty string is returned. Used internally by C<as_string()>.
289              
290             =head3 C<format_content>
291              
292             my $formatted_content $line->format_content;
293              
294             Formats and returns the main content of the line. This consists of an operator
295             and its associated white space, if any, followed by the formatted name.
296              
297             =head3 C<format_note>
298              
299             my $note = $line->format_note;
300              
301             Returns the note formatted for output. That is, with a leading C<#> and
302             newlines encoded.
303              
304             =head3 C<as_string>
305              
306             my $string = $line->as_string;
307              
308             Returns the full stringification of the line, suitable for output to a plan
309             file.
310              
311             =head3 C<request_note>
312              
313             my $note = $line->request_note( for => 'add' );
314              
315             Request the note from the user. Pass in the name of the command for which the
316             note is requested via the C<for> parameter. If there is a note, it is simply
317             returned. Otherwise, an editor will be launched and the user asked to write
318             one. Once the editor exits, the note will be retrieved from the file, saved,
319             and returned. If no note was written, an exception will be thrown with an
320             C<exitval> of 1.
321              
322             =head3 C<note_prompt>
323              
324             my $prompt = $line->note_prompt( for => 'tag' );
325              
326             Returns a localized string for use in the temporary file created by
327             C<request_note()>. Pass in the name of the command for which to prompt via the
328             C<for> parameter.
329              
330             =head1 See Also
331              
332             =over
333              
334             =item L<App::Sqitch::Plan>
335              
336             Class representing a plan.
337              
338             =item L<sqitch>
339              
340             The Sqitch command-line client.
341              
342             =back
343              
344             =head1 Author
345              
346             David E. Wheeler <david@justatheory.com>
347              
348             =head1 License
349              
350             Copyright (c) 2012-2023 iovation Inc., David E. Wheeler
351              
352             Permission is hereby granted, free of charge, to any person obtaining a copy
353             of this software and associated documentation files (the "Software"), to deal
354             in the Software without restriction, including without limitation the rights
355             to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
356             copies of the Software, and to permit persons to whom the Software is
357             furnished to do so, subject to the following conditions:
358              
359             The above copyright notice and this permission notice shall be included in all
360             copies or substantial portions of the Software.
361              
362             THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
363             IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
364             FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
365             AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
366             LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
367             OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
368             SOFTWARE.
369              
370             =cut