line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
use 5.010; |
3
|
50
|
|
|
50
|
|
993
|
use utf8; |
|
50
|
|
|
|
|
165
|
|
4
|
50
|
|
|
50
|
|
273
|
use App::Sqitch::Plan::Tag; |
|
50
|
|
|
|
|
91
|
|
|
50
|
|
|
|
|
300
|
|
5
|
50
|
|
|
50
|
|
18608
|
use App::Sqitch::Plan::Change; |
|
50
|
|
|
|
|
149
|
|
|
50
|
|
|
|
|
1647
|
|
6
|
50
|
|
|
50
|
|
23031
|
use App::Sqitch::Plan::Blank; |
|
50
|
|
|
|
|
170
|
|
|
50
|
|
|
|
|
1714
|
|
7
|
50
|
|
|
50
|
|
20340
|
use App::Sqitch::Plan::Pragma; |
|
50
|
|
|
|
|
151
|
|
|
50
|
|
|
|
|
1561
|
|
8
|
50
|
|
|
50
|
|
19580
|
use App::Sqitch::Plan::Depend; |
|
50
|
|
|
|
|
149
|
|
|
50
|
|
|
|
|
1593
|
|
9
|
50
|
|
|
50
|
|
340
|
use Path::Class; |
|
50
|
|
|
|
|
100
|
|
|
50
|
|
|
|
|
1047
|
|
10
|
50
|
|
|
50
|
|
232
|
use App::Sqitch::Plan::ChangeList; |
|
50
|
|
|
|
|
101
|
|
|
50
|
|
|
|
|
2592
|
|
11
|
50
|
|
|
50
|
|
21528
|
use App::Sqitch::Plan::LineList; |
|
50
|
|
|
|
|
114
|
|
|
50
|
|
|
|
|
1602
|
|
12
|
50
|
|
|
50
|
|
18765
|
use Locale::TextDomain qw(App-Sqitch); |
|
50
|
|
|
|
|
111
|
|
|
50
|
|
|
|
|
1602
|
|
13
|
50
|
|
|
50
|
|
300
|
use App::Sqitch::X qw(hurl); |
|
50
|
|
|
|
|
90
|
|
|
50
|
|
|
|
|
300
|
|
14
|
50
|
|
|
50
|
|
7240
|
use List::MoreUtils qw(uniq any); |
|
50
|
|
|
|
|
96
|
|
|
50
|
|
|
|
|
382
|
|
15
|
50
|
|
|
50
|
|
11200
|
use namespace::autoclean; |
|
50
|
|
|
|
|
96
|
|
|
50
|
|
|
|
|
426
|
|
16
|
50
|
|
|
50
|
|
50103
|
use Moo; |
|
50
|
|
|
|
|
99
|
|
|
50
|
|
|
|
|
356
|
|
17
|
50
|
|
|
50
|
|
3046
|
use App::Sqitch::Types qw(Str Int HashRef ChangeList LineList Maybe Sqitch URI File Target); |
|
50
|
|
|
|
|
87
|
|
|
50
|
|
|
|
|
275
|
|
18
|
50
|
|
|
50
|
|
17348
|
use constant SYNTAX_VERSION => '1.0.0'; |
|
50
|
|
|
|
|
103
|
|
|
50
|
|
|
|
|
335
|
|
19
|
50
|
|
|
50
|
|
75776
|
|
|
50
|
|
|
|
|
101
|
|
|
50
|
|
|
|
|
269799
|
|
20
|
|
|
|
|
|
|
our $VERSION = 'v1.3.0'; # VERSION |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
# Like [:punct:], but excluding _. Copied from perlrecharclass. |
23
|
|
|
|
|
|
|
my $punct = q{-!"#$%&'()*+,./:;<=>?@[\\]^`{|}~}; |
24
|
|
|
|
|
|
|
my $name_re = qr{ |
25
|
|
|
|
|
|
|
(?![$punct]) # first character isn't punctuation |
26
|
|
|
|
|
|
|
(?: # start non-capturing group, repeated once or more ... |
27
|
|
|
|
|
|
|
(?! # negative look ahead for... |
28
|
|
|
|
|
|
|
[~/=%^] # symbolic reference punctuation |
29
|
|
|
|
|
|
|
[[:digit:]]+ # digits |
30
|
|
|
|
|
|
|
(?:$|[[:blank:]]) # eol or blank |
31
|
|
|
|
|
|
|
) # ... |
32
|
|
|
|
|
|
|
[^[:blank:]:@#] # match a valid character |
33
|
|
|
|
|
|
|
)+ # ... end non-capturing group |
34
|
|
|
|
|
|
|
(?<![$punct])\b # last character isn't punctuation |
35
|
|
|
|
|
|
|
}x; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
my %reserved = map { $_ => undef } qw(ROOT HEAD); |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
|
40
|
442
|
|
|
442
|
1
|
4857
|
has sqitch => ( |
41
|
|
|
|
|
|
|
is => 'ro', |
42
|
|
|
|
|
|
|
isa => Sqitch, |
43
|
|
|
|
|
|
|
required => 1, |
44
|
|
|
|
|
|
|
weak_ref => 1, |
45
|
|
|
|
|
|
|
); |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
has target => ( |
48
|
|
|
|
|
|
|
is => 'ro', |
49
|
|
|
|
|
|
|
isa => Target, |
50
|
|
|
|
|
|
|
required => 1, |
51
|
|
|
|
|
|
|
weak_ref => 1, |
52
|
|
|
|
|
|
|
); |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
has file => ( |
55
|
|
|
|
|
|
|
is => 'ro', |
56
|
|
|
|
|
|
|
isa => File, |
57
|
|
|
|
|
|
|
lazy => 1, |
58
|
|
|
|
|
|
|
default => sub { |
59
|
|
|
|
|
|
|
shift->target->plan_file |
60
|
|
|
|
|
|
|
}, |
61
|
|
|
|
|
|
|
); |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
has _plan => ( |
64
|
|
|
|
|
|
|
is => 'rw', |
65
|
|
|
|
|
|
|
isa => HashRef, |
66
|
|
|
|
|
|
|
builder => 'load', |
67
|
|
|
|
|
|
|
init_arg => 'plan', |
68
|
|
|
|
|
|
|
lazy => 1, |
69
|
|
|
|
|
|
|
required => 1, |
70
|
|
|
|
|
|
|
); |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
has _changes => ( |
73
|
|
|
|
|
|
|
is => 'ro', |
74
|
|
|
|
|
|
|
isa => ChangeList, |
75
|
|
|
|
|
|
|
lazy => 1, |
76
|
|
|
|
|
|
|
default => sub { |
77
|
|
|
|
|
|
|
App::Sqitch::Plan::ChangeList->new(@{ shift->_plan->{changes} }), |
78
|
|
|
|
|
|
|
}, |
79
|
|
|
|
|
|
|
); |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
has _lines => ( |
82
|
|
|
|
|
|
|
is => 'ro', |
83
|
|
|
|
|
|
|
isa => LineList, |
84
|
|
|
|
|
|
|
lazy => 1, |
85
|
|
|
|
|
|
|
default => sub { |
86
|
|
|
|
|
|
|
App::Sqitch::Plan::LineList->new(@{ shift->_plan->{lines} }), |
87
|
|
|
|
|
|
|
}, |
88
|
|
|
|
|
|
|
); |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
has position => ( |
91
|
|
|
|
|
|
|
is => 'rw', |
92
|
|
|
|
|
|
|
isa => Int, |
93
|
|
|
|
|
|
|
default => -1, |
94
|
|
|
|
|
|
|
); |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
has project => ( |
97
|
|
|
|
|
|
|
is => 'ro', |
98
|
|
|
|
|
|
|
isa => Str, |
99
|
|
|
|
|
|
|
lazy => 1, |
100
|
|
|
|
|
|
|
default => sub { |
101
|
|
|
|
|
|
|
shift->_plan->{pragmas}{project}; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
); |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
has uri => ( |
106
|
|
|
|
|
|
|
is => 'ro', |
107
|
|
|
|
|
|
|
isa => Maybe[URI], |
108
|
|
|
|
|
|
|
lazy => 1, |
109
|
|
|
|
|
|
|
default => sub { |
110
|
|
|
|
|
|
|
my $uri = shift->_plan->{pragmas}{uri} || return; |
111
|
|
|
|
|
|
|
require URI; |
112
|
|
|
|
|
|
|
'URI'->new($uri); |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
); |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
my ( $self, $data ) = @_; |
117
|
|
|
|
|
|
|
open my $fh, '<:utf8_strict', \$data; |
118
|
|
|
|
|
|
|
$self->_plan( $self->load($fh) ); |
119
|
8
|
|
|
8
|
1
|
1446
|
return $self; |
120
|
8
|
|
|
1
|
|
139
|
} |
|
1
|
|
|
1
|
|
5
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
716
|
|
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
4
|
|
121
|
8
|
|
|
|
|
721
|
|
122
|
8
|
|
|
|
|
231
|
my $self = shift; |
123
|
|
|
|
|
|
|
my $file = $self->file; |
124
|
|
|
|
|
|
|
my $fh = shift || do { |
125
|
|
|
|
|
|
|
hurl plan => __x('Plan file {file} does not exist', file => $file) |
126
|
277
|
|
|
277
|
1
|
56756
|
unless -e $file; |
127
|
277
|
|
|
|
|
4075
|
hurl plan => __x('Plan file {file} is not a regular file', file => $file) |
128
|
277
|
|
66
|
|
|
33087
|
unless -f $file; |
129
|
|
|
|
|
|
|
$file->open('<:utf8_strict') or hurl io => __x( |
130
|
|
|
|
|
|
|
'Cannot open {file}: {error}', |
131
|
|
|
|
|
|
|
file => $file, |
132
|
|
|
|
|
|
|
error => $! |
133
|
|
|
|
|
|
|
); |
134
|
|
|
|
|
|
|
}; |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
return $self->_parse($file, $fh); |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
my ( $self, $file, $fh ) = @_; |
140
|
268
|
|
|
|
|
60057
|
|
141
|
|
|
|
|
|
|
my @lines; # List of lines. |
142
|
|
|
|
|
|
|
my @changes; # List of changes. |
143
|
|
|
|
|
|
|
my @curr_changes; # List of changes since last tag. |
144
|
347
|
|
|
347
|
|
751767
|
my %line_no_for; # Maps tags and changes to line numbers. |
145
|
|
|
|
|
|
|
my %change_named; # Maps change names to change objects. |
146
|
347
|
|
|
|
|
2806
|
my %tag_changes; # Maps changes in current tag section to line numbers. |
147
|
|
|
|
|
|
|
my %pragmas; # Maps pragma names to values. |
148
|
347
|
|
|
|
|
0
|
my $seen_version; # Have we seen a version pragma? |
149
|
347
|
|
|
|
|
0
|
my $prev_tag; # Last seen tag. |
150
|
347
|
|
|
|
|
0
|
my $prev_change; # Last seen change. |
151
|
347
|
|
|
|
|
0
|
|
152
|
347
|
|
|
|
|
0
|
# Regex to match timestamps. |
153
|
347
|
|
|
|
|
0
|
my $ts_re = qr/ |
154
|
347
|
|
|
|
|
0
|
(?<yr>[[:digit:]]{4}) # year |
155
|
347
|
|
|
|
|
0
|
- # dash |
156
|
|
|
|
|
|
|
(?<mo>[[:digit:]]{2}) # month |
157
|
|
|
|
|
|
|
- # dash |
158
|
347
|
|
|
|
|
1893
|
(?<dy>[[:digit:]]{2}) # day |
159
|
|
|
|
|
|
|
T # T |
160
|
|
|
|
|
|
|
(?<hr>[[:digit:]]{2}) # hour |
161
|
|
|
|
|
|
|
: # colon |
162
|
|
|
|
|
|
|
(?<mi>[[:digit:]]{2}) # minute |
163
|
|
|
|
|
|
|
: # colon |
164
|
|
|
|
|
|
|
(?<sc>[[:digit:]]{2}) # second |
165
|
|
|
|
|
|
|
Z # Zulu time |
166
|
|
|
|
|
|
|
/x; |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
my $planner_re = qr/ |
169
|
|
|
|
|
|
|
(?<planner_name>[^<]+) # name |
170
|
|
|
|
|
|
|
[[:blank:]]+ # blanks |
171
|
|
|
|
|
|
|
<(?<planner_email>[^>]+)> # email |
172
|
|
|
|
|
|
|
/x; |
173
|
347
|
|
|
|
|
981
|
|
174
|
|
|
|
|
|
|
# Use for raising syntax error exceptions. |
175
|
|
|
|
|
|
|
my $raise_syntax_error = sub { |
176
|
|
|
|
|
|
|
hurl parse => __x( |
177
|
|
|
|
|
|
|
'Syntax error in {file} at line {lineno}: {error}', |
178
|
|
|
|
|
|
|
file => $file, |
179
|
|
|
|
|
|
|
lineno => $fh->input_line_number, |
180
|
|
|
|
|
|
|
error => shift |
181
|
46
|
|
|
46
|
|
3629
|
); |
182
|
|
|
|
|
|
|
}; |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
# First, find pragmas. |
185
|
|
|
|
|
|
|
HEADER: while ( my $line = $fh->getline ) { |
186
|
|
|
|
|
|
|
$line =~ s/\r?\n\z//; |
187
|
347
|
|
|
|
|
1828
|
|
188
|
|
|
|
|
|
|
# Grab blank lines first. |
189
|
|
|
|
|
|
|
if ($line =~ /\A(?<lspace>[[:blank:]]*)(?:#[[:blank:]]*(?<note>.+)|$)/) { |
190
|
347
|
|
|
|
|
8961
|
my $line = App::Sqitch::Plan::Blank->new( plan => $self, %+ ); |
191
|
818
|
|
|
|
|
30813
|
push @lines => $line; |
192
|
|
|
|
|
|
|
last HEADER if @lines && !$line->note; |
193
|
|
|
|
|
|
|
next HEADER; |
194
|
818
|
100
|
|
|
|
3424
|
} |
195
|
376
|
|
|
|
|
8732
|
|
196
|
376
|
|
|
|
|
52673
|
# Grab inline note. |
197
|
376
|
100
|
66
|
|
|
8544
|
$line =~ s/(?<rspace>[[:blank:]]*)(?:[#][[:blank:]]*(?<note>.*))?$//; |
198
|
42
|
|
|
|
|
894
|
my %params = %+; |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
$raise_syntax_error->( |
201
|
|
|
|
|
|
|
__ 'Invalid pragma; a blank line must come between pragmas and changes' |
202
|
442
|
|
|
|
|
3804
|
) unless $line =~ / |
203
|
442
|
|
|
|
|
5668
|
\A # Beginning of line |
204
|
|
|
|
|
|
|
(?<lspace>[[:blank:]]*)? # Optional leading space |
205
|
442
|
50
|
|
|
|
8914
|
[%] # Required % |
206
|
|
|
|
|
|
|
(?<hspace>[[:blank:]]*)? # Optional space |
207
|
|
|
|
|
|
|
(?<name> # followed by name consisting of... |
208
|
|
|
|
|
|
|
[^$punct] # not punct |
209
|
|
|
|
|
|
|
(?: # followed by... |
210
|
|
|
|
|
|
|
[^[:blank:]=]*? # any number non-blank, non-= |
211
|
|
|
|
|
|
|
[^$punct[:blank:]] # one not blank or punct |
212
|
|
|
|
|
|
|
)? # ... optionally |
213
|
|
|
|
|
|
|
) # ... required |
214
|
|
|
|
|
|
|
(?: # followed by value consisting of... |
215
|
|
|
|
|
|
|
(?<lopspace>[[:blank:]]*) # Optional blanks |
216
|
|
|
|
|
|
|
(?<operator>=) # Required = |
217
|
|
|
|
|
|
|
(?<ropspace>[[:blank:]]*) # Optional blanks |
218
|
|
|
|
|
|
|
(?<value>.+) # String value |
219
|
|
|
|
|
|
|
)? # ... optionally |
220
|
|
|
|
|
|
|
\z # end of line |
221
|
|
|
|
|
|
|
/x; |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
# XXX Die if the pragma is a dupe? |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
if ($+{name} eq 'syntax-version') { |
226
|
|
|
|
|
|
|
# Set explicit version in case we write it out later. In future |
227
|
|
|
|
|
|
|
# releases, may change parsers depending on the version. |
228
|
|
|
|
|
|
|
$pragmas{syntax_version} = $params{value} = SYNTAX_VERSION; |
229
|
|
|
|
|
|
|
} elsif ($+{name} eq 'project') { |
230
|
442
|
100
|
|
|
|
3956
|
my $proj = $+{value}; |
|
|
100
|
|
|
|
|
|
231
|
|
|
|
|
|
|
$raise_syntax_error->(__x( |
232
|
|
|
|
|
|
|
qq{invalid project name "{project}": project names must not } |
233
|
90
|
|
|
|
|
346
|
. 'begin with punctuation, contain "@", ":", "#", or blanks, or end in ' |
234
|
|
|
|
|
|
|
. 'punctuation or digits following punctuation', |
235
|
345
|
|
|
|
|
1386
|
project => $proj, |
236
|
345
|
100
|
|
|
|
5039
|
)) unless $proj =~ /\A$name_re\z/; |
237
|
|
|
|
|
|
|
$pragmas{project} = $proj; |
238
|
|
|
|
|
|
|
} else { |
239
|
|
|
|
|
|
|
$pragmas{ $+{name} } = $+{value} // 1; |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
|
242
|
334
|
|
|
|
|
1109
|
push @lines => App::Sqitch::Plan::Pragma->new( |
243
|
|
|
|
|
|
|
plan => $self, |
244
|
7
|
|
100
|
|
|
53
|
%+, |
245
|
|
|
|
|
|
|
%params |
246
|
|
|
|
|
|
|
); |
247
|
431
|
|
|
|
|
13411
|
next HEADER; |
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
# We should have a version pragma. |
251
|
|
|
|
|
|
|
unless ( $pragmas{syntax_version} ) { |
252
|
431
|
|
|
|
|
85865
|
unshift @lines => $self->_version_line; |
253
|
|
|
|
|
|
|
$pragmas{syntax_version} = SYNTAX_VERSION; |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
336
|
100
|
|
|
|
3283
|
# Should have valid project pragma. |
257
|
246
|
|
|
|
|
899
|
hurl parse => __x( |
258
|
246
|
|
|
|
|
36467
|
'Missing %project pragma in {file}', |
259
|
|
|
|
|
|
|
file => $file, |
260
|
|
|
|
|
|
|
) unless $pragmas{project}; |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
LINE: while ( my $line = $fh->getline ) { |
263
|
|
|
|
|
|
|
$line =~ s/\r?\n\z//; |
264
|
|
|
|
|
|
|
|
265
|
336
|
100
|
|
|
|
1006
|
# Grab blank lines first. |
266
|
|
|
|
|
|
|
if ($line =~ /\A(?<lspace>[[:blank:]]*)(?:#[[:blank:]]*(?<note>.+)|$)/) { |
267
|
334
|
|
|
|
|
5888
|
my $line = App::Sqitch::Plan::Blank->new( plan => $self, %+ ); |
268
|
1609
|
|
|
|
|
39288
|
push @lines => $line; |
269
|
|
|
|
|
|
|
next LINE; |
270
|
|
|
|
|
|
|
} |
271
|
1609
|
100
|
|
|
|
5613
|
|
272
|
266
|
|
|
|
|
5353
|
# Grab inline note. |
273
|
266
|
|
|
|
|
32529
|
$line =~ s/(?<rspace>[[:blank:]]*)(?:[#][[:blank:]]*(?<note>.*))?$//; |
274
|
266
|
|
|
|
|
4866
|
my %params = %+; |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
# Is it a tag or a change? |
277
|
|
|
|
|
|
|
my $type = $line =~ /^[[:blank:]]*[@]/ ? 'tag' : 'change'; |
278
|
1343
|
|
|
|
|
22674
|
$line =~ / |
279
|
1343
|
|
|
|
|
11246
|
^ # Beginning of line |
280
|
|
|
|
|
|
|
(?<lspace>[[:blank:]]*)? # Optional leading space |
281
|
|
|
|
|
|
|
|
282
|
1343
|
100
|
|
|
|
5957
|
(?: # followed by... |
283
|
1343
|
|
|
|
|
27566
|
[@] # @ for tag |
284
|
|
|
|
|
|
|
| # ...or... |
285
|
|
|
|
|
|
|
(?<lopspace>[[:blank:]]*) # Optional blanks |
286
|
|
|
|
|
|
|
(?<operator>[+-]) # Required + or - |
287
|
|
|
|
|
|
|
(?<ropspace>[[:blank:]]*) # Optional blanks |
288
|
|
|
|
|
|
|
)? # ... optionally |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
(?<name>$name_re) # followed by name |
291
|
|
|
|
|
|
|
(?<pspace>[[:blank:]]+)? # blanks |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
(?: # followed by... |
294
|
|
|
|
|
|
|
[[](?<dependencies>[^]]+)[]] # dependencies |
295
|
|
|
|
|
|
|
[[:blank:]]* # blanks |
296
|
|
|
|
|
|
|
)? # ... optionally |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
(?: # followed by... |
299
|
|
|
|
|
|
|
$ts_re # timestamp |
300
|
|
|
|
|
|
|
[[:blank:]]* # blanks |
301
|
|
|
|
|
|
|
)? # ... optionally |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
(?: # followed by |
304
|
|
|
|
|
|
|
$planner_re # planner |
305
|
|
|
|
|
|
|
)? # ... optionally |
306
|
|
|
|
|
|
|
$ # end of line |
307
|
|
|
|
|
|
|
/x; |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
%params = ( %params, %+ ); |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
# Raise errors for missing data. |
312
|
|
|
|
|
|
|
$raise_syntax_error->(__( |
313
|
|
|
|
|
|
|
qq{Invalid name; names must not begin with punctuation, } |
314
|
1343
|
|
|
|
|
34230
|
. 'contain "@", ":", "#", or blanks, or end in punctuation or digits following punctuation', |
315
|
|
|
|
|
|
|
)) if !$params{name} |
316
|
|
|
|
|
|
|
|| (!$params{yr} && $line =~ $ts_re); |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
$raise_syntax_error->(__ 'Missing timestamp and planner name and email') |
319
|
|
|
|
|
|
|
unless $params{yr} || $params{planner_name}; |
320
|
|
|
|
|
|
|
$raise_syntax_error->(__ 'Missing timestamp') unless $params{yr}; |
321
|
1343
|
100
|
100
|
|
|
9341
|
|
|
|
|
100
|
|
|
|
|
322
|
|
|
|
|
|
|
$raise_syntax_error->(__ 'Missing planner name and email') |
323
|
|
|
|
|
|
|
unless $params{planner_name}; |
324
|
1320
|
100
|
100
|
|
|
2607
|
|
325
|
1319
|
100
|
|
|
|
2520
|
# It must not be a reserved name. |
326
|
|
|
|
|
|
|
$raise_syntax_error->(__x( |
327
|
|
|
|
|
|
|
'"{name}" is a reserved name', |
328
|
1318
|
100
|
|
|
|
2126
|
name => ($type eq 'tag' ? '@' : '') . $params{name}, |
329
|
|
|
|
|
|
|
)) if exists $reserved{ $params{name} }; |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
# It must not look like a SHA1 hash. |
332
|
|
|
|
|
|
|
$raise_syntax_error->(__x( |
333
|
|
|
|
|
|
|
'"{name}" is invalid because it could be confused with a SHA1 ID', |
334
|
1317
|
50
|
|
|
|
3042
|
name => $params{name}, |
|
|
100
|
|
|
|
|
|
335
|
|
|
|
|
|
|
)) if $params{name} =~ /^[0-9a-f]{40}/; |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
# Assemble the timestamp. |
338
|
|
|
|
|
|
|
require App::Sqitch::DateTime; |
339
|
|
|
|
|
|
|
$params{timestamp} = App::Sqitch::DateTime->new( |
340
|
1315
|
100
|
|
|
|
2416
|
year => delete $params{yr}, |
341
|
|
|
|
|
|
|
month => delete $params{mo}, |
342
|
|
|
|
|
|
|
day => delete $params{dy}, |
343
|
1314
|
|
|
|
|
14479
|
hour => delete $params{hr}, |
344
|
|
|
|
|
|
|
minute => delete $params{mi}, |
345
|
|
|
|
|
|
|
second => delete $params{sc}, |
346
|
|
|
|
|
|
|
time_zone => 'UTC', |
347
|
|
|
|
|
|
|
); |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
if ($type eq 'tag') { |
350
|
|
|
|
|
|
|
# Fail if no changes. |
351
|
1314
|
|
|
|
|
7249
|
unless ($prev_change) { |
352
|
|
|
|
|
|
|
$raise_syntax_error->(__x( |
353
|
|
|
|
|
|
|
'Tag "{tag}" declared without a preceding change', |
354
|
1314
|
100
|
|
|
|
414856
|
tag => $params{name}, |
355
|
|
|
|
|
|
|
)); |
356
|
449
|
100
|
|
|
|
1190
|
} |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
# Fail on duplicate tag. |
359
|
|
|
|
|
|
|
my $key = '@' . $params{name}; |
360
|
1
|
|
|
|
|
5
|
if ( my $at = $line_no_for{$key} ) { |
361
|
|
|
|
|
|
|
$raise_syntax_error->(__x( |
362
|
|
|
|
|
|
|
'Tag "{tag}" duplicates earlier declaration on line {line}', |
363
|
|
|
|
|
|
|
tag => $params{name}, |
364
|
448
|
|
|
|
|
1186
|
line => $at, |
365
|
448
|
100
|
|
|
|
1285
|
)); |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
# Fail on dependencies. |
369
|
1
|
|
|
|
|
6
|
$raise_syntax_error->(__x( |
370
|
|
|
|
|
|
|
__ 'Tags may not specify dependencies' |
371
|
|
|
|
|
|
|
)) if $params{dependencies}; |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
if (@curr_changes) { |
374
|
|
|
|
|
|
|
# Sort all changes up to this tag by their dependencies. |
375
|
|
|
|
|
|
|
push @changes => $self->check_changes( |
376
|
447
|
100
|
|
|
|
979
|
$pragmas{project}, |
377
|
|
|
|
|
|
|
\%line_no_for, |
378
|
446
|
100
|
|
|
|
914
|
@curr_changes, |
379
|
|
|
|
|
|
|
); |
380
|
|
|
|
|
|
|
@curr_changes = (); |
381
|
|
|
|
|
|
|
} |
382
|
376
|
|
|
|
|
1439
|
|
383
|
|
|
|
|
|
|
# Create the tag and associate it with the previous change. |
384
|
|
|
|
|
|
|
$prev_tag = App::Sqitch::Plan::Tag->new( |
385
|
376
|
|
|
|
|
858
|
plan => $self, |
386
|
|
|
|
|
|
|
change => $prev_change, |
387
|
|
|
|
|
|
|
%params, |
388
|
|
|
|
|
|
|
); |
389
|
446
|
|
|
|
|
9989
|
|
390
|
|
|
|
|
|
|
# Keep track of everything and clean up. |
391
|
|
|
|
|
|
|
$prev_change->add_tag($prev_tag); |
392
|
|
|
|
|
|
|
push @lines => $prev_tag; |
393
|
|
|
|
|
|
|
%line_no_for = (%line_no_for, %tag_changes, $key => $fh->input_line_number); |
394
|
|
|
|
|
|
|
%tag_changes = (); |
395
|
|
|
|
|
|
|
} else { |
396
|
446
|
|
|
|
|
38579
|
# Fail on duplicate change since last tag. |
397
|
446
|
|
|
|
|
8214
|
if ( my $at = $tag_changes{ $params{name} } ) { |
398
|
446
|
|
|
|
|
2016
|
$raise_syntax_error->(__x( |
399
|
446
|
|
|
|
|
16381
|
'Change "{change}" duplicates earlier declaration on line {line}', |
400
|
|
|
|
|
|
|
change => $params{name}, |
401
|
|
|
|
|
|
|
line => $at, |
402
|
865
|
100
|
|
|
|
2631
|
)); |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
# Got dependencies? |
406
|
1
|
|
|
|
|
6
|
if (my $deps = $params{dependencies}) { |
407
|
|
|
|
|
|
|
my (@req, @con, %seen_dep); |
408
|
|
|
|
|
|
|
for my $depstring (split /[[:blank:]]+/, $deps) { |
409
|
|
|
|
|
|
|
my $dep_params = App::Sqitch::Plan::Depend->parse( |
410
|
|
|
|
|
|
|
$depstring, |
411
|
864
|
100
|
|
|
|
1981
|
) or $raise_syntax_error->(__x( |
412
|
214
|
|
|
|
|
366
|
'"{dep}" is not a valid dependency specification', |
413
|
214
|
|
|
|
|
1055
|
dep => $depstring, |
414
|
307
|
100
|
|
|
|
1407
|
)); |
415
|
|
|
|
|
|
|
my $dep = App::Sqitch::Plan::Depend->new( |
416
|
|
|
|
|
|
|
plan => $self, |
417
|
|
|
|
|
|
|
%{ $dep_params }, |
418
|
|
|
|
|
|
|
); |
419
|
|
|
|
|
|
|
# Prevent dupes. |
420
|
|
|
|
|
|
|
$raise_syntax_error->( |
421
|
|
|
|
|
|
|
__x( 'Duplicate dependency "{dep}"', dep => $depstring ), |
422
|
306
|
|
|
|
|
854
|
) if $seen_dep{$depstring}++; |
|
306
|
|
|
|
|
5669
|
|
423
|
|
|
|
|
|
|
if ($dep->conflicts) { |
424
|
|
|
|
|
|
|
push @con => $dep; |
425
|
|
|
|
|
|
|
} else { |
426
|
|
|
|
|
|
|
push @req => $dep; |
427
|
306
|
100
|
|
|
|
29713
|
} |
428
|
305
|
100
|
|
|
|
1010
|
} |
429
|
73
|
|
|
|
|
253
|
$params{requires} = \@req; |
430
|
|
|
|
|
|
|
$params{conflicts} = \@con; |
431
|
232
|
|
|
|
|
732
|
} |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
$tag_changes{ $params{name} } = $fh->input_line_number; |
434
|
212
|
|
|
|
|
510
|
push @curr_changes => $prev_change = App::Sqitch::Plan::Change->new( |
435
|
212
|
|
|
|
|
464
|
plan => $self, |
436
|
|
|
|
|
|
|
( $prev_tag ? ( since_tag => $prev_tag ) : () ), |
437
|
|
|
|
|
|
|
( $prev_change ? ( parent => $prev_change ) : () ), |
438
|
862
|
|
|
|
|
2918
|
%params, |
439
|
862
|
100
|
|
|
|
35848
|
); |
|
|
100
|
|
|
|
|
|
440
|
|
|
|
|
|
|
push @lines => $prev_change; |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
if (my $duped = $change_named{ $params{name} }) { |
443
|
|
|
|
|
|
|
# Get rework tags by change in reverse order to reworked change. |
444
|
|
|
|
|
|
|
my @rework_tags; |
445
|
862
|
|
|
|
|
90939
|
for (my $i = $#changes; $changes[$i] ne $duped; $i--) { |
446
|
|
|
|
|
|
|
push @rework_tags => $changes[$i]->tags; |
447
|
862
|
100
|
|
|
|
2621
|
} |
448
|
|
|
|
|
|
|
# Add list of rework tags to the reworked change. |
449
|
91
|
|
|
|
|
159
|
$duped->add_rework_tags(@rework_tags, $duped->tags); |
450
|
91
|
|
|
|
|
466
|
} |
451
|
39
|
|
|
|
|
261
|
$change_named{ $params{name} } = $prev_change; |
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
} |
454
|
91
|
|
|
|
|
679
|
|
455
|
|
|
|
|
|
|
# Sort and store any remaining changes. |
456
|
862
|
|
|
|
|
19085
|
push @changes => $self->check_changes( |
457
|
|
|
|
|
|
|
$pragmas{project}, |
458
|
|
|
|
|
|
|
\%line_no_for, |
459
|
|
|
|
|
|
|
@curr_changes, |
460
|
|
|
|
|
|
|
) if @curr_changes; |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
return { |
463
|
299
|
100
|
|
|
|
11187
|
changes => \@changes, |
464
|
|
|
|
|
|
|
lines => \@lines, |
465
|
|
|
|
|
|
|
pragmas => \%pragmas, |
466
|
|
|
|
|
|
|
}; |
467
|
|
|
|
|
|
|
} |
468
|
299
|
|
|
|
|
13676
|
|
469
|
|
|
|
|
|
|
App::Sqitch::Plan::Pragma->new( |
470
|
|
|
|
|
|
|
plan => shift, |
471
|
|
|
|
|
|
|
name => 'syntax-version', |
472
|
|
|
|
|
|
|
operator => '=', |
473
|
|
|
|
|
|
|
value => SYNTAX_VERSION, |
474
|
|
|
|
|
|
|
); |
475
|
246
|
|
|
246
|
|
3818
|
} |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
my ( $self, $proj ) = ( shift, shift ); |
478
|
|
|
|
|
|
|
my $seen = ref $_[0] eq 'HASH' ? shift : {}; |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
my %position; |
481
|
|
|
|
|
|
|
my @invalid; |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
my $i = 0; |
484
|
467
|
|
|
467
|
1
|
1406
|
for my $change (@_) { |
485
|
467
|
100
|
|
|
|
1262
|
my @bad; |
486
|
|
|
|
|
|
|
|
487
|
467
|
|
|
|
|
734
|
# XXX Ignoring conflicts for now. |
488
|
|
|
|
|
|
|
for my $dep ( $change->requires ) { |
489
|
|
|
|
|
|
|
# Ignore dependencies on other projects. |
490
|
467
|
|
|
|
|
597
|
if ($dep->got_project) { |
491
|
467
|
|
|
|
|
950
|
# Skip if parsed project name different from current project. |
492
|
843
|
|
|
|
|
1001
|
next if $dep->project ne $proj; |
493
|
|
|
|
|
|
|
} else { |
494
|
|
|
|
|
|
|
# Skip if an ID was passed, is it could be internal or external. |
495
|
843
|
|
|
|
|
2170
|
next if $dep->got_id; |
496
|
|
|
|
|
|
|
} |
497
|
249
|
100
|
|
|
|
1173
|
my $key = $dep->key_name; |
498
|
|
|
|
|
|
|
|
499
|
21
|
100
|
|
|
|
354
|
# Skip it if it's a change from an earlier tag. |
500
|
|
|
|
|
|
|
if ($key =~ /.@/) { |
501
|
|
|
|
|
|
|
# Need to look it up before the tag. |
502
|
228
|
50
|
|
|
|
543
|
my ( $change, $tag ) = split /@/ => $key, 2; |
503
|
|
|
|
|
|
|
if ( my $tag_at = $seen->{"\@$tag"} ) { |
504
|
248
|
|
|
|
|
714
|
if ( my $change_at = $seen->{$change}) { |
505
|
|
|
|
|
|
|
next if $change_at < $tag_at; |
506
|
|
|
|
|
|
|
} |
507
|
248
|
100
|
|
|
|
784
|
} |
508
|
|
|
|
|
|
|
} else { |
509
|
74
|
|
|
|
|
359
|
# Skip it if we've already seen it in the plan. |
510
|
74
|
50
|
|
|
|
307
|
next if exists $seen->{$key} || $position{$key}; |
511
|
74
|
50
|
|
|
|
201
|
} |
512
|
74
|
100
|
|
|
|
226
|
|
513
|
|
|
|
|
|
|
# Hrm, unknown dependency. |
514
|
|
|
|
|
|
|
push @bad, $key; |
515
|
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
$position{$change->name} = ++$i; |
517
|
174
|
100
|
100
|
|
|
662
|
push @invalid, [ $change->name => \@bad ] if @bad; |
518
|
|
|
|
|
|
|
} |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
|
521
|
12
|
|
|
|
|
27
|
# Nothing bad, then go! |
522
|
|
|
|
|
|
|
return @_ unless @invalid; |
523
|
843
|
|
|
|
|
2939
|
|
524
|
843
|
100
|
|
|
|
1833
|
# Build up all of the error messages. |
525
|
|
|
|
|
|
|
my @errors; |
526
|
|
|
|
|
|
|
for my $bad (@invalid) { |
527
|
|
|
|
|
|
|
my $change = $bad->[0]; |
528
|
|
|
|
|
|
|
my $max_delta = 0; |
529
|
467
|
100
|
|
|
|
1774
|
for my $dep (@{ $bad->[1] }) { |
530
|
|
|
|
|
|
|
if ($change eq $dep) { |
531
|
|
|
|
|
|
|
push @errors => __x( |
532
|
9
|
|
|
|
|
17
|
'Change "{change}" cannot require itself', |
533
|
9
|
|
|
|
|
13
|
change => $change, |
534
|
10
|
|
|
|
|
132
|
); |
535
|
10
|
|
|
|
|
12
|
} elsif (my $pos = $position{ $dep }) { |
536
|
10
|
|
|
|
|
14
|
my $delta = $pos - $position{$change}; |
|
10
|
|
|
|
|
19
|
|
537
|
12
|
100
|
|
|
|
227
|
$max_delta = $delta if $delta > $max_delta; |
|
|
100
|
|
|
|
|
|
538
|
1
|
|
|
|
|
4
|
push @errors => __xn( |
539
|
|
|
|
|
|
|
'Change "{change}" planned {num} change before required change "{required}"', |
540
|
|
|
|
|
|
|
'Change "{change}" planned {num} changes before required change "{required}"', |
541
|
|
|
|
|
|
|
$delta, |
542
|
|
|
|
|
|
|
change => $change, |
543
|
8
|
|
|
|
|
13
|
required => $dep, |
544
|
8
|
100
|
|
|
|
15
|
num => $delta, |
545
|
8
|
|
|
|
|
21
|
); |
546
|
|
|
|
|
|
|
} else { |
547
|
|
|
|
|
|
|
push @errors => __x( |
548
|
|
|
|
|
|
|
'Unknown change "{required}" required by change "{change}"', |
549
|
|
|
|
|
|
|
required => $dep, |
550
|
|
|
|
|
|
|
change => $change, |
551
|
|
|
|
|
|
|
); |
552
|
|
|
|
|
|
|
} |
553
|
|
|
|
|
|
|
} |
554
|
3
|
|
|
|
|
9
|
if ($max_delta) { |
555
|
|
|
|
|
|
|
# Suggest that the change be moved. |
556
|
|
|
|
|
|
|
# XXX Potentially offer to move it and rewrite the plan. |
557
|
|
|
|
|
|
|
$errors[-1] .= "\n " . __xn( |
558
|
|
|
|
|
|
|
'HINT: move "{change}" down {num} line in {plan}', |
559
|
|
|
|
|
|
|
'HINT: move "{change}" down {num} lines in {plan}', |
560
|
|
|
|
|
|
|
$max_delta, |
561
|
10
|
100
|
|
|
|
937
|
change => $change, |
562
|
|
|
|
|
|
|
num => $max_delta, |
563
|
|
|
|
|
|
|
plan => $self->file, |
564
|
6
|
|
|
|
|
112
|
); |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
# Throw the exception with all of the errors. |
569
|
|
|
|
|
|
|
hurl parse => join( |
570
|
|
|
|
|
|
|
"\n ", |
571
|
|
|
|
|
|
|
__n( |
572
|
|
|
|
|
|
|
'Dependency error detected:', |
573
|
|
|
|
|
|
|
'Dependency errors detected:', |
574
|
|
|
|
|
|
|
@errors |
575
|
|
|
|
|
|
|
), |
576
|
9
|
|
|
|
|
596
|
@errors, |
577
|
|
|
|
|
|
|
); |
578
|
|
|
|
|
|
|
} |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
my ( $self, $file ) = @_; |
581
|
|
|
|
|
|
|
# return has higher precedence than or, so use ||. |
582
|
|
|
|
|
|
|
return $file->open('<:utf8_strict') || hurl io => __x( |
583
|
|
|
|
|
|
|
'Cannot open {file}: {error}', |
584
|
|
|
|
|
|
|
file => $file, |
585
|
|
|
|
|
|
|
error => $!, |
586
|
|
|
|
|
|
|
); |
587
|
|
|
|
|
|
|
} |
588
|
6
|
|
|
6
|
1
|
2903
|
|
589
|
|
|
|
|
|
|
|
590
|
6
|
|
66
|
|
|
16
|
my ( $self, %p ) = @_; |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
my $reverse = 0; |
593
|
|
|
|
|
|
|
if (my $d = delete $p{direction}) { |
594
|
|
|
|
|
|
|
$reverse = $d =~ /^ASC/i ? 0 |
595
|
|
|
|
|
|
|
: $d =~ /^DESC/i ? 1 |
596
|
|
|
|
|
|
|
: hurl 'Search direction must be either "ASC" or "DESC"'; |
597
|
1
|
|
|
1
|
1
|
735
|
} |
598
|
58
|
|
|
58
|
1
|
2389
|
|
599
|
37
|
|
|
37
|
1
|
75068
|
# Limit with regular expressions? |
600
|
9
|
|
|
9
|
1
|
668
|
my @filters; |
601
|
62
|
|
|
62
|
1
|
22832
|
if (my $regex = delete $p{planner}) { |
602
|
123
|
|
|
123
|
1
|
5208
|
$regex = qr/$regex/; |
603
|
134
|
|
|
134
|
1
|
31918
|
push @filters => sub { $_[0]->planner_name =~ $regex }; |
604
|
148
|
|
|
148
|
1
|
79564
|
} |
605
|
62
|
|
|
62
|
1
|
10284
|
if (my $regex = delete $p{name}) { |
606
|
48
|
|
|
48
|
1
|
782
|
$regex = qr/$regex/; |
607
|
167
|
|
|
167
|
1
|
19828
|
push @filters => sub { $_[0]->name =~ $regex }; |
608
|
14
|
|
|
14
|
1
|
813
|
} |
609
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
# Match events? |
611
|
19
|
|
|
19
|
1
|
13409
|
if (my $op = lc(delete $p{operation} || '') ) { |
612
|
|
|
|
|
|
|
push @filters => $op eq 'deploy' ? sub { $_[0]->is_deploy } |
613
|
19
|
|
|
|
|
34
|
: $op eq 'revert' ? sub { $_[0]->is_revert } |
614
|
19
|
100
|
|
|
|
48
|
: hurl qq{Unknown change operation "$op"}; |
615
|
6
|
100
|
|
|
|
34
|
} |
|
|
100
|
|
|
|
|
|
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
my $changes = $self->_changes; |
618
|
|
|
|
|
|
|
my $offset = delete $p{offset} || 0; |
619
|
|
|
|
|
|
|
my $limit = delete $p{limit} || 0; |
620
|
|
|
|
|
|
|
|
621
|
18
|
|
|
|
|
24
|
hurl 'Invalid parameters passed to search_changes(): ' |
622
|
18
|
100
|
|
|
|
39
|
. join ', ', sort keys %p if %p; |
623
|
2
|
|
|
|
|
24
|
|
624
|
2
|
|
|
8
|
|
14
|
# If no filters, we want to return everything. |
|
8
|
|
|
|
|
62
|
|
625
|
|
|
|
|
|
|
push @filters => sub { 1 } unless @filters; |
626
|
18
|
100
|
|
|
|
38
|
|
627
|
3
|
|
|
|
|
41
|
if ($reverse) { |
628
|
3
|
|
|
12
|
|
14
|
# Go backwards. |
|
12
|
|
|
|
|
78
|
|
629
|
|
|
|
|
|
|
my $index = $changes->count - ($offset + 1); |
630
|
|
|
|
|
|
|
my $end_at = $limit ? $index - $limit : -1; |
631
|
|
|
|
|
|
|
return sub { |
632
|
18
|
100
|
100
|
|
|
67
|
while ($index > $end_at) { |
633
|
8
|
|
|
8
|
|
19
|
my $change = $changes->change_at($index--) or return; |
634
|
8
|
|
|
8
|
|
17
|
return $change if any { $_->($change) } @filters; |
635
|
5
|
100
|
|
|
|
37
|
} |
|
|
100
|
|
|
|
|
|
636
|
|
|
|
|
|
|
return; |
637
|
|
|
|
|
|
|
}; |
638
|
17
|
|
|
|
|
357
|
} |
639
|
17
|
|
100
|
|
|
146
|
|
640
|
17
|
|
100
|
|
|
42
|
my $index = $offset - 1; |
641
|
|
|
|
|
|
|
my $end_at = $limit ? $index + $limit : $changes->count - 1; |
642
|
17
|
50
|
|
|
|
31
|
return sub { |
643
|
|
|
|
|
|
|
while ($index < $end_at) { |
644
|
|
|
|
|
|
|
my $change = $changes->change_at(++$index) or return; |
645
|
|
|
|
|
|
|
return $change if any { $_->($change) } @filters; |
646
|
17
|
100
|
|
20
|
|
49
|
} |
|
20
|
|
|
|
|
70
|
|
647
|
|
|
|
|
|
|
return; |
648
|
17
|
100
|
|
|
|
32
|
}; |
649
|
|
|
|
|
|
|
} |
650
|
4
|
|
|
|
|
15
|
|
651
|
4
|
100
|
|
|
|
19
|
my ( $self, $key ) = @_; |
652
|
|
|
|
|
|
|
my $index = $self->index_of($key); |
653
|
13
|
|
|
13
|
|
55
|
hurl plan => __x( |
654
|
9
|
50
|
|
|
|
22
|
'Cannot find change "{change}" in plan', |
655
|
9
|
50
|
|
|
|
38
|
change => $key, |
|
9
|
|
|
|
|
15
|
|
656
|
|
|
|
|
|
|
) unless defined $index; |
657
|
4
|
|
|
|
|
6
|
$self->position($index); |
658
|
4
|
|
|
|
|
25
|
return $self; |
659
|
|
|
|
|
|
|
} |
660
|
|
|
|
|
|
|
|
661
|
13
|
|
|
|
|
20
|
my $self = shift; |
662
|
13
|
100
|
|
|
|
48
|
$self->position(-1); |
663
|
|
|
|
|
|
|
return $self; |
664
|
40
|
|
|
40
|
|
184
|
} |
665
|
47
|
50
|
|
|
|
104
|
|
666
|
47
|
100
|
|
|
|
136
|
my $self = shift; |
|
47
|
|
|
|
|
68
|
|
667
|
|
|
|
|
|
|
if ( my $next = $self->peek ) { |
668
|
13
|
|
|
|
|
25
|
$self->position( $self->position + 1 ); |
669
|
13
|
|
|
|
|
91
|
return $next; |
670
|
|
|
|
|
|
|
} |
671
|
|
|
|
|
|
|
$self->position( $self->position + 1 ) if defined $self->current; |
672
|
|
|
|
|
|
|
return undef; |
673
|
7
|
|
|
7
|
1
|
605
|
} |
674
|
7
|
|
|
|
|
14
|
|
675
|
6
|
100
|
|
|
|
32
|
my $self = shift; |
676
|
|
|
|
|
|
|
my $pos = $self->position; |
677
|
|
|
|
|
|
|
return if $pos < 0; |
678
|
|
|
|
|
|
|
$self->_changes->change_at( $pos ); |
679
|
5
|
|
|
|
|
83
|
} |
680
|
5
|
|
|
|
|
155
|
|
681
|
|
|
|
|
|
|
my $self = shift; |
682
|
|
|
|
|
|
|
$self->_changes->change_at( $self->position + 1 ); |
683
|
|
|
|
|
|
|
} |
684
|
30
|
|
|
30
|
1
|
57165
|
|
685
|
30
|
|
|
|
|
540
|
shift->_changes->change_at( -1 ); |
686
|
30
|
|
|
|
|
706
|
} |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
my ( $self, $code ) = @_; |
689
|
|
|
|
|
|
|
while ( local $_ = $self->next ) { |
690
|
151
|
|
|
151
|
1
|
5634
|
return unless $code->($_); |
691
|
151
|
100
|
|
|
|
273
|
} |
692
|
125
|
|
|
|
|
1590
|
} |
693
|
125
|
|
|
|
|
3879
|
|
694
|
|
|
|
|
|
|
my ( $self, %p ) = @_; |
695
|
26
|
100
|
|
|
|
92
|
( my $name = $p{name} ) =~ s/^@//; |
696
|
26
|
|
|
|
|
852
|
$self->_is_valid(tag => $name); |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
my $changes = $self->_changes; |
699
|
|
|
|
|
|
|
my $key = "\@$name"; |
700
|
92
|
|
|
92
|
1
|
61312
|
|
701
|
92
|
|
|
|
|
1201
|
hurl plan => __x( |
702
|
92
|
100
|
|
|
|
506
|
'Tag "{tag}" already exists', |
703
|
90
|
|
|
|
|
1106
|
tag => $key |
704
|
|
|
|
|
|
|
) if defined $changes->index_of($key); |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
my $change; |
707
|
155
|
|
|
155
|
1
|
732
|
if (my $spec = $p{change}) { |
708
|
155
|
|
|
|
|
2861
|
$change = $changes->get($spec) or hurl plan => __x( |
709
|
|
|
|
|
|
|
'Unknown change: "{change}"', |
710
|
|
|
|
|
|
|
change => $spec, |
711
|
|
|
|
|
|
|
); |
712
|
9
|
|
|
9
|
1
|
1605
|
} else { |
713
|
|
|
|
|
|
|
$change = $changes->last_change or hurl plan => __x( |
714
|
|
|
|
|
|
|
'Cannot apply tag "{tag}" to a plan with no changes', |
715
|
|
|
|
|
|
|
tag => $key |
716
|
2
|
|
|
2
|
1
|
3
|
); |
717
|
2
|
|
|
|
|
6
|
} |
718
|
4
|
50
|
|
|
|
10
|
|
719
|
|
|
|
|
|
|
my $tag = App::Sqitch::Plan::Tag->new( |
720
|
|
|
|
|
|
|
%p, |
721
|
|
|
|
|
|
|
plan => $self, |
722
|
|
|
|
|
|
|
name => $name, |
723
|
33
|
|
|
33
|
1
|
41337
|
change => $change, |
724
|
33
|
|
|
|
|
101
|
); |
725
|
33
|
|
|
|
|
95
|
|
726
|
|
|
|
|
|
|
$change->add_tag($tag); |
727
|
19
|
|
|
|
|
341
|
$changes->index_tag( $changes->index_of( $change->id ), $tag ); |
728
|
19
|
|
|
|
|
274
|
|
729
|
|
|
|
|
|
|
# Add tag to line list, after the change and any preceding tags. |
730
|
19
|
100
|
|
|
|
69
|
my $lines = $self->_lines; |
731
|
|
|
|
|
|
|
$lines->insert_at( $tag, $lines->index_of($change) + $change->tags ); |
732
|
|
|
|
|
|
|
return $tag; |
733
|
|
|
|
|
|
|
} |
734
|
|
|
|
|
|
|
|
735
|
18
|
|
|
|
|
29
|
my ( $self, $p ) = @_; |
736
|
18
|
100
|
|
|
|
49
|
# Dependencies must be parsed into objects. |
737
|
3
|
50
|
|
|
|
15
|
$p->{requires} = [ map { |
738
|
|
|
|
|
|
|
my $p = App::Sqitch::Plan::Depend->parse($_) // hurl plan => __x( |
739
|
|
|
|
|
|
|
'"{dep}" is not a valid dependency specification', |
740
|
|
|
|
|
|
|
dep => $_, |
741
|
|
|
|
|
|
|
); |
742
|
15
|
50
|
|
|
|
43
|
App::Sqitch::Plan::Depend->new( |
743
|
|
|
|
|
|
|
%{ $p }, |
744
|
|
|
|
|
|
|
plan => $self, |
745
|
|
|
|
|
|
|
conflicts => 0, |
746
|
|
|
|
|
|
|
); |
747
|
|
|
|
|
|
|
} uniq @{ $p->{requires} } ] if $p->{requires}; |
748
|
18
|
|
|
|
|
365
|
|
749
|
|
|
|
|
|
|
$p->{conflicts} = [ map { |
750
|
|
|
|
|
|
|
my $p = App::Sqitch::Plan::Depend->parse("!$_") // hurl plan => __x( |
751
|
|
|
|
|
|
|
'"{dep}" is not a valid dependency specification', |
752
|
|
|
|
|
|
|
dep => $_, |
753
|
|
|
|
|
|
|
); |
754
|
|
|
|
|
|
|
App::Sqitch::Plan::Depend->new( |
755
|
18
|
|
|
|
|
5266
|
%{ $p }, |
756
|
18
|
|
|
|
|
369
|
plan => $self, |
757
|
|
|
|
|
|
|
conflicts => 1, |
758
|
|
|
|
|
|
|
); |
759
|
18
|
|
|
|
|
298
|
} uniq @{ $p->{conflicts} } ] if $p->{conflicts}; |
760
|
18
|
|
|
|
|
283
|
} |
761
|
18
|
|
|
|
|
83
|
|
762
|
|
|
|
|
|
|
my ( $self, %p ) = @_; |
763
|
|
|
|
|
|
|
$self->_is_valid(change => $p{name}); |
764
|
|
|
|
|
|
|
my $changes = $self->_changes; |
765
|
46
|
|
|
46
|
|
103
|
|
766
|
|
|
|
|
|
|
if ( defined( my $idx = $changes->index_of( $p{name} . '@HEAD' ) ) ) { |
767
|
|
|
|
|
|
|
my $tag_idx = $changes->index_of_last_tagged; |
768
|
10
|
|
100
|
|
|
78
|
hurl plan => __x( |
769
|
|
|
|
|
|
|
qq{Change "{change}" already exists in plan {file}.\n} |
770
|
|
|
|
|
|
|
. 'Use "sqitch rework" to copy and rework it', |
771
|
|
|
|
|
|
|
change => $p{name}, |
772
|
|
|
|
|
|
|
file => $self->file, |
773
|
8
|
|
|
|
|
26
|
); |
|
8
|
|
|
|
|
147
|
|
774
|
|
|
|
|
|
|
} |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
$self->_parse_deps(\%p); |
777
|
46
|
100
|
|
|
|
166
|
my $change = App::Sqitch::Plan::Change->new( %p, plan => $self ); |
|
33
|
|
|
|
|
199
|
|
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
# Make sure dependencies are valid. |
780
|
7
|
|
66
|
|
|
197
|
$self->_check_dependencies( $change, 'add' ); |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
# We good. Append a blank line if the previous change has a tag. |
783
|
|
|
|
|
|
|
if ( $changes->count ) { |
784
|
|
|
|
|
|
|
my $prev = $changes->change_at( $changes->count - 1 ); |
785
|
5
|
|
|
|
|
17
|
if ( $prev->tags ) { |
|
5
|
|
|
|
|
102
|
|
786
|
|
|
|
|
|
|
$self->_lines->append( |
787
|
|
|
|
|
|
|
App::Sqitch::Plan::Blank->new( plan => $self ) |
788
|
|
|
|
|
|
|
); |
789
|
44
|
100
|
|
|
|
994
|
} |
|
28
|
|
|
|
|
103
|
|
790
|
|
|
|
|
|
|
} |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
# Append the change and return. |
793
|
43
|
|
|
43
|
1
|
65973
|
$changes->append( $change ); |
794
|
43
|
|
|
|
|
165
|
$self->_lines->append( $change ); |
795
|
29
|
|
|
|
|
604
|
return $change; |
796
|
|
|
|
|
|
|
} |
797
|
29
|
100
|
|
|
|
669
|
|
798
|
1
|
|
|
|
|
4
|
my ( $self, %p ) = @_; |
799
|
|
|
|
|
|
|
my $changes = $self->_changes; |
800
|
|
|
|
|
|
|
my $idx = $changes->index_of( $p{name} . '@HEAD') // hurl plan => __x( |
801
|
|
|
|
|
|
|
qq{Change "{change}" does not exist in {file}.\n} |
802
|
|
|
|
|
|
|
. 'Use "sqitch add {change}" to add it to the plan', |
803
|
1
|
|
|
|
|
19
|
change => $p{name}, |
804
|
|
|
|
|
|
|
file => $self->file, |
805
|
|
|
|
|
|
|
); |
806
|
|
|
|
|
|
|
|
807
|
28
|
|
|
|
|
127
|
my $tag_idx = $changes->index_of_last_tagged; |
808
|
26
|
|
|
|
|
697
|
hurl plan => __x( |
809
|
|
|
|
|
|
|
qq{Cannot rework "{change}" without an intervening tag.\n} |
810
|
|
|
|
|
|
|
. 'Use "sqitch tag" to create a tag and try again', |
811
|
26
|
|
|
|
|
8407
|
change => $p{name}, |
812
|
|
|
|
|
|
|
) if !defined $tag_idx || $tag_idx < $idx; |
813
|
|
|
|
|
|
|
|
814
|
24
|
100
|
|
|
|
110
|
$self->_parse_deps(\%p); |
815
|
15
|
|
|
|
|
48
|
|
816
|
15
|
100
|
|
|
|
47
|
my ($tag) = $changes->change_at($tag_idx)->tags; |
817
|
3
|
|
|
|
|
61
|
unshift @{ $p{requires} ||= [] } => App::Sqitch::Plan::Depend->new( |
818
|
|
|
|
|
|
|
plan => $self, |
819
|
|
|
|
|
|
|
change => $p{name}, |
820
|
|
|
|
|
|
|
tag => $tag->name, |
821
|
|
|
|
|
|
|
); |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
my $orig = $changes->change_at($idx); |
824
|
24
|
|
|
|
|
198
|
my $new = App::Sqitch::Plan::Change->new( %p, plan => $self ); |
825
|
24
|
|
|
|
|
381
|
|
826
|
24
|
|
|
|
|
146
|
# Make sure dependencies are valid. |
827
|
|
|
|
|
|
|
$self->_check_dependencies( $new, 'rework' ); |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
# We good. |
830
|
22
|
|
|
22
|
1
|
12022
|
$orig->add_rework_tags($tag); |
831
|
22
|
|
|
|
|
454
|
$changes->append( $new ); |
832
|
|
|
|
|
|
|
$self->_lines->append( $new ); |
833
|
|
|
|
|
|
|
return $new; |
834
|
|
|
|
|
|
|
} |
835
|
|
|
|
|
|
|
|
836
|
22
|
|
100
|
|
|
545
|
my ( $self, $change, $action ) = @_; |
837
|
|
|
|
|
|
|
my $changes = $self->_changes; |
838
|
|
|
|
|
|
|
my $project = $self->project; |
839
|
20
|
|
|
|
|
119
|
for my $req ( $change->requires ) { |
840
|
|
|
|
|
|
|
next if $req->project ne $project; |
841
|
|
|
|
|
|
|
$req = $req->key_name; |
842
|
|
|
|
|
|
|
next if defined $changes->index_of($req =~ /@/ ? $req : $req . '@HEAD'); |
843
|
|
|
|
|
|
|
my $name = $change->name; |
844
|
20
|
100
|
100
|
|
|
227
|
if ($action eq 'add') { |
845
|
|
|
|
|
|
|
hurl plan => __x( |
846
|
18
|
|
|
|
|
98
|
'Cannot add change "{change}": requires unknown change "{req}"', |
847
|
|
|
|
|
|
|
change => $name, |
848
|
16
|
|
|
|
|
150
|
req => $req, |
849
|
16
|
|
100
|
|
|
405
|
); |
850
|
|
|
|
|
|
|
} else { |
851
|
|
|
|
|
|
|
hurl plan => __x( |
852
|
16
|
|
|
|
|
134
|
'Cannot rework change "{change}": requires unknown change "{req}"', |
853
|
|
|
|
|
|
|
change => $name, |
854
|
|
|
|
|
|
|
req => $req, |
855
|
16
|
|
|
|
|
2185
|
); |
856
|
16
|
|
|
|
|
320
|
} |
857
|
|
|
|
|
|
|
} |
858
|
|
|
|
|
|
|
return $self; |
859
|
16
|
|
|
|
|
5073
|
} |
860
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
my ( $self, $type, $name ) = @_; |
862
|
15
|
|
|
|
|
362
|
hurl plan => __x( |
863
|
15
|
|
|
|
|
431
|
'"{name}" is a reserved name', |
864
|
15
|
|
|
|
|
277
|
name => $name |
865
|
15
|
|
|
|
|
90
|
) if exists $reserved{$name}; |
866
|
|
|
|
|
|
|
hurl plan => __x( |
867
|
|
|
|
|
|
|
'"{name}" is invalid because it could be confused with a SHA1 ID', |
868
|
|
|
|
|
|
|
name => $name, |
869
|
52
|
|
|
52
|
|
5172
|
) if $name =~ /^[0-9a-f]{40}/; |
870
|
52
|
|
|
|
|
907
|
|
871
|
52
|
|
|
|
|
1030
|
unless ($name =~ /\A$name_re\z/) { |
872
|
52
|
|
|
|
|
802
|
if ($type eq 'change') { |
873
|
34
|
100
|
|
|
|
558
|
hurl plan => __x( |
874
|
31
|
|
|
|
|
1150
|
qq{"{name}" is invalid: changes must not begin with punctuation, } |
875
|
31
|
100
|
|
|
|
247
|
. 'contain "@", ":", "#", or blanks, or end in punctuation or digits following punctuation', |
|
|
100
|
|
|
|
|
|
876
|
6
|
|
|
|
|
19
|
name => $name, |
877
|
6
|
100
|
|
|
|
21
|
); |
878
|
2
|
|
|
|
|
7
|
} else { |
879
|
|
|
|
|
|
|
hurl plan => __x( |
880
|
|
|
|
|
|
|
qq{"{name}" is invalid: tags must not begin with punctuation, } |
881
|
|
|
|
|
|
|
. 'contain "@", ":", "#", or blanks, or end in punctuation or digits following punctuation', |
882
|
|
|
|
|
|
|
name => $name, |
883
|
|
|
|
|
|
|
); |
884
|
4
|
|
|
|
|
15
|
} |
885
|
|
|
|
|
|
|
} |
886
|
|
|
|
|
|
|
} |
887
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
my ( $self, $file, $from, $to ) = @_; |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
my @lines = $self->lines; |
891
|
46
|
|
|
|
|
124
|
|
892
|
|
|
|
|
|
|
if (defined $from || defined $to) { |
893
|
|
|
|
|
|
|
my $lines = $self->_lines; |
894
|
|
|
|
|
|
|
|
895
|
97
|
|
|
97
|
|
10255
|
# Where are the pragmas? |
896
|
|
|
|
|
|
|
my $head_ends_at = do { |
897
|
|
|
|
|
|
|
my $i = 0; |
898
|
|
|
|
|
|
|
while ( my $line = $lines[$i] ) { |
899
|
97
|
100
|
|
|
|
302
|
last if $line->isa('App::Sqitch::Plan::Blank') |
900
|
93
|
100
|
|
|
|
203
|
&& !length $line->note; |
901
|
|
|
|
|
|
|
++$i; |
902
|
|
|
|
|
|
|
} |
903
|
|
|
|
|
|
|
$i; |
904
|
|
|
|
|
|
|
}; |
905
|
91
|
100
|
|
|
|
1327
|
|
906
|
33
|
100
|
|
|
|
99
|
# Where do we start with the changes? |
907
|
11
|
|
|
|
|
44
|
my $from_idx = defined $from ? do { |
908
|
|
|
|
|
|
|
my $change = $self->find($from // '@ROOT') // hurl plan => __x( |
909
|
|
|
|
|
|
|
'Cannot find change {change}', |
910
|
|
|
|
|
|
|
change => $from, |
911
|
|
|
|
|
|
|
); |
912
|
|
|
|
|
|
|
$lines->index_of($change); |
913
|
22
|
|
|
|
|
70
|
} : $head_ends_at + 1; |
914
|
|
|
|
|
|
|
|
915
|
|
|
|
|
|
|
# Where do we end up? |
916
|
|
|
|
|
|
|
my $to_idx = defined $to ? do { |
917
|
|
|
|
|
|
|
my $change = $self->find( $to // '@HEAD' ) // hurl plan => __x( |
918
|
|
|
|
|
|
|
'Cannot find change {change}', |
919
|
|
|
|
|
|
|
change => $to, |
920
|
|
|
|
|
|
|
); |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
# Include any subsequent tags. |
923
|
51
|
|
|
51
|
1
|
4055
|
if (my @tags = $change->tags) { |
924
|
|
|
|
|
|
|
$change = $tags[-1]; |
925
|
51
|
|
|
|
|
241
|
} |
926
|
|
|
|
|
|
|
$lines->index_of($change); |
927
|
51
|
100
|
100
|
|
|
326
|
} : $#lines; |
928
|
11
|
|
|
|
|
164
|
|
929
|
|
|
|
|
|
|
# Collect the lines to write. |
930
|
|
|
|
|
|
|
@lines = ( |
931
|
11
|
|
|
|
|
74
|
@lines[ 0 .. $head_ends_at ], |
932
|
11
|
|
|
|
|
19
|
@lines[ $from_idx .. $to_idx ], |
933
|
11
|
|
|
|
|
29
|
); |
934
|
37
|
100
|
100
|
|
|
382
|
} |
935
|
|
|
|
|
|
|
|
936
|
26
|
|
|
|
|
72
|
my $fh = $file->open('>:utf8_strict') or hurl io => __x( |
937
|
|
|
|
|
|
|
'Cannot open {file}: {error}', |
938
|
11
|
|
|
|
|
74
|
file => $file, |
939
|
|
|
|
|
|
|
error => $! |
940
|
|
|
|
|
|
|
); |
941
|
|
|
|
|
|
|
$fh->say($_->as_string) for @lines; |
942
|
11
|
100
|
|
|
|
30
|
$fh->close or hurl io => __x( |
943
|
9
|
|
50
|
|
|
33
|
'"Error closing {file}: {error}', |
|
|
|
33
|
|
|
|
|
944
|
|
|
|
|
|
|
file => $file, |
945
|
|
|
|
|
|
|
error => $!, |
946
|
|
|
|
|
|
|
); |
947
|
9
|
|
|
|
|
36
|
return $self; |
948
|
|
|
|
|
|
|
} |
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
1; |
951
|
11
|
100
|
|
|
|
26
|
|
952
|
6
|
|
50
|
|
|
21
|
|
|
|
|
33
|
|
|
|
|
953
|
|
|
|
|
|
|
=head1 Name |
954
|
|
|
|
|
|
|
|
955
|
|
|
|
|
|
|
App::Sqitch::Plan - Sqitch Deployment Plan |
956
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
=head1 Synopsis |
958
|
6
|
100
|
|
|
|
18
|
|
959
|
3
|
|
|
|
|
29
|
my $plan = App::Sqitch::Plan->new( sqitch => $sqitch ); |
960
|
|
|
|
|
|
|
while (my $change = $plan->next) { |
961
|
6
|
|
|
|
|
34
|
say "Deploy ", $change->format_name; |
962
|
|
|
|
|
|
|
} |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
=head1 Description |
965
|
11
|
|
|
|
|
42
|
|
966
|
|
|
|
|
|
|
App::Sqitch::Plan provides the interface for a Sqitch plan. It parses a plan |
967
|
|
|
|
|
|
|
file and provides an iteration interface for working with the plan. |
968
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
=head1 Interface |
970
|
|
|
|
|
|
|
|
971
|
51
|
50
|
|
|
|
198
|
=head2 Constants |
972
|
|
|
|
|
|
|
|
973
|
|
|
|
|
|
|
=head3 C<SYNTAX_VERSION> |
974
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
Returns the current version of the Sqitch plan syntax. Used for the |
976
|
51
|
|
|
|
|
9361
|
C<%sytax-version> pragma. |
977
|
51
|
50
|
|
|
|
683
|
|
978
|
|
|
|
|
|
|
=head2 Class Methods |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
=head3 C<name_regex> |
981
|
|
|
|
|
|
|
|
982
|
51
|
|
|
|
|
5215
|
die "$this has no name" unless $this =~ App::Sqitch::Plan->name_regex; |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
Returns a regular expression that matches names. Note that it is not anchored, |
985
|
|
|
|
|
|
|
so if you need to make sure that a string is a valid name and nothing else, |
986
|
|
|
|
|
|
|
you will need to anchor it yourself, like so: |
987
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
my $name_re = App::Sqitch::Plan->name_regex; |
989
|
|
|
|
|
|
|
die "$this is not a valid name" if $this !~ /\A$name_re\z/; |
990
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
=head2 Constructors |
992
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
=head3 C<new> |
994
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
my $plan = App::Sqitch::Plan->new( sqitch => $sqitch ); |
996
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
Instantiates and returns a App::Sqitch::Plan object. Takes a single parameter: |
998
|
|
|
|
|
|
|
an L<App::Sqitch> object. |
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
=head2 Accessors |
1001
|
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
=head3 C<sqitch> |
1003
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
my $sqitch = $plan->sqitch; |
1005
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
Returns the L<App::Sqitch> object that instantiated the plan. |
1007
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
=head3 C<target> |
1009
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
my $target = $plan->target |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
Returns the L<App::Sqitch::Target> passed to the constructor. |
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
=head3 C<file> |
1015
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
my $file = $plan->file; |
1017
|
|
|
|
|
|
|
|
1018
|
|
|
|
|
|
|
The file name from which to read the plan. |
1019
|
|
|
|
|
|
|
|
1020
|
|
|
|
|
|
|
=head3 C<position> |
1021
|
|
|
|
|
|
|
|
1022
|
|
|
|
|
|
|
Returns the current position of the iterator. This is an integer that's used |
1023
|
|
|
|
|
|
|
as an index into plan. If C<next()> has not been called, or if C<reset()> has |
1024
|
|
|
|
|
|
|
been called, the value will be -1, meaning it is outside of the plan. When |
1025
|
|
|
|
|
|
|
C<next> returns C<undef>, the value will be the last index in the plan plus 1. |
1026
|
|
|
|
|
|
|
|
1027
|
|
|
|
|
|
|
=head3 C<project> |
1028
|
|
|
|
|
|
|
|
1029
|
|
|
|
|
|
|
my $project = $plan->project; |
1030
|
|
|
|
|
|
|
|
1031
|
|
|
|
|
|
|
Returns the name of the project as set via the C<%project> pragma in the plan |
1032
|
|
|
|
|
|
|
file. |
1033
|
|
|
|
|
|
|
|
1034
|
|
|
|
|
|
|
=head3 C<uri> |
1035
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
my $uri = $plan->uri; |
1037
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
Returns the URI for the project as set via the C<%uri> pragma, which is |
1039
|
|
|
|
|
|
|
optional. If it is not present, C<undef> will be returned. |
1040
|
|
|
|
|
|
|
|
1041
|
|
|
|
|
|
|
=head3 C<syntax_version> |
1042
|
|
|
|
|
|
|
|
1043
|
|
|
|
|
|
|
my $syntax_version = $plan->syntax_version; |
1044
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
Returns the plan syntax version, which is always the latest version. |
1046
|
|
|
|
|
|
|
|
1047
|
|
|
|
|
|
|
=head2 Instance Methods |
1048
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
=head3 C<index_of> |
1050
|
|
|
|
|
|
|
|
1051
|
|
|
|
|
|
|
my $index = $plan->index_of('6c2f28d125aff1deea615f8de774599acf39a7a1'); |
1052
|
|
|
|
|
|
|
my $foo_index = $plan->index_of('@foo'); |
1053
|
|
|
|
|
|
|
my $bar_index = $plan->index_of('bar'); |
1054
|
|
|
|
|
|
|
my $bar1_index = $plan->index_of('bar@alpha') |
1055
|
|
|
|
|
|
|
my $bar2_index = $plan->index_of('bar@HEAD'); |
1056
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
Returns the index of the specified change. Returns C<undef> if no such change |
1058
|
|
|
|
|
|
|
exists. The argument may be any one of: |
1059
|
|
|
|
|
|
|
|
1060
|
|
|
|
|
|
|
=over |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
=item * An ID |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
my $index = $plan->index_of('6c2f28d125aff1deea615f8de774599acf39a7a1'); |
1065
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
This is the SHA1 hash of a change or tag. Currently, the full 40-character hexed |
1067
|
|
|
|
|
|
|
hash string must be specified. |
1068
|
|
|
|
|
|
|
|
1069
|
|
|
|
|
|
|
=item * A change name |
1070
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
my $index = $plan->index_of('users_table'); |
1072
|
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
|
The name of a change. Will throw an exception if the named change appears more |
1074
|
|
|
|
|
|
|
than once in the list. |
1075
|
|
|
|
|
|
|
|
1076
|
|
|
|
|
|
|
=item * A tag name |
1077
|
|
|
|
|
|
|
|
1078
|
|
|
|
|
|
|
my $index = $plan->index_of('@beta1'); |
1079
|
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
The name of a tag, including the leading C<@>. |
1081
|
|
|
|
|
|
|
|
1082
|
|
|
|
|
|
|
=item * A tag-qualified change name |
1083
|
|
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
my $index = $plan->index_of('users_table@beta1'); |
1085
|
|
|
|
|
|
|
|
1086
|
|
|
|
|
|
|
The named change as it was last seen in the list before the specified tag. |
1087
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
=back |
1089
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
=head3 C<contains> |
1091
|
|
|
|
|
|
|
|
1092
|
|
|
|
|
|
|
say 'Yes!' if $plan->contains('6c2f28d125aff1deea615f8de774599acf39a7a1'); |
1093
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
Like C<index_of()>, but never throws an exception, and returns true if the |
1095
|
|
|
|
|
|
|
plan contains the specified change, and false if it does not. |
1096
|
|
|
|
|
|
|
|
1097
|
|
|
|
|
|
|
=head3 C<get> |
1098
|
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
my $change = $plan->get('6c2f28d125aff1deea615f8de774599acf39a7a1'); |
1100
|
|
|
|
|
|
|
my $foo = $plan->get('@foo'); |
1101
|
|
|
|
|
|
|
my $bar = $plan->get('bar'); |
1102
|
|
|
|
|
|
|
my $bar1 = $plan->get('bar@alpha') |
1103
|
|
|
|
|
|
|
my $bar2 = $plan->get('bar@HEAD'); |
1104
|
|
|
|
|
|
|
|
1105
|
|
|
|
|
|
|
Returns the change corresponding to the specified ID or name. The argument may |
1106
|
|
|
|
|
|
|
be in any of the formats described for C<index_of()>. |
1107
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
=head3 C<find> |
1109
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
my $change = $plan->find('6c2f28d125aff1deea615f8de774599acf39a7a1'); |
1111
|
|
|
|
|
|
|
my $foo = $plan->find('@foo'); |
1112
|
|
|
|
|
|
|
my $bar = $plan->find('bar'); |
1113
|
|
|
|
|
|
|
my $bar1 = $plan->find('bar@alpha') |
1114
|
|
|
|
|
|
|
my $bar2 = $plan->find('bar@HEAD'); |
1115
|
|
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
Finds the change corresponding to the specified ID or name. The argument may be |
1117
|
|
|
|
|
|
|
in any of the formats described for C<index_of()>. Unlike C<get()>, C<find()> |
1118
|
|
|
|
|
|
|
will not throw an error if more than one change exists with the specified name, |
1119
|
|
|
|
|
|
|
but will return the first instance. |
1120
|
|
|
|
|
|
|
|
1121
|
|
|
|
|
|
|
=head3 C<first_index_of> |
1122
|
|
|
|
|
|
|
|
1123
|
|
|
|
|
|
|
my $index = $plan->first_index_of($change_name); |
1124
|
|
|
|
|
|
|
my $index = $plan->first_index_of($change_name, $change_or_tag_name); |
1125
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
Returns the index of the first instance of the named change in the plan. If a |
1127
|
|
|
|
|
|
|
second argument is passed, the index of the first instance of the change |
1128
|
|
|
|
|
|
|
I<after> the index of the second argument will be returned. This is useful |
1129
|
|
|
|
|
|
|
for getting the index of a change as it was deployed after a particular tag, for |
1130
|
|
|
|
|
|
|
example, to get the first index of the F<foo> change since the C<@beta> tag, do |
1131
|
|
|
|
|
|
|
this: |
1132
|
|
|
|
|
|
|
|
1133
|
|
|
|
|
|
|
my $index = $plan->first_index_of('foo', '@beta'); |
1134
|
|
|
|
|
|
|
|
1135
|
|
|
|
|
|
|
You can also specify the first instance of a change after another change, |
1136
|
|
|
|
|
|
|
including such a change at the point of a tag: |
1137
|
|
|
|
|
|
|
|
1138
|
|
|
|
|
|
|
my $index = $plan->first_index_of('foo', 'users_table@beta1'); |
1139
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
The second argument must unambiguously refer to a single change in the plan. As |
1141
|
|
|
|
|
|
|
such, it should usually be a tag name or tag-qualified change name. Returns |
1142
|
|
|
|
|
|
|
C<undef> if the change does not appear in the plan, or if it does not appear |
1143
|
|
|
|
|
|
|
after the specified second argument change name. |
1144
|
|
|
|
|
|
|
|
1145
|
|
|
|
|
|
|
=head3 C<last_tagged_change> |
1146
|
|
|
|
|
|
|
|
1147
|
|
|
|
|
|
|
my $change = $plan->last_tagged_change; |
1148
|
|
|
|
|
|
|
|
1149
|
|
|
|
|
|
|
Returns the last tagged change object. Returns C<undef> if no changes have |
1150
|
|
|
|
|
|
|
been tagged. |
1151
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
=head3 C<change_at> |
1153
|
|
|
|
|
|
|
|
1154
|
|
|
|
|
|
|
my $change = $plan->change_at($index); |
1155
|
|
|
|
|
|
|
|
1156
|
|
|
|
|
|
|
Returns the change at the specified index. |
1157
|
|
|
|
|
|
|
|
1158
|
|
|
|
|
|
|
=head3 C<seek> |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
$plan->seek('@foo'); |
1161
|
|
|
|
|
|
|
$plan->seek('bar'); |
1162
|
|
|
|
|
|
|
|
1163
|
|
|
|
|
|
|
Move the plan position to the specified change. Dies if the change cannot be found |
1164
|
|
|
|
|
|
|
in the plan. |
1165
|
|
|
|
|
|
|
|
1166
|
|
|
|
|
|
|
=head3 C<reset> |
1167
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
$plan->reset; |
1169
|
|
|
|
|
|
|
|
1170
|
|
|
|
|
|
|
Resets iteration. Same as C<< $plan->position(-1) >>, but better. |
1171
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
=head3 C<next> |
1173
|
|
|
|
|
|
|
|
1174
|
|
|
|
|
|
|
while (my $change = $plan->next) { |
1175
|
|
|
|
|
|
|
say "Deploy ", $change->format_name; |
1176
|
|
|
|
|
|
|
} |
1177
|
|
|
|
|
|
|
|
1178
|
|
|
|
|
|
|
Returns the next L<change|App::Sqitch::Plan::Change> in the plan. Returns C<undef> |
1179
|
|
|
|
|
|
|
if there are no more changes. |
1180
|
|
|
|
|
|
|
|
1181
|
|
|
|
|
|
|
=head3 C<last> |
1182
|
|
|
|
|
|
|
|
1183
|
|
|
|
|
|
|
my $change = $plan->last; |
1184
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
Returns the last change in the plan. Does not change the current position. |
1186
|
|
|
|
|
|
|
|
1187
|
|
|
|
|
|
|
=head3 C<current> |
1188
|
|
|
|
|
|
|
|
1189
|
|
|
|
|
|
|
my $change = $plan->current; |
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
Returns the same change as was last returned by C<next()>. Returns C<undef> if |
1192
|
|
|
|
|
|
|
C<next()> has not been called or if the plan has been reset. |
1193
|
|
|
|
|
|
|
|
1194
|
|
|
|
|
|
|
=head3 C<peek> |
1195
|
|
|
|
|
|
|
|
1196
|
|
|
|
|
|
|
my $change = $plan->peek; |
1197
|
|
|
|
|
|
|
|
1198
|
|
|
|
|
|
|
Returns the next change in the plan without incrementing the iterator. Returns |
1199
|
|
|
|
|
|
|
C<undef> if there are no more changes beyond the current change. |
1200
|
|
|
|
|
|
|
|
1201
|
|
|
|
|
|
|
=head3 C<changes> |
1202
|
|
|
|
|
|
|
|
1203
|
|
|
|
|
|
|
my @changes = $plan->changes; |
1204
|
|
|
|
|
|
|
|
1205
|
|
|
|
|
|
|
Returns all of the changes in the plan. This constitutes the entire plan. |
1206
|
|
|
|
|
|
|
|
1207
|
|
|
|
|
|
|
=head3 C<tags> |
1208
|
|
|
|
|
|
|
|
1209
|
|
|
|
|
|
|
my @tags = $plan->tags; |
1210
|
|
|
|
|
|
|
|
1211
|
|
|
|
|
|
|
Returns all of the tags in the plan. |
1212
|
|
|
|
|
|
|
|
1213
|
|
|
|
|
|
|
=head3 C<count> |
1214
|
|
|
|
|
|
|
|
1215
|
|
|
|
|
|
|
my $count = $plan->count; |
1216
|
|
|
|
|
|
|
|
1217
|
|
|
|
|
|
|
Returns the number of changes in the plan. |
1218
|
|
|
|
|
|
|
|
1219
|
|
|
|
|
|
|
=head3 C<lines> |
1220
|
|
|
|
|
|
|
|
1221
|
|
|
|
|
|
|
my @lines = $plan->lines; |
1222
|
|
|
|
|
|
|
|
1223
|
|
|
|
|
|
|
Returns all of the lines in the plan. This includes all the |
1224
|
|
|
|
|
|
|
L<changes|App::Sqitch::Plan::Change>, L<tags|App::Sqitch::Plan::Tag>, |
1225
|
|
|
|
|
|
|
L<pragmas|App::Sqitch::Plan::Pragma>, and L<blank |
1226
|
|
|
|
|
|
|
lines|App::Sqitch::Plan::Blank>. |
1227
|
|
|
|
|
|
|
|
1228
|
|
|
|
|
|
|
=head3 C<do> |
1229
|
|
|
|
|
|
|
|
1230
|
|
|
|
|
|
|
$plan->do(sub { say $_[0]->name; return $_[0]; }); |
1231
|
|
|
|
|
|
|
$plan->do(sub { say $_->name; return $_; }); |
1232
|
|
|
|
|
|
|
|
1233
|
|
|
|
|
|
|
Pass a code reference to this method to execute it for each change in the plan. |
1234
|
|
|
|
|
|
|
Each change will be stored in C<$_> before executing the code reference, and |
1235
|
|
|
|
|
|
|
will also be passed as the sole argument. If C<next()> has been called prior |
1236
|
|
|
|
|
|
|
to the call to C<do()>, then only the remaining changes in the iterator will |
1237
|
|
|
|
|
|
|
passed to the code reference. Iteration terminates when the code reference |
1238
|
|
|
|
|
|
|
returns false, so be sure to have it return a true value if you want it to |
1239
|
|
|
|
|
|
|
iterate over every change. |
1240
|
|
|
|
|
|
|
|
1241
|
|
|
|
|
|
|
=head3 C<search_changes> |
1242
|
|
|
|
|
|
|
|
1243
|
|
|
|
|
|
|
my $iter = $engine->search_changes( %params ); |
1244
|
|
|
|
|
|
|
while (my $change = $iter->()) { |
1245
|
|
|
|
|
|
|
say '* $change->{event}ed $change->{change}"; |
1246
|
|
|
|
|
|
|
} |
1247
|
|
|
|
|
|
|
|
1248
|
|
|
|
|
|
|
Searches the changes in the plan returns an iterator code reference with the |
1249
|
|
|
|
|
|
|
results. If no parameters are provided, a list of all changes will be returned |
1250
|
|
|
|
|
|
|
from the iterator in plan order. The supported parameters are: |
1251
|
|
|
|
|
|
|
|
1252
|
|
|
|
|
|
|
=over |
1253
|
|
|
|
|
|
|
|
1254
|
|
|
|
|
|
|
=item C<event> |
1255
|
|
|
|
|
|
|
|
1256
|
|
|
|
|
|
|
An array of the type of event to search for. Allowed values are "deploy" and |
1257
|
|
|
|
|
|
|
"revert". |
1258
|
|
|
|
|
|
|
|
1259
|
|
|
|
|
|
|
=item C<name> |
1260
|
|
|
|
|
|
|
|
1261
|
|
|
|
|
|
|
Limit the results to changes with names matching the specified regular |
1262
|
|
|
|
|
|
|
expression. |
1263
|
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
=item C<planner> |
1265
|
|
|
|
|
|
|
|
1266
|
|
|
|
|
|
|
Limit the changes to those added by planners matching the specified regular |
1267
|
|
|
|
|
|
|
expression. |
1268
|
|
|
|
|
|
|
|
1269
|
|
|
|
|
|
|
=item C<limit> |
1270
|
|
|
|
|
|
|
|
1271
|
|
|
|
|
|
|
Limit the number of changes to the specified number. |
1272
|
|
|
|
|
|
|
|
1273
|
|
|
|
|
|
|
=item C<offset> |
1274
|
|
|
|
|
|
|
|
1275
|
|
|
|
|
|
|
Skip the specified number of events. |
1276
|
|
|
|
|
|
|
|
1277
|
|
|
|
|
|
|
=item C<direction> |
1278
|
|
|
|
|
|
|
|
1279
|
|
|
|
|
|
|
Return the results in the specified order, which must be a value matching |
1280
|
|
|
|
|
|
|
C</^(:?a|de)sc/i> for "ascending" or "descending". |
1281
|
|
|
|
|
|
|
|
1282
|
|
|
|
|
|
|
=back |
1283
|
|
|
|
|
|
|
|
1284
|
|
|
|
|
|
|
=head3 C<write_to> |
1285
|
|
|
|
|
|
|
|
1286
|
|
|
|
|
|
|
$plan->write_to($file); |
1287
|
|
|
|
|
|
|
$plan->write_to($file, $from, $to); |
1288
|
|
|
|
|
|
|
|
1289
|
|
|
|
|
|
|
Write the plan to the named file, including notes and white space from the |
1290
|
|
|
|
|
|
|
original plan file. If C<from> and/or C<$to> are provided, the plan will be |
1291
|
|
|
|
|
|
|
written only with the pragmas headers and the lines between those specified |
1292
|
|
|
|
|
|
|
changes. |
1293
|
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
|
=head3 C<open_script> |
1295
|
|
|
|
|
|
|
|
1296
|
|
|
|
|
|
|
my $file_handle = $plan->open_script( $change->deploy_file ); |
1297
|
|
|
|
|
|
|
|
1298
|
|
|
|
|
|
|
Opens the script file passed to it and returns a file handle for reading. The |
1299
|
|
|
|
|
|
|
script file must be encoded in UTF-8. |
1300
|
|
|
|
|
|
|
|
1301
|
|
|
|
|
|
|
=head3 C<load> |
1302
|
|
|
|
|
|
|
|
1303
|
|
|
|
|
|
|
my $plan_data = $plan->load; |
1304
|
|
|
|
|
|
|
|
1305
|
|
|
|
|
|
|
Loads the plan data. Called internally, not meant to be called directly, as it |
1306
|
|
|
|
|
|
|
parses the plan file and deploy scripts every time it's called. If you want |
1307
|
|
|
|
|
|
|
the all of the changes, call C<changes()> instead. And if you want to load an |
1308
|
|
|
|
|
|
|
alternate plan, use C<parse()>. |
1309
|
|
|
|
|
|
|
|
1310
|
|
|
|
|
|
|
=head3 C<parse> |
1311
|
|
|
|
|
|
|
|
1312
|
|
|
|
|
|
|
$plan->parse($plan_data); |
1313
|
|
|
|
|
|
|
|
1314
|
|
|
|
|
|
|
Load an alternate plan by passing the complete text of the plan. The text |
1315
|
|
|
|
|
|
|
should be UTF-8 encoded. Useful for loading a plan from a different VCS |
1316
|
|
|
|
|
|
|
branch, for example. |
1317
|
|
|
|
|
|
|
|
1318
|
|
|
|
|
|
|
=head3 C<check_changes> |
1319
|
|
|
|
|
|
|
|
1320
|
|
|
|
|
|
|
@changes = $plan->check_changes( $project, @changes ); |
1321
|
|
|
|
|
|
|
@changes = $plan->check_changes( $project, { '@foo' => 1 }, @changes ); |
1322
|
|
|
|
|
|
|
|
1323
|
|
|
|
|
|
|
Checks a list of changes to validate their dependencies and returns them. If |
1324
|
|
|
|
|
|
|
the second argument is a hash reference, its keys should be previously-seen |
1325
|
|
|
|
|
|
|
change and tag names that can be assumed to be satisfied requirements for the |
1326
|
|
|
|
|
|
|
succeeding changes. |
1327
|
|
|
|
|
|
|
|
1328
|
|
|
|
|
|
|
=head3 C<tag> |
1329
|
|
|
|
|
|
|
|
1330
|
|
|
|
|
|
|
$plan->tag( name => 'whee' ); |
1331
|
|
|
|
|
|
|
|
1332
|
|
|
|
|
|
|
Tags a change in the plan. Exits with a fatal error if the tag already exists |
1333
|
|
|
|
|
|
|
in the plan or if a change cannot be found to tag. The supported parameters |
1334
|
|
|
|
|
|
|
are: |
1335
|
|
|
|
|
|
|
|
1336
|
|
|
|
|
|
|
=over |
1337
|
|
|
|
|
|
|
|
1338
|
|
|
|
|
|
|
=item C<name> |
1339
|
|
|
|
|
|
|
|
1340
|
|
|
|
|
|
|
The tag name to use. Required. |
1341
|
|
|
|
|
|
|
|
1342
|
|
|
|
|
|
|
=item C<change> |
1343
|
|
|
|
|
|
|
|
1344
|
|
|
|
|
|
|
The change to be tagged, specified as a supported change specification as |
1345
|
|
|
|
|
|
|
described in L<sqitchchanges>. Defaults to the last change in the plan. |
1346
|
|
|
|
|
|
|
|
1347
|
|
|
|
|
|
|
=item C<note> |
1348
|
|
|
|
|
|
|
|
1349
|
|
|
|
|
|
|
A brief note about the tag. |
1350
|
|
|
|
|
|
|
|
1351
|
|
|
|
|
|
|
=item C<planner_name> |
1352
|
|
|
|
|
|
|
|
1353
|
|
|
|
|
|
|
The name of the user adding the tag to the plan. Defaults to the value of the |
1354
|
|
|
|
|
|
|
C<user.name> configuration variable. |
1355
|
|
|
|
|
|
|
|
1356
|
|
|
|
|
|
|
=item C<planner_email> |
1357
|
|
|
|
|
|
|
|
1358
|
|
|
|
|
|
|
The email address of the user adding the tag to the plan. Defaults to the |
1359
|
|
|
|
|
|
|
value of the C<user.email> configuration variable. |
1360
|
|
|
|
|
|
|
|
1361
|
|
|
|
|
|
|
=back |
1362
|
|
|
|
|
|
|
|
1363
|
|
|
|
|
|
|
=head3 C<add> |
1364
|
|
|
|
|
|
|
|
1365
|
|
|
|
|
|
|
$plan->add( name => 'whatevs' ); |
1366
|
|
|
|
|
|
|
$plan->add( |
1367
|
|
|
|
|
|
|
name => 'widgets', |
1368
|
|
|
|
|
|
|
requires => [qw(foo bar)], |
1369
|
|
|
|
|
|
|
conflicts => [qw(dr_evil)], |
1370
|
|
|
|
|
|
|
); |
1371
|
|
|
|
|
|
|
|
1372
|
|
|
|
|
|
|
Adds a change to the plan. The supported parameters are the same as those |
1373
|
|
|
|
|
|
|
passed to the L<App::Sqitch::Plan::Change> constructor. Exits with a fatal |
1374
|
|
|
|
|
|
|
error if the change already exists, or if the any of the dependencies are |
1375
|
|
|
|
|
|
|
unknown. |
1376
|
|
|
|
|
|
|
|
1377
|
|
|
|
|
|
|
=head3 C<rework> |
1378
|
|
|
|
|
|
|
|
1379
|
|
|
|
|
|
|
$plan->rework( 'whatevs' ); |
1380
|
|
|
|
|
|
|
$plan->rework( 'widgets', [qw(foo bar)], [qw(dr_evil)] ); |
1381
|
|
|
|
|
|
|
|
1382
|
|
|
|
|
|
|
Reworks an existing change. Said change must already exist in the plan and be |
1383
|
|
|
|
|
|
|
tagged or have a tag following it or an exception will be thrown. The previous |
1384
|
|
|
|
|
|
|
occurrence of the change will have the suffix of the most recent tag added to |
1385
|
|
|
|
|
|
|
it, and a new tag instance will be added to the list. |
1386
|
|
|
|
|
|
|
|
1387
|
|
|
|
|
|
|
=head1 Plan File |
1388
|
|
|
|
|
|
|
|
1389
|
|
|
|
|
|
|
A plan file describes the deployment changes to be run against a database, and |
1390
|
|
|
|
|
|
|
is typically maintained using the L<C<add>|sqitch-add> and |
1391
|
|
|
|
|
|
|
L<C<rework>|sqitch-rework> commands. Its contents must be plain text encoded |
1392
|
|
|
|
|
|
|
as UTF-8. Each line of a plan file may be one of four things: |
1393
|
|
|
|
|
|
|
|
1394
|
|
|
|
|
|
|
=over |
1395
|
|
|
|
|
|
|
|
1396
|
|
|
|
|
|
|
=item * |
1397
|
|
|
|
|
|
|
|
1398
|
|
|
|
|
|
|
A blank line. May include any amount of white space, which will be ignored. |
1399
|
|
|
|
|
|
|
|
1400
|
|
|
|
|
|
|
=item * A Pragma |
1401
|
|
|
|
|
|
|
|
1402
|
|
|
|
|
|
|
Begins with a C<%>, followed by a pragma name, optionally followed by C<=> and |
1403
|
|
|
|
|
|
|
a value. Currently, the only pragma recognized by Sqitch is C<syntax-version>. |
1404
|
|
|
|
|
|
|
|
1405
|
|
|
|
|
|
|
=item * A change. |
1406
|
|
|
|
|
|
|
|
1407
|
|
|
|
|
|
|
A named change change as defined in L<sqitchchanges>. A change may then also |
1408
|
|
|
|
|
|
|
contain a space-delimited list of dependencies, which are the names of other |
1409
|
|
|
|
|
|
|
changes or tags prefixed with a colon (C<:>) for required changes or with an |
1410
|
|
|
|
|
|
|
exclamation point (C<!>) for conflicting changes. |
1411
|
|
|
|
|
|
|
|
1412
|
|
|
|
|
|
|
Changes with a leading C<-> are slated to be reverted, while changes with no |
1413
|
|
|
|
|
|
|
character or a leading C<+> are to be deployed. |
1414
|
|
|
|
|
|
|
|
1415
|
|
|
|
|
|
|
=item * A tag. |
1416
|
|
|
|
|
|
|
|
1417
|
|
|
|
|
|
|
A named deployment tag, generally corresponding to a release name. Begins with |
1418
|
|
|
|
|
|
|
a C<@>, followed by one or more non-blanks characters, excluding "@", ":", |
1419
|
|
|
|
|
|
|
"#", and blanks. The first and last characters must not be punctuation |
1420
|
|
|
|
|
|
|
characters. |
1421
|
|
|
|
|
|
|
|
1422
|
|
|
|
|
|
|
=item * A note. |
1423
|
|
|
|
|
|
|
|
1424
|
|
|
|
|
|
|
Begins with a C<#> and goes to the end of the line. Preceding white space is |
1425
|
|
|
|
|
|
|
ignored. May appear on a line after a pragma, change, or tag. |
1426
|
|
|
|
|
|
|
|
1427
|
|
|
|
|
|
|
=back |
1428
|
|
|
|
|
|
|
|
1429
|
|
|
|
|
|
|
Here's an example of a plan file with a single deploy change and tag: |
1430
|
|
|
|
|
|
|
|
1431
|
|
|
|
|
|
|
%syntax-version=1.0.0 |
1432
|
|
|
|
|
|
|
+users_table |
1433
|
|
|
|
|
|
|
@alpha |
1434
|
|
|
|
|
|
|
|
1435
|
|
|
|
|
|
|
There may, of course, be any number of tags and changes. Here's an expansion: |
1436
|
|
|
|
|
|
|
|
1437
|
|
|
|
|
|
|
%syntax-version=1.0.0 |
1438
|
|
|
|
|
|
|
+users_table |
1439
|
|
|
|
|
|
|
+insert_user |
1440
|
|
|
|
|
|
|
+update_user |
1441
|
|
|
|
|
|
|
+delete_user |
1442
|
|
|
|
|
|
|
@root |
1443
|
|
|
|
|
|
|
@alpha |
1444
|
|
|
|
|
|
|
|
1445
|
|
|
|
|
|
|
Here we have four changes -- "users_table", "insert_user", "update_user", and |
1446
|
|
|
|
|
|
|
"delete_user" -- followed by two tags: "@root" and "@alpha". |
1447
|
|
|
|
|
|
|
|
1448
|
|
|
|
|
|
|
Most plans will have many changes and tags. Here's a longer example with three |
1449
|
|
|
|
|
|
|
tagged deployment points, as well as a change that is deployed and later |
1450
|
|
|
|
|
|
|
reverted: |
1451
|
|
|
|
|
|
|
|
1452
|
|
|
|
|
|
|
%syntax-version=1.0.0 |
1453
|
|
|
|
|
|
|
+users_table |
1454
|
|
|
|
|
|
|
+insert_user |
1455
|
|
|
|
|
|
|
+update_user |
1456
|
|
|
|
|
|
|
+delete_user |
1457
|
|
|
|
|
|
|
+dr_evil |
1458
|
|
|
|
|
|
|
@root |
1459
|
|
|
|
|
|
|
@alpha |
1460
|
|
|
|
|
|
|
|
1461
|
|
|
|
|
|
|
+widgets_table |
1462
|
|
|
|
|
|
|
+list_widgets |
1463
|
|
|
|
|
|
|
@beta |
1464
|
|
|
|
|
|
|
|
1465
|
|
|
|
|
|
|
-dr_evil |
1466
|
|
|
|
|
|
|
+ftw |
1467
|
|
|
|
|
|
|
@gamma |
1468
|
|
|
|
|
|
|
|
1469
|
|
|
|
|
|
|
Using this plan, to deploy to the "beta" tag, all of the changes up to the |
1470
|
|
|
|
|
|
|
"@root" and "@alpha" tags must be deployed, as must changes listed before the |
1471
|
|
|
|
|
|
|
"@beta" tag. To then deploy to the "@gamma" tag, the "dr_evil" change must be |
1472
|
|
|
|
|
|
|
reverted and the "ftw" change must be deployed. If you then choose to revert |
1473
|
|
|
|
|
|
|
to "@alpha", then the "ftw" change will be reverted, the "dr_evil" change |
1474
|
|
|
|
|
|
|
re-deployed, and the "@gamma" tag removed; then "list_widgets" must be |
1475
|
|
|
|
|
|
|
reverted and the associated "@beta" tag removed, then the "widgets_table" |
1476
|
|
|
|
|
|
|
change must be reverted. |
1477
|
|
|
|
|
|
|
|
1478
|
|
|
|
|
|
|
Changes can only be repeated if one or more tags intervene. This allows Sqitch |
1479
|
|
|
|
|
|
|
to distinguish between them. An example: |
1480
|
|
|
|
|
|
|
|
1481
|
|
|
|
|
|
|
%syntax-version=1.0.0 |
1482
|
|
|
|
|
|
|
+users_table |
1483
|
|
|
|
|
|
|
@alpha |
1484
|
|
|
|
|
|
|
|
1485
|
|
|
|
|
|
|
+add_widget |
1486
|
|
|
|
|
|
|
+widgets_table |
1487
|
|
|
|
|
|
|
@beta |
1488
|
|
|
|
|
|
|
|
1489
|
|
|
|
|
|
|
+add_user |
1490
|
|
|
|
|
|
|
@gamma |
1491
|
|
|
|
|
|
|
|
1492
|
|
|
|
|
|
|
+widgets_created_at |
1493
|
|
|
|
|
|
|
@delta |
1494
|
|
|
|
|
|
|
|
1495
|
|
|
|
|
|
|
+add_widget |
1496
|
|
|
|
|
|
|
|
1497
|
|
|
|
|
|
|
Note that the "add_widget" change is repeated after the "@beta" tag, and at |
1498
|
|
|
|
|
|
|
the end. Sqitch will notice the repetition when it parses this file, and allow |
1499
|
|
|
|
|
|
|
it, because at least one tag "@beta" appears between the instances of |
1500
|
|
|
|
|
|
|
"add_widget". When deploying, Sqitch will fetch the instance of the deploy |
1501
|
|
|
|
|
|
|
script as of the "@delta" tag and apply it as the first change, and then, when |
1502
|
|
|
|
|
|
|
it gets to the last change, retrieve the current instance of the deploy |
1503
|
|
|
|
|
|
|
script. How does it find such files? The first instances files will either be |
1504
|
|
|
|
|
|
|
named F<add_widget@delta.sql> or (soon) findable in the VCS history as of a |
1505
|
|
|
|
|
|
|
VCS "delta" tag. |
1506
|
|
|
|
|
|
|
|
1507
|
|
|
|
|
|
|
=head2 Grammar |
1508
|
|
|
|
|
|
|
|
1509
|
|
|
|
|
|
|
Here is the EBNF Grammar for the plan file: |
1510
|
|
|
|
|
|
|
|
1511
|
|
|
|
|
|
|
plan-file = { <pragma> | <change-line> | <tag-line> | <note-line> | <blank-line> }* ; |
1512
|
|
|
|
|
|
|
|
1513
|
|
|
|
|
|
|
blank-line = [ <blanks> ] <eol>; |
1514
|
|
|
|
|
|
|
note-line = <note> ; |
1515
|
|
|
|
|
|
|
change-line = <name> [ "[" { <requires> | <conflicts> } "]" ] ( <eol> | <note> ) ; |
1516
|
|
|
|
|
|
|
tag-line = <tag> ( <eol> | <note> ) ; |
1517
|
|
|
|
|
|
|
pragma = "%" [ <blanks> ] <name> [ <blanks> ] = [ <blanks> ] <value> ( <eol> | <note> ) ; |
1518
|
|
|
|
|
|
|
|
1519
|
|
|
|
|
|
|
tag = "@" <name> ; |
1520
|
|
|
|
|
|
|
requires = <name> ; |
1521
|
|
|
|
|
|
|
conflicts = "!" <name> ; |
1522
|
|
|
|
|
|
|
name = <non-punct> [ [ ? non-blank and not "@", ":", or "#" characters ? ] <non-punct> ] ; |
1523
|
|
|
|
|
|
|
non-punct = ? non-punctuation, non-blank character ? ; |
1524
|
|
|
|
|
|
|
value = ? non-EOL or "#" characters ? |
1525
|
|
|
|
|
|
|
|
1526
|
|
|
|
|
|
|
note = [ <blanks> ] "#" [ <string> ] <EOL> ; |
1527
|
|
|
|
|
|
|
eol = [ <blanks> ] <EOL> ; |
1528
|
|
|
|
|
|
|
|
1529
|
|
|
|
|
|
|
blanks = ? blank characters ? ; |
1530
|
|
|
|
|
|
|
string = ? non-EOL characters ? ; |
1531
|
|
|
|
|
|
|
|
1532
|
|
|
|
|
|
|
And written as regular expressions: |
1533
|
|
|
|
|
|
|
|
1534
|
|
|
|
|
|
|
my $eol = qr/[[:blank:]]*$/ |
1535
|
|
|
|
|
|
|
my $note = qr/(?:[[:blank:]]+)?[#].+$/; |
1536
|
|
|
|
|
|
|
my $punct = q{-!"#$%&'()*+,./:;<=>?@[\\]^`{|}~}; |
1537
|
|
|
|
|
|
|
my $name = qr/[^$punct[:blank:]](?:(?:[^[:space:]:#@]+)?[^$punct[:blank:]])?/; |
1538
|
|
|
|
|
|
|
my $tag = qr/[@]$name/; |
1539
|
|
|
|
|
|
|
my $requires = qr/$name/; |
1540
|
|
|
|
|
|
|
my conflicts = qr/[!]$name/; |
1541
|
|
|
|
|
|
|
my $tag_line = qr/^$tag(?:$note|$eol)/; |
1542
|
|
|
|
|
|
|
my $change_line = qr/^$name(?:[[](?:$requires|$conflicts)+[]])?(?:$note|$eol)/; |
1543
|
|
|
|
|
|
|
my $note_line = qr/^$note/; |
1544
|
|
|
|
|
|
|
my $pragma = qr/^][[:blank:]]*[%][[:blank:]]*$name[[:blank:]]*=[[:blank:]].+?(?:$note|$eol)$/; |
1545
|
|
|
|
|
|
|
my $blank_line = qr/^$eol/; |
1546
|
|
|
|
|
|
|
my $plan = qr/(?:$pragma|$change_line|$tag_line|$note_line|$blank_line)+/ms; |
1547
|
|
|
|
|
|
|
|
1548
|
|
|
|
|
|
|
=head1 See Also |
1549
|
|
|
|
|
|
|
|
1550
|
|
|
|
|
|
|
=over |
1551
|
|
|
|
|
|
|
|
1552
|
|
|
|
|
|
|
=item L<sqitch> |
1553
|
|
|
|
|
|
|
|
1554
|
|
|
|
|
|
|
The Sqitch command-line client. |
1555
|
|
|
|
|
|
|
|
1556
|
|
|
|
|
|
|
=back |
1557
|
|
|
|
|
|
|
|
1558
|
|
|
|
|
|
|
=head1 Author |
1559
|
|
|
|
|
|
|
|
1560
|
|
|
|
|
|
|
David E. Wheeler <david@justatheory.com> |
1561
|
|
|
|
|
|
|
|
1562
|
|
|
|
|
|
|
=head1 License |
1563
|
|
|
|
|
|
|
|
1564
|
|
|
|
|
|
|
Copyright (c) 2012-2022 iovation Inc., David E. Wheeler |
1565
|
|
|
|
|
|
|
|
1566
|
|
|
|
|
|
|
Permission is hereby granted, free of charge, to any person obtaining a copy |
1567
|
|
|
|
|
|
|
of this software and associated documentation files (the "Software"), to deal |
1568
|
|
|
|
|
|
|
in the Software without restriction, including without limitation the rights |
1569
|
|
|
|
|
|
|
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell |
1570
|
|
|
|
|
|
|
copies of the Software, and to permit persons to whom the Software is |
1571
|
|
|
|
|
|
|
furnished to do so, subject to the following conditions: |
1572
|
|
|
|
|
|
|
|
1573
|
|
|
|
|
|
|
The above copyright notice and this permission notice shall be included in all |
1574
|
|
|
|
|
|
|
copies or substantial portions of the Software. |
1575
|
|
|
|
|
|
|
|
1576
|
|
|
|
|
|
|
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR |
1577
|
|
|
|
|
|
|
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, |
1578
|
|
|
|
|
|
|
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE |
1579
|
|
|
|
|
|
|
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER |
1580
|
|
|
|
|
|
|
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, |
1581
|
|
|
|
|
|
|
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE |
1582
|
|
|
|
|
|
|
SOFTWARE. |
1583
|
|
|
|
|
|
|
|
1584
|
|
|
|
|
|
|
=cut |