line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package App::Sqitch::Role::DBIEngine; |
2
|
|
|
|
|
|
|
|
3
|
29
|
|
|
29
|
|
145846
|
use 5.010; |
|
29
|
|
|
|
|
156
|
|
4
|
29
|
|
|
29
|
|
199
|
use strict; |
|
29
|
|
|
|
|
79
|
|
|
29
|
|
|
|
|
794
|
|
5
|
29
|
|
|
29
|
|
220
|
use warnings; |
|
29
|
|
|
|
|
122
|
|
|
29
|
|
|
|
|
1055
|
|
6
|
29
|
|
|
29
|
|
221
|
use utf8; |
|
29
|
|
|
|
|
87
|
|
|
29
|
|
|
|
|
247
|
|
7
|
29
|
|
|
29
|
|
27668
|
use DBI 1.631; |
|
29
|
|
|
|
|
282746
|
|
|
29
|
|
|
|
|
1749
|
|
8
|
29
|
|
|
29
|
|
1039
|
use Moo::Role; |
|
29
|
|
|
|
|
19106
|
|
|
29
|
|
|
|
|
298
|
|
9
|
29
|
|
|
29
|
|
14499
|
use Try::Tiny; |
|
29
|
|
|
|
|
1545
|
|
|
29
|
|
|
|
|
1953
|
|
10
|
29
|
|
|
29
|
|
730
|
use App::Sqitch::X qw(hurl); |
|
29
|
|
|
|
|
99
|
|
|
29
|
|
|
|
|
315
|
|
11
|
29
|
|
|
29
|
|
12263
|
use Locale::TextDomain qw(App-Sqitch); |
|
29
|
|
|
|
|
19545
|
|
|
29
|
|
|
|
|
305
|
|
12
|
29
|
|
|
29
|
|
26424
|
use namespace::autoclean; |
|
29
|
|
|
|
|
12804
|
|
|
29
|
|
|
|
|
317
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
our $VERSION = 'v1.4.0'; # VERSION |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
requires 'dbh'; |
17
|
|
|
|
|
|
|
requires 'sqitch'; |
18
|
|
|
|
|
|
|
requires 'plan'; |
19
|
|
|
|
|
|
|
requires '_regex_op'; |
20
|
|
|
|
|
|
|
requires '_ts2char_format'; |
21
|
|
|
|
|
|
|
requires '_char2ts'; |
22
|
|
|
|
|
|
|
requires '_listagg_format'; |
23
|
|
|
|
|
|
|
requires '_no_table_error'; |
24
|
|
|
|
|
|
|
requires '_unique_error'; |
25
|
|
|
|
|
|
|
requires '_handle_lookup_index'; |
26
|
|
|
|
|
|
|
requires '_no_registry'; |
27
|
|
|
|
|
|
|
requires 'initialized'; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# Called on connect if the registry schema does not exist. |
30
|
|
|
|
|
|
|
sub _handle_no_registry { |
31
|
0
|
|
|
0
|
|
0
|
my ($self, $dbh) = @_; |
32
|
|
|
|
|
|
|
# https://www.nntp.perl.org/group/perl.dbi.dev/2013/11/msg7622.html |
33
|
0
|
|
|
|
|
0
|
$dbh->set_err(undef, undef); |
34
|
0
|
|
|
|
|
0
|
$self->_no_registry(1); |
35
|
0
|
|
|
|
|
0
|
return; |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
after use_driver => sub { |
39
|
|
|
|
|
|
|
DBI->trace(1) if $_[0]->sqitch->verbosity > 2; |
40
|
|
|
|
|
|
|
}; |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
sub _dt($) { |
43
|
2
|
|
|
2
|
|
2005
|
require App::Sqitch::DateTime; |
44
|
2
|
|
|
|
|
38
|
return App::Sqitch::DateTime->new(split /:/ => shift); |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub _log_tags_param { |
48
|
0
|
|
|
0
|
|
0
|
join ' ' => map { $_->format_name } $_[1]->tags; |
|
0
|
|
|
|
|
0
|
|
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub _log_requires_param { |
52
|
0
|
|
|
0
|
|
0
|
join ',' => map { $_->as_string } $_[1]->requires; |
|
0
|
|
|
|
|
0
|
|
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
sub _log_conflicts_param { |
56
|
0
|
|
|
0
|
|
0
|
join ',' => map { $_->as_string } $_[1]->conflicts; |
|
0
|
|
|
|
|
0
|
|
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
1
|
|
|
1
|
|
1932
|
sub _ts_default { 'DEFAULT' } |
60
|
|
|
|
|
|
|
|
61
|
0
|
|
|
0
|
|
0
|
sub _can_limit { 1 } |
62
|
1
|
|
|
1
|
|
8
|
sub _limit_default { undef } |
63
|
|
|
|
|
|
|
|
64
|
1
|
|
|
1
|
|
8
|
sub _simple_from { '' } |
65
|
|
|
|
|
|
|
|
66
|
0
|
|
|
0
|
|
0
|
sub _quote_idents { shift; @_ } |
|
0
|
|
|
|
|
0
|
|
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
sub _in_expr { |
69
|
0
|
|
|
0
|
|
0
|
my ($self, $vals) = @_; |
70
|
0
|
|
|
|
|
0
|
my $in = sprintf 'IN (%s)', join ', ', ('?') x @{ $vals }; |
|
0
|
|
|
|
|
0
|
|
71
|
0
|
|
|
|
|
0
|
return $in, @{ $vals }; |
|
0
|
|
|
|
|
0
|
|
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
sub _register_release { |
75
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
76
|
0
|
|
0
|
|
|
0
|
my $version = shift || $self->registry_release; |
77
|
0
|
|
|
|
|
0
|
my $sqitch = $self->sqitch; |
78
|
0
|
|
|
|
|
0
|
my $ts = $self->_ts_default; |
79
|
|
|
|
|
|
|
|
80
|
0
|
|
|
|
|
0
|
$self->begin_work; |
81
|
0
|
|
|
|
|
0
|
$self->dbh->do(qq{ |
82
|
|
|
|
|
|
|
INSERT INTO releases (version, installed_at, installer_name, installer_email) |
83
|
|
|
|
|
|
|
VALUES (?, $ts, ?, ?) |
84
|
|
|
|
|
|
|
}, undef, $version, $sqitch->user_name, $sqitch->user_email); |
85
|
0
|
|
|
|
|
0
|
$self->finish_work; |
86
|
0
|
|
|
|
|
0
|
return $self; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
0
|
|
|
0
|
|
0
|
sub _version_query { 'SELECT MAX(version) FROM releases' } |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
sub registry_version { |
92
|
2
|
|
|
2
|
1
|
1018
|
my $self = shift; |
93
|
|
|
|
|
|
|
try { |
94
|
2
|
|
|
2
|
|
266
|
$self->dbh->selectcol_arrayref($self->_version_query)->[0]; |
95
|
|
|
|
|
|
|
} catch { |
96
|
2
|
100
|
|
2
|
|
57
|
return 0 if $self->_no_table_error; |
97
|
1
|
|
|
|
|
12
|
die $_; |
98
|
2
|
|
|
|
|
16
|
}; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
sub _cid { |
102
|
2
|
|
|
2
|
|
49
|
my ( $self, $ord, $offset, $project ) = @_; |
103
|
|
|
|
|
|
|
return try { |
104
|
2
|
|
0
|
2
|
|
167
|
$self->dbh->selectcol_arrayref(qq{ |
105
|
|
|
|
|
|
|
SELECT change_id |
106
|
|
|
|
|
|
|
FROM changes |
107
|
|
|
|
|
|
|
WHERE project = ? |
108
|
|
|
|
|
|
|
ORDER BY committed_at $ord |
109
|
|
|
|
|
|
|
LIMIT 1 |
110
|
|
|
|
|
|
|
OFFSET COALESCE(?, 0) |
111
|
|
|
|
|
|
|
}, undef, $project || $self->plan->project, $offset)->[0]; |
112
|
|
|
|
|
|
|
} catch { |
113
|
2
|
100
|
66
|
2
|
|
39
|
return if $self->_no_table_error && !$self->initialized; |
114
|
1
|
|
|
|
|
11
|
die $_; |
115
|
2
|
|
|
|
|
16
|
}; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub earliest_change_id { |
119
|
0
|
|
|
0
|
1
|
0
|
shift->_cid('ASC', @_); |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
sub latest_change_id { |
123
|
0
|
|
|
0
|
1
|
0
|
shift->_cid('DESC', @_); |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
sub _select_state { |
127
|
0
|
|
|
0
|
|
0
|
my ( $self, $project, $with_hash ) = @_; |
128
|
0
|
|
|
|
|
0
|
my $cdtcol = sprintf $self->_ts2char_format, 'c.committed_at'; |
129
|
0
|
|
|
|
|
0
|
my $pdtcol = sprintf $self->_ts2char_format, 'c.planned_at'; |
130
|
0
|
|
|
|
|
0
|
my $tagcol = sprintf $self->_listagg_format, 't.tag'; |
131
|
0
|
0
|
|
|
|
0
|
my $hshcol = $with_hash ? "c.script_hash\n , " : ''; |
132
|
0
|
|
|
|
|
0
|
my $dbh = $self->dbh; |
133
|
0
|
|
0
|
|
|
0
|
$dbh->selectrow_hashref(qq{ |
134
|
|
|
|
|
|
|
SELECT c.change_id |
135
|
|
|
|
|
|
|
, ${hshcol}c.change |
136
|
|
|
|
|
|
|
, c.project |
137
|
|
|
|
|
|
|
, c.note |
138
|
|
|
|
|
|
|
, c.committer_name |
139
|
|
|
|
|
|
|
, c.committer_email |
140
|
|
|
|
|
|
|
, $cdtcol AS committed_at |
141
|
|
|
|
|
|
|
, c.planner_name |
142
|
|
|
|
|
|
|
, c.planner_email |
143
|
|
|
|
|
|
|
, $pdtcol AS planned_at |
144
|
|
|
|
|
|
|
, $tagcol AS tags |
145
|
|
|
|
|
|
|
FROM changes c |
146
|
|
|
|
|
|
|
LEFT JOIN tags t ON c.change_id = t.change_id |
147
|
|
|
|
|
|
|
WHERE c.project = ? |
148
|
|
|
|
|
|
|
GROUP BY c.change_id |
149
|
|
|
|
|
|
|
, ${hshcol}c.change |
150
|
|
|
|
|
|
|
, c.project |
151
|
|
|
|
|
|
|
, c.note |
152
|
|
|
|
|
|
|
, c.committer_name |
153
|
|
|
|
|
|
|
, c.committer_email |
154
|
|
|
|
|
|
|
, c.committed_at |
155
|
|
|
|
|
|
|
, c.planner_name |
156
|
|
|
|
|
|
|
, c.planner_email |
157
|
|
|
|
|
|
|
, c.planned_at |
158
|
|
|
|
|
|
|
ORDER BY c.committed_at DESC |
159
|
|
|
|
|
|
|
LIMIT 1 |
160
|
|
|
|
|
|
|
}, undef, $project // $self->plan->project ); |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
sub current_state { |
164
|
3
|
|
|
3
|
1
|
89
|
my ( $self, $project ) = @_; |
165
|
|
|
|
|
|
|
my $state = try { |
166
|
3
|
|
|
3
|
|
274
|
$self->_select_state($project, 1) |
167
|
|
|
|
|
|
|
} catch { |
168
|
3
|
100
|
100
|
3
|
|
68
|
return if $self->_no_table_error && !$self->initialized; |
169
|
2
|
100
|
|
|
|
16
|
return $self->_select_state($project, 0) if $self->_no_column_error; |
170
|
1
|
|
|
|
|
11
|
die $_; |
171
|
3
|
50
|
|
|
|
21
|
} or return undef; |
172
|
|
|
|
|
|
|
|
173
|
0
|
0
|
|
|
|
0
|
unless (ref $state->{tags}) { |
174
|
0
|
0
|
|
|
|
0
|
$state->{tags} = $state->{tags} ? [ split / / => $state->{tags} ] : []; |
175
|
|
|
|
|
|
|
} |
176
|
0
|
|
|
|
|
0
|
$state->{committed_at} = _dt $state->{committed_at}; |
177
|
0
|
|
|
|
|
0
|
$state->{planned_at} = _dt $state->{planned_at}; |
178
|
0
|
|
|
|
|
0
|
return $state; |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
sub current_changes { |
182
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $project ) = @_; |
183
|
0
|
|
|
|
|
0
|
my $cdtcol = sprintf $self->_ts2char_format, 'c.committed_at'; |
184
|
0
|
|
|
|
|
0
|
my $pdtcol = sprintf $self->_ts2char_format, 'c.planned_at'; |
185
|
0
|
|
|
|
|
0
|
my $sth = $self->dbh->prepare(qq{ |
186
|
|
|
|
|
|
|
SELECT c.change_id |
187
|
|
|
|
|
|
|
, c.script_hash |
188
|
|
|
|
|
|
|
, c.change |
189
|
|
|
|
|
|
|
, c.committer_name |
190
|
|
|
|
|
|
|
, c.committer_email |
191
|
|
|
|
|
|
|
, $cdtcol AS committed_at |
192
|
|
|
|
|
|
|
, c.planner_name |
193
|
|
|
|
|
|
|
, c.planner_email |
194
|
|
|
|
|
|
|
, $pdtcol AS planned_at |
195
|
|
|
|
|
|
|
FROM changes c |
196
|
|
|
|
|
|
|
WHERE project = ? |
197
|
|
|
|
|
|
|
ORDER BY c.committed_at DESC |
198
|
|
|
|
|
|
|
}); |
199
|
0
|
|
0
|
|
|
0
|
$sth->execute($project // $self->plan->project); |
200
|
|
|
|
|
|
|
return sub { |
201
|
0
|
0
|
|
0
|
|
0
|
my $row = $sth->fetchrow_hashref or return; |
202
|
0
|
|
|
|
|
0
|
$row->{committed_at} = _dt $row->{committed_at}; |
203
|
0
|
|
|
|
|
0
|
$row->{planned_at} = _dt $row->{planned_at}; |
204
|
0
|
|
|
|
|
0
|
return $row; |
205
|
0
|
|
|
|
|
0
|
}; |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
sub current_tags { |
209
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $project ) = @_; |
210
|
0
|
|
|
|
|
0
|
my $cdtcol = sprintf $self->_ts2char_format, 'committed_at'; |
211
|
0
|
|
|
|
|
0
|
my $pdtcol = sprintf $self->_ts2char_format, 'planned_at'; |
212
|
0
|
|
|
|
|
0
|
my $sth = $self->dbh->prepare(qq{ |
213
|
|
|
|
|
|
|
SELECT tag_id |
214
|
|
|
|
|
|
|
, tag |
215
|
|
|
|
|
|
|
, committer_name |
216
|
|
|
|
|
|
|
, committer_email |
217
|
|
|
|
|
|
|
, $cdtcol AS committed_at |
218
|
|
|
|
|
|
|
, planner_name |
219
|
|
|
|
|
|
|
, planner_email |
220
|
|
|
|
|
|
|
, $pdtcol AS planned_at |
221
|
|
|
|
|
|
|
FROM tags |
222
|
|
|
|
|
|
|
WHERE project = ? |
223
|
|
|
|
|
|
|
ORDER BY tags.committed_at DESC |
224
|
|
|
|
|
|
|
}); |
225
|
0
|
|
0
|
|
|
0
|
$sth->execute($project // $self->plan->project); |
226
|
|
|
|
|
|
|
return sub { |
227
|
0
|
0
|
|
0
|
|
0
|
my $row = $sth->fetchrow_hashref or return; |
228
|
0
|
|
|
|
|
0
|
$row->{committed_at} = _dt $row->{committed_at}; |
229
|
0
|
|
|
|
|
0
|
$row->{planned_at} = _dt $row->{planned_at}; |
230
|
0
|
|
|
|
|
0
|
return $row; |
231
|
0
|
|
|
|
|
0
|
}; |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
sub search_events { |
235
|
0
|
|
|
0
|
1
|
0
|
my ( $self, %p ) = @_; |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
# Determine order direction. |
238
|
0
|
|
|
|
|
0
|
my $dir = 'DESC'; |
239
|
0
|
0
|
|
|
|
0
|
if (my $d = delete $p{direction}) { |
240
|
0
|
0
|
|
|
|
0
|
$dir = $d =~ /^ASC/i ? 'ASC' |
|
|
0
|
|
|
|
|
|
241
|
|
|
|
|
|
|
: $d =~ /^DESC/i ? 'DESC' |
242
|
|
|
|
|
|
|
: hurl 'Search direction must be either "ASC" or "DESC"'; |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
# Limit with regular expressions? |
246
|
0
|
|
|
|
|
0
|
my (@wheres, @params); |
247
|
0
|
|
|
|
|
0
|
for my $spec ( |
248
|
|
|
|
|
|
|
[ committer => 'e.committer_name' ], |
249
|
|
|
|
|
|
|
[ planner => 'e.planner_name' ], |
250
|
|
|
|
|
|
|
[ change => 'e.change' ], |
251
|
|
|
|
|
|
|
[ project => 'e.project' ], |
252
|
|
|
|
|
|
|
) { |
253
|
0
|
|
0
|
|
|
0
|
my $regex = delete $p{ $spec->[0] } // next; |
254
|
0
|
|
|
|
|
0
|
my ($op, $expr) = $self->_regex_expr($spec->[1], $regex); |
255
|
0
|
|
|
|
|
0
|
push @wheres => $op; |
256
|
0
|
|
|
|
|
0
|
push @params => $expr; |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
# Match events? |
260
|
0
|
0
|
|
|
|
0
|
if (my $e = delete $p{event} ) { |
261
|
0
|
|
|
|
|
0
|
my ($in, @vals) = $self->_in_expr( $e ); |
262
|
0
|
|
|
|
|
0
|
push @wheres => "e.event $in"; |
263
|
0
|
|
|
|
|
0
|
push @params => @vals; |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
# Assemble the where clause. |
267
|
0
|
0
|
|
|
|
0
|
my $where = @wheres |
268
|
|
|
|
|
|
|
? "\n WHERE " . join( "\n ", @wheres ) |
269
|
|
|
|
|
|
|
: ''; |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
# Handle remaining parameters. |
272
|
0
|
|
|
|
|
0
|
my $limits = ''; |
273
|
0
|
0
|
0
|
|
|
0
|
if (exists $p{limit} || exists $p{offset}) { |
274
|
0
|
|
|
|
|
0
|
my ($exprs, $values) = $self->_limit_offset(delete $p{limit}, delete $p{offset}); |
275
|
0
|
0
|
|
|
|
0
|
if (@{ $exprs}) { |
|
0
|
|
|
|
|
0
|
|
276
|
0
|
|
|
|
|
0
|
$limits = join "\n ", '', @{ $exprs }; |
|
0
|
|
|
|
|
0
|
|
277
|
0
|
0
|
|
|
|
0
|
push @params => @{ $values || [] }; |
|
0
|
|
|
|
|
0
|
|
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
|
281
|
0
|
0
|
|
|
|
0
|
hurl 'Invalid parameters passed to search_events(): ' |
282
|
|
|
|
|
|
|
. join ', ', sort keys %p if %p; |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
# Prepare, execute, and return. |
285
|
0
|
|
|
|
|
0
|
my $cdtcol = sprintf $self->_ts2char_format, 'e.committed_at'; |
286
|
0
|
|
|
|
|
0
|
my $pdtcol = sprintf $self->_ts2char_format, 'e.planned_at'; |
287
|
0
|
|
|
|
|
0
|
my $sth = $self->dbh->prepare(qq{ |
288
|
|
|
|
|
|
|
SELECT e.event |
289
|
|
|
|
|
|
|
, e.project |
290
|
|
|
|
|
|
|
, e.change_id |
291
|
|
|
|
|
|
|
, e.change |
292
|
|
|
|
|
|
|
, e.note |
293
|
|
|
|
|
|
|
, e.requires |
294
|
|
|
|
|
|
|
, e.conflicts |
295
|
|
|
|
|
|
|
, e.tags |
296
|
|
|
|
|
|
|
, e.committer_name |
297
|
|
|
|
|
|
|
, e.committer_email |
298
|
|
|
|
|
|
|
, $cdtcol AS committed_at |
299
|
|
|
|
|
|
|
, e.planner_name |
300
|
|
|
|
|
|
|
, e.planner_email |
301
|
|
|
|
|
|
|
, $pdtcol AS planned_at |
302
|
|
|
|
|
|
|
FROM events e$where |
303
|
|
|
|
|
|
|
ORDER BY e.committed_at $dir$limits |
304
|
|
|
|
|
|
|
}); |
305
|
|
|
|
|
|
|
|
306
|
0
|
|
|
|
|
0
|
$sth->execute(@params); |
307
|
|
|
|
|
|
|
return sub { |
308
|
0
|
0
|
|
0
|
|
0
|
my $row = $sth->fetchrow_hashref or return; |
309
|
0
|
|
|
|
|
0
|
$row->{committed_at} = _dt $row->{committed_at}; |
310
|
0
|
|
|
|
|
0
|
$row->{planned_at} = _dt $row->{planned_at}; |
311
|
0
|
|
|
|
|
0
|
return $row; |
312
|
0
|
|
|
|
|
0
|
}; |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
sub _regex_expr { |
316
|
1
|
|
|
1
|
|
10
|
my ( $self, $col, $regex ) = @_; |
317
|
1
|
|
|
|
|
7
|
my $op = $self->_regex_op; |
318
|
1
|
|
|
|
|
11
|
return "$col $op ?", $regex; |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
sub _limit_offset { |
322
|
6
|
|
|
6
|
|
329
|
my ($self, $lim, $off) = @_; |
323
|
6
|
|
|
|
|
14
|
my (@limits, @params); |
324
|
|
|
|
|
|
|
|
325
|
6
|
100
|
|
|
|
16
|
if ($lim) { |
326
|
3
|
|
|
|
|
11
|
push @limits => 'LIMIT ?'; |
327
|
3
|
|
|
|
|
7
|
push @params => $lim; |
328
|
|
|
|
|
|
|
} |
329
|
6
|
100
|
|
|
|
14
|
if ($off) { |
330
|
2
|
100
|
66
|
|
|
12
|
if (!$lim && ($lim = $self->_limit_default)) { |
331
|
|
|
|
|
|
|
# Some drivers require LIMIT when OFFSET is set. |
332
|
1
|
|
|
|
|
12
|
push @limits => 'LIMIT ?'; |
333
|
1
|
|
|
|
|
7
|
push @params => $lim; |
334
|
|
|
|
|
|
|
} |
335
|
2
|
|
|
|
|
10
|
push @limits => 'OFFSET ?'; |
336
|
2
|
|
|
|
|
6
|
push @params => $off; |
337
|
|
|
|
|
|
|
} |
338
|
6
|
|
|
|
|
55
|
return \@limits, \@params; |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
sub registered_projects { |
342
|
0
|
|
|
0
|
1
|
0
|
return @{ shift->dbh->selectcol_arrayref( |
343
|
0
|
|
|
|
|
0
|
'SELECT project FROM projects ORDER BY project' |
344
|
|
|
|
|
|
|
) }; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
sub register_project { |
348
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
349
|
0
|
|
|
|
|
0
|
my $sqitch = $self->sqitch; |
350
|
0
|
|
|
|
|
0
|
my $dbh = $self->dbh; |
351
|
0
|
|
|
|
|
0
|
my $plan = $self->plan; |
352
|
0
|
|
|
|
|
0
|
my $proj = $plan->project; |
353
|
0
|
|
|
|
|
0
|
my $uri = $plan->uri; |
354
|
|
|
|
|
|
|
|
355
|
0
|
|
|
|
|
0
|
my $res = $dbh->selectcol_arrayref( |
356
|
|
|
|
|
|
|
'SELECT uri FROM projects WHERE project = ?', |
357
|
|
|
|
|
|
|
undef, $proj |
358
|
|
|
|
|
|
|
); |
359
|
|
|
|
|
|
|
|
360
|
0
|
0
|
|
|
|
0
|
if (@{ $res }) { |
|
0
|
|
|
|
|
0
|
|
361
|
|
|
|
|
|
|
# A project with that name is already registered. Compare URIs. |
362
|
0
|
|
|
|
|
0
|
my $reg_uri = $res->[0]; |
363
|
0
|
0
|
0
|
|
|
0
|
if ( defined $uri && !defined $reg_uri ) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
364
|
0
|
|
|
|
|
0
|
hurl engine => __x( |
365
|
|
|
|
|
|
|
'Cannot register "{project}" with URI {uri}: already exists with NULL URI', |
366
|
|
|
|
|
|
|
project => $proj, |
367
|
|
|
|
|
|
|
uri => $uri |
368
|
|
|
|
|
|
|
); |
369
|
|
|
|
|
|
|
} elsif ( !defined $uri && defined $reg_uri ) { |
370
|
0
|
|
|
|
|
0
|
hurl engine => __x( |
371
|
|
|
|
|
|
|
'Cannot register "{project}" without URI: already exists with URI {uri}', |
372
|
|
|
|
|
|
|
project => $proj, |
373
|
|
|
|
|
|
|
uri => $reg_uri |
374
|
|
|
|
|
|
|
); |
375
|
|
|
|
|
|
|
} elsif ( defined $uri && defined $reg_uri ) { |
376
|
0
|
0
|
|
|
|
0
|
hurl engine => __x( |
377
|
|
|
|
|
|
|
'Cannot register "{project}" with URI {uri}: already exists with URI {reg_uri}', |
378
|
|
|
|
|
|
|
project => $proj, |
379
|
|
|
|
|
|
|
uri => $uri, |
380
|
|
|
|
|
|
|
reg_uri => $reg_uri, |
381
|
|
|
|
|
|
|
) if $uri ne $reg_uri; |
382
|
|
|
|
|
|
|
} else { |
383
|
|
|
|
|
|
|
# Both are undef, so cool. |
384
|
|
|
|
|
|
|
} |
385
|
|
|
|
|
|
|
} else { |
386
|
|
|
|
|
|
|
# No project with that name exists. Check to see if the URI does. |
387
|
0
|
0
|
|
|
|
0
|
if (defined $uri) { |
388
|
|
|
|
|
|
|
# Does the URI already exist? |
389
|
0
|
|
|
|
|
0
|
my $res = $dbh->selectcol_arrayref( |
390
|
|
|
|
|
|
|
'SELECT project FROM projects WHERE uri = ?', |
391
|
|
|
|
|
|
|
undef, $uri |
392
|
|
|
|
|
|
|
); |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
hurl engine => __x( |
395
|
|
|
|
|
|
|
'Cannot register "{project}" with URI {uri}: project "{reg_proj}" already using that URI', |
396
|
|
|
|
|
|
|
project => $proj, |
397
|
|
|
|
|
|
|
uri => $uri, |
398
|
|
|
|
|
|
|
reg_proj => $res->[0], |
399
|
0
|
0
|
|
|
|
0
|
) if @{ $res }; |
|
0
|
|
|
|
|
0
|
|
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
# Insert the project. |
403
|
0
|
|
|
|
|
0
|
my $ts = $self->_ts_default; |
404
|
0
|
|
|
|
|
0
|
$dbh->do(qq{ |
405
|
|
|
|
|
|
|
INSERT INTO projects (project, uri, creator_name, creator_email, created_at) |
406
|
|
|
|
|
|
|
VALUES (?, ?, ?, ?, $ts) |
407
|
|
|
|
|
|
|
}, undef, $proj, $uri, $sqitch->user_name, $sqitch->user_email); |
408
|
|
|
|
|
|
|
} |
409
|
|
|
|
|
|
|
|
410
|
0
|
|
|
|
|
0
|
return $self; |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
sub is_deployed_change { |
414
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $change ) = @_; |
415
|
0
|
|
|
|
|
0
|
$self->dbh->selectcol_arrayref(q{ |
416
|
|
|
|
|
|
|
SELECT EXISTS( |
417
|
|
|
|
|
|
|
SELECT 1 |
418
|
|
|
|
|
|
|
FROM changes |
419
|
|
|
|
|
|
|
WHERE change_id = ? |
420
|
|
|
|
|
|
|
) |
421
|
|
|
|
|
|
|
}, undef, $change->id)->[0]; |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
sub are_deployed_changes { |
425
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
426
|
0
|
|
|
|
|
0
|
my $qs = join ', ' => ('?') x @_; |
427
|
0
|
|
|
|
|
0
|
@{ $self->dbh->selectcol_arrayref( |
428
|
|
|
|
|
|
|
"SELECT change_id FROM changes WHERE change_id IN ($qs)", |
429
|
|
|
|
|
|
|
undef, |
430
|
0
|
|
|
|
|
0
|
map { $_->id } @_, |
|
0
|
|
|
|
|
0
|
|
431
|
|
|
|
|
|
|
) }; |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
sub is_deployed_tag { |
435
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $tag ) = @_; |
436
|
0
|
|
|
|
|
0
|
return $self->dbh->selectcol_arrayref(q{ |
437
|
|
|
|
|
|
|
SELECT EXISTS( |
438
|
|
|
|
|
|
|
SELECT 1 |
439
|
|
|
|
|
|
|
FROM tags |
440
|
|
|
|
|
|
|
WHERE tag_id = ? |
441
|
|
|
|
|
|
|
); |
442
|
|
|
|
|
|
|
}, undef, $tag->id)->[0]; |
443
|
|
|
|
|
|
|
} |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
sub _multi_values { |
446
|
0
|
|
|
0
|
|
0
|
my ($self, $count, $expr) = @_; |
447
|
0
|
|
|
|
|
0
|
return 'VALUES ' . join(', ', ("($expr)") x $count) |
448
|
|
|
|
|
|
|
} |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
sub _dependency_placeholders { |
451
|
0
|
|
|
0
|
|
0
|
return '?, ?, ?, ?'; |
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
sub _tag_placeholders { |
455
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
456
|
0
|
|
|
|
|
0
|
return '?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ' . $self->_ts_default; |
457
|
|
|
|
|
|
|
} |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
sub _tag_subselect_columns { |
460
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
461
|
0
|
|
|
|
|
0
|
return join(', ', |
462
|
|
|
|
|
|
|
'? AS tid', |
463
|
|
|
|
|
|
|
'? AS tname', |
464
|
|
|
|
|
|
|
'? AS proj', |
465
|
|
|
|
|
|
|
'? AS cid', |
466
|
|
|
|
|
|
|
'? AS note', |
467
|
|
|
|
|
|
|
'? AS cuser', |
468
|
|
|
|
|
|
|
'? AS cemail', |
469
|
|
|
|
|
|
|
'? AS tts', |
470
|
|
|
|
|
|
|
'? AS puser', |
471
|
|
|
|
|
|
|
'? AS pemail', |
472
|
|
|
|
|
|
|
$self->_ts_default, |
473
|
|
|
|
|
|
|
); |
474
|
|
|
|
|
|
|
} |
475
|
|
|
|
|
|
|
|
476
|
0
|
|
|
0
|
|
0
|
sub _prepare_to_log { $_[0] } |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
sub log_deploy_change { |
479
|
0
|
|
|
0
|
1
|
0
|
my ($self, $change) = @_; |
480
|
0
|
|
|
|
|
0
|
my $dbh = $self->dbh; |
481
|
0
|
|
|
|
|
0
|
my $sqitch = $self->sqitch; |
482
|
|
|
|
|
|
|
|
483
|
0
|
|
|
|
|
0
|
my ($id, $name, $proj, $user, $email) = ( |
484
|
|
|
|
|
|
|
$change->id, |
485
|
|
|
|
|
|
|
$change->format_name, |
486
|
|
|
|
|
|
|
$change->project, |
487
|
|
|
|
|
|
|
$sqitch->user_name, |
488
|
|
|
|
|
|
|
$sqitch->user_email |
489
|
|
|
|
|
|
|
); |
490
|
|
|
|
|
|
|
|
491
|
0
|
|
|
|
|
0
|
my $ts = $self->_ts_default; |
492
|
0
|
|
|
|
|
0
|
my $cols = join "\n , ", $self->_quote_idents(qw( |
493
|
|
|
|
|
|
|
change_id |
494
|
|
|
|
|
|
|
script_hash |
495
|
|
|
|
|
|
|
change |
496
|
|
|
|
|
|
|
project |
497
|
|
|
|
|
|
|
note |
498
|
|
|
|
|
|
|
committer_name |
499
|
|
|
|
|
|
|
committer_email |
500
|
|
|
|
|
|
|
planned_at |
501
|
|
|
|
|
|
|
planner_name |
502
|
|
|
|
|
|
|
planner_email |
503
|
|
|
|
|
|
|
committed_at |
504
|
|
|
|
|
|
|
)); |
505
|
|
|
|
|
|
|
|
506
|
0
|
|
|
|
|
0
|
$self->_prepare_to_log(changes => $change); |
507
|
|
|
|
|
|
|
try { |
508
|
0
|
|
|
0
|
|
0
|
$dbh->do(qq{ |
509
|
|
|
|
|
|
|
INSERT INTO changes ( |
510
|
|
|
|
|
|
|
$cols |
511
|
|
|
|
|
|
|
) |
512
|
|
|
|
|
|
|
VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, $ts) |
513
|
|
|
|
|
|
|
}, undef, |
514
|
|
|
|
|
|
|
$id, |
515
|
|
|
|
|
|
|
$change->script_hash, |
516
|
|
|
|
|
|
|
$name, |
517
|
|
|
|
|
|
|
$proj, |
518
|
|
|
|
|
|
|
$change->note, |
519
|
|
|
|
|
|
|
$user, |
520
|
|
|
|
|
|
|
$email, |
521
|
|
|
|
|
|
|
$self->_char2ts( $change->timestamp ), |
522
|
|
|
|
|
|
|
$change->planner_name, |
523
|
|
|
|
|
|
|
$change->planner_email, |
524
|
|
|
|
|
|
|
) |
525
|
|
|
|
|
|
|
} catch { |
526
|
0
|
0
|
|
0
|
|
0
|
hurl engine => __x( |
527
|
|
|
|
|
|
|
'Cannot log change "{change}": The deploy script is not unique', |
528
|
|
|
|
|
|
|
change => $name, |
529
|
|
|
|
|
|
|
) if $self->_unique_error; |
530
|
0
|
|
|
|
|
0
|
die $_; |
531
|
0
|
|
|
|
|
0
|
}; |
532
|
|
|
|
|
|
|
|
533
|
0
|
0
|
|
|
|
0
|
if ( my @deps = $change->dependencies ) { |
534
|
|
|
|
|
|
|
$dbh->do(q{ |
535
|
|
|
|
|
|
|
INSERT INTO dependencies( |
536
|
|
|
|
|
|
|
change_id |
537
|
|
|
|
|
|
|
, type |
538
|
|
|
|
|
|
|
, dependency |
539
|
|
|
|
|
|
|
, dependency_id |
540
|
|
|
|
|
|
|
) } . $self->_multi_values(scalar @deps, $self->_dependency_placeholders), |
541
|
|
|
|
|
|
|
undef, |
542
|
0
|
|
|
|
|
0
|
map { ( |
543
|
0
|
|
|
|
|
0
|
$id, |
544
|
|
|
|
|
|
|
$_->type, |
545
|
|
|
|
|
|
|
$_->as_string, |
546
|
|
|
|
|
|
|
$_->resolved_id, |
547
|
|
|
|
|
|
|
) } @deps |
548
|
|
|
|
|
|
|
); |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
|
551
|
0
|
0
|
|
|
|
0
|
if ( my @tags = $change->tags ) { |
552
|
|
|
|
|
|
|
$dbh->do(q{ |
553
|
|
|
|
|
|
|
INSERT INTO tags ( |
554
|
|
|
|
|
|
|
tag_id |
555
|
|
|
|
|
|
|
, tag |
556
|
|
|
|
|
|
|
, project |
557
|
|
|
|
|
|
|
, change_id |
558
|
|
|
|
|
|
|
, note |
559
|
|
|
|
|
|
|
, committer_name |
560
|
|
|
|
|
|
|
, committer_email |
561
|
|
|
|
|
|
|
, planned_at |
562
|
|
|
|
|
|
|
, planner_name |
563
|
|
|
|
|
|
|
, planner_email |
564
|
|
|
|
|
|
|
, committed_at |
565
|
|
|
|
|
|
|
) } . $self->_multi_values(scalar @tags, $self->_tag_placeholders), |
566
|
|
|
|
|
|
|
undef, |
567
|
0
|
|
|
|
|
0
|
map { ( |
568
|
0
|
|
|
|
|
0
|
$_->id, |
569
|
|
|
|
|
|
|
$_->format_name, |
570
|
|
|
|
|
|
|
$proj, |
571
|
|
|
|
|
|
|
$id, |
572
|
|
|
|
|
|
|
$_->note, |
573
|
|
|
|
|
|
|
$user, |
574
|
|
|
|
|
|
|
$email, |
575
|
|
|
|
|
|
|
$self->_char2ts( $_->timestamp ), |
576
|
|
|
|
|
|
|
$_->planner_name, |
577
|
|
|
|
|
|
|
$_->planner_email, |
578
|
|
|
|
|
|
|
) } @tags |
579
|
|
|
|
|
|
|
); |
580
|
|
|
|
|
|
|
} |
581
|
|
|
|
|
|
|
|
582
|
0
|
|
|
|
|
0
|
return $self->_log_event( deploy => $change ); |
583
|
|
|
|
|
|
|
} |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
sub log_fail_change { |
586
|
0
|
|
|
0
|
1
|
0
|
shift->_log_event( fail => shift ); |
587
|
|
|
|
|
|
|
} |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
sub _log_event { |
590
|
0
|
|
|
0
|
|
0
|
my ( $self, $event, $change, $tags, $requires, $conflicts) = @_; |
591
|
0
|
|
|
|
|
0
|
my $dbh = $self->dbh; |
592
|
0
|
|
|
|
|
0
|
my $sqitch = $self->sqitch; |
593
|
|
|
|
|
|
|
|
594
|
0
|
|
|
|
|
0
|
my $ts = $self->_ts_default; |
595
|
0
|
|
|
|
|
0
|
my $cols = join "\n , ", $self->_quote_idents(qw( |
596
|
|
|
|
|
|
|
event |
597
|
|
|
|
|
|
|
change_id |
598
|
|
|
|
|
|
|
change |
599
|
|
|
|
|
|
|
project |
600
|
|
|
|
|
|
|
note |
601
|
|
|
|
|
|
|
tags |
602
|
|
|
|
|
|
|
requires |
603
|
|
|
|
|
|
|
conflicts |
604
|
|
|
|
|
|
|
committer_name |
605
|
|
|
|
|
|
|
committer_email |
606
|
|
|
|
|
|
|
planned_at |
607
|
|
|
|
|
|
|
planner_name |
608
|
|
|
|
|
|
|
planner_email |
609
|
|
|
|
|
|
|
committed_at |
610
|
|
|
|
|
|
|
)); |
611
|
|
|
|
|
|
|
|
612
|
0
|
|
|
|
|
0
|
$self->_prepare_to_log(events => $change); |
613
|
0
|
|
0
|
|
|
0
|
$dbh->do(qq{ |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
614
|
|
|
|
|
|
|
INSERT INTO events ( |
615
|
|
|
|
|
|
|
$cols |
616
|
|
|
|
|
|
|
) |
617
|
|
|
|
|
|
|
VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, $ts) |
618
|
|
|
|
|
|
|
}, undef, |
619
|
|
|
|
|
|
|
$event, |
620
|
|
|
|
|
|
|
$change->id, |
621
|
|
|
|
|
|
|
$change->name, |
622
|
|
|
|
|
|
|
$change->project, |
623
|
|
|
|
|
|
|
$change->note, |
624
|
|
|
|
|
|
|
$tags || $self->_log_tags_param($change), |
625
|
|
|
|
|
|
|
$requires || $self->_log_requires_param($change), |
626
|
|
|
|
|
|
|
$conflicts || $self->_log_conflicts_param($change), |
627
|
|
|
|
|
|
|
$sqitch->user_name, |
628
|
|
|
|
|
|
|
$sqitch->user_email, |
629
|
|
|
|
|
|
|
$self->_char2ts( $change->timestamp ), |
630
|
|
|
|
|
|
|
$change->planner_name, |
631
|
|
|
|
|
|
|
$change->planner_email, |
632
|
|
|
|
|
|
|
); |
633
|
|
|
|
|
|
|
|
634
|
0
|
|
|
|
|
0
|
return $self; |
635
|
|
|
|
|
|
|
} |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
sub changes_requiring_change { |
638
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $change ) = @_; |
639
|
0
|
|
|
|
|
0
|
return @{ $self->dbh->selectall_arrayref(q{ |
|
0
|
|
|
|
|
0
|
|
640
|
|
|
|
|
|
|
SELECT c.change_id, c.project, c.change, ( |
641
|
|
|
|
|
|
|
SELECT tag |
642
|
|
|
|
|
|
|
FROM changes c2 |
643
|
|
|
|
|
|
|
JOIN tags ON c2.change_id = tags.change_id |
644
|
|
|
|
|
|
|
WHERE c2.project = c.project |
645
|
|
|
|
|
|
|
AND c2.committed_at >= c.committed_at |
646
|
|
|
|
|
|
|
ORDER BY c2.committed_at |
647
|
|
|
|
|
|
|
LIMIT 1 |
648
|
|
|
|
|
|
|
) AS asof_tag |
649
|
|
|
|
|
|
|
FROM dependencies d |
650
|
|
|
|
|
|
|
JOIN changes c ON c.change_id = d.change_id |
651
|
|
|
|
|
|
|
WHERE d.dependency_id = ? |
652
|
|
|
|
|
|
|
}, { Slice => {} }, $change->id) }; |
653
|
|
|
|
|
|
|
} |
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
sub name_for_change_id { |
656
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $change_id ) = @_; |
657
|
0
|
|
|
|
|
0
|
return $self->dbh->selectcol_arrayref(q{ |
658
|
|
|
|
|
|
|
SELECT c.change || COALESCE(( |
659
|
|
|
|
|
|
|
SELECT tag |
660
|
|
|
|
|
|
|
FROM changes c2 |
661
|
|
|
|
|
|
|
JOIN tags ON c2.change_id = tags.change_id |
662
|
|
|
|
|
|
|
WHERE c2.committed_at >= c.committed_at |
663
|
|
|
|
|
|
|
AND c2.project = c.project |
664
|
|
|
|
|
|
|
LIMIT 1 |
665
|
|
|
|
|
|
|
), '@HEAD') |
666
|
|
|
|
|
|
|
FROM changes c |
667
|
|
|
|
|
|
|
WHERE change_id = ? |
668
|
|
|
|
|
|
|
}, undef, $change_id)->[0]; |
669
|
|
|
|
|
|
|
} |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
sub log_new_tags { |
672
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $change ) = @_; |
673
|
0
|
0
|
|
|
|
0
|
my @tags = $change->tags or return $self; |
674
|
0
|
|
|
|
|
0
|
my $sqitch = $self->sqitch; |
675
|
|
|
|
|
|
|
|
676
|
0
|
|
|
|
|
0
|
my ($id, $name, $proj, $user, $email) = ( |
677
|
|
|
|
|
|
|
$change->id, |
678
|
|
|
|
|
|
|
$change->format_name, |
679
|
|
|
|
|
|
|
$change->project, |
680
|
|
|
|
|
|
|
$sqitch->user_name, |
681
|
|
|
|
|
|
|
$sqitch->user_email |
682
|
|
|
|
|
|
|
); |
683
|
|
|
|
|
|
|
|
684
|
0
|
|
|
|
|
0
|
my $subselect = 'SELECT ' . $self->_tag_subselect_columns . $self->_simple_from; |
685
|
|
|
|
|
|
|
$self->dbh->do( |
686
|
|
|
|
|
|
|
q{ |
687
|
|
|
|
|
|
|
INSERT INTO tags ( |
688
|
|
|
|
|
|
|
tag_id |
689
|
|
|
|
|
|
|
, tag |
690
|
|
|
|
|
|
|
, project |
691
|
|
|
|
|
|
|
, change_id |
692
|
|
|
|
|
|
|
, note |
693
|
|
|
|
|
|
|
, committer_name |
694
|
|
|
|
|
|
|
, committer_email |
695
|
|
|
|
|
|
|
, planned_at |
696
|
|
|
|
|
|
|
, planner_name |
697
|
|
|
|
|
|
|
, planner_email |
698
|
|
|
|
|
|
|
, committed_at |
699
|
|
|
|
|
|
|
) |
700
|
|
|
|
|
|
|
SELECT i.* FROM ( |
701
|
|
|
|
|
|
|
} . join( |
702
|
|
|
|
|
|
|
"\n UNION ALL ", |
703
|
|
|
|
|
|
|
($subselect) x @tags |
704
|
|
|
|
|
|
|
) . q{ |
705
|
|
|
|
|
|
|
) i |
706
|
|
|
|
|
|
|
LEFT JOIN tags ON i.tid = tags.tag_id |
707
|
|
|
|
|
|
|
WHERE tags.tag_id IS NULL |
708
|
|
|
|
|
|
|
}, |
709
|
|
|
|
|
|
|
undef, |
710
|
0
|
|
|
|
|
0
|
map { ( |
711
|
0
|
|
|
|
|
0
|
$_->id, |
712
|
|
|
|
|
|
|
$_->format_name, |
713
|
|
|
|
|
|
|
$proj, |
714
|
|
|
|
|
|
|
$id, |
715
|
|
|
|
|
|
|
$_->note, |
716
|
|
|
|
|
|
|
$user, |
717
|
|
|
|
|
|
|
$email, |
718
|
|
|
|
|
|
|
$self->_char2ts( $_->timestamp ), |
719
|
|
|
|
|
|
|
$_->planner_name, |
720
|
|
|
|
|
|
|
$_->planner_email, |
721
|
|
|
|
|
|
|
) } @tags |
722
|
|
|
|
|
|
|
); |
723
|
|
|
|
|
|
|
|
724
|
0
|
|
|
|
|
0
|
return $self; |
725
|
|
|
|
|
|
|
} |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
sub log_revert_change { |
728
|
0
|
|
|
0
|
1
|
0
|
my ($self, $change) = @_; |
729
|
0
|
|
|
|
|
0
|
my $dbh = $self->dbh; |
730
|
0
|
|
|
|
|
0
|
my $cid = $change->id; |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
# Retrieve and delete tags. |
733
|
0
|
0
|
|
|
|
0
|
my $del_tags = join ',' => @{ $dbh->selectcol_arrayref( |
|
0
|
|
|
|
|
0
|
|
734
|
|
|
|
|
|
|
'SELECT tag FROM tags WHERE change_id = ?', |
735
|
|
|
|
|
|
|
undef, $cid |
736
|
|
|
|
|
|
|
) || [] }; |
737
|
|
|
|
|
|
|
|
738
|
0
|
|
|
|
|
0
|
$dbh->do( |
739
|
|
|
|
|
|
|
'DELETE FROM tags WHERE change_id = ?', |
740
|
|
|
|
|
|
|
undef, $cid |
741
|
|
|
|
|
|
|
); |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
# Retrieve dependencies and delete. |
744
|
0
|
|
|
|
|
0
|
my $sth = $dbh->prepare(q{ |
745
|
|
|
|
|
|
|
SELECT dependency |
746
|
|
|
|
|
|
|
FROM dependencies |
747
|
|
|
|
|
|
|
WHERE change_id = ? |
748
|
|
|
|
|
|
|
AND type = ? |
749
|
|
|
|
|
|
|
}); |
750
|
0
|
|
|
|
|
0
|
my $req = join ',' => @{ $dbh->selectcol_arrayref( |
|
0
|
|
|
|
|
0
|
|
751
|
|
|
|
|
|
|
$sth, undef, $cid, 'require' |
752
|
|
|
|
|
|
|
) }; |
753
|
|
|
|
|
|
|
|
754
|
0
|
|
|
|
|
0
|
my $conf = join ',' => @{ $dbh->selectcol_arrayref( |
|
0
|
|
|
|
|
0
|
|
755
|
|
|
|
|
|
|
$sth, undef, $cid, 'conflict' |
756
|
|
|
|
|
|
|
) }; |
757
|
|
|
|
|
|
|
|
758
|
0
|
|
|
|
|
0
|
$dbh->do('DELETE FROM dependencies WHERE change_id = ?', undef, $cid); |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
# Delete the change record. |
761
|
0
|
|
|
|
|
0
|
$dbh->do( |
762
|
|
|
|
|
|
|
'DELETE FROM changes where change_id = ?', |
763
|
|
|
|
|
|
|
undef, $cid, |
764
|
|
|
|
|
|
|
); |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
# Log it. |
767
|
0
|
|
|
|
|
0
|
return $self->_log_event( revert => $change, $del_tags, $req, $conf ); |
768
|
|
|
|
|
|
|
} |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
sub deployed_changes { |
771
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
772
|
0
|
|
|
|
|
0
|
my $tscol = sprintf $self->_ts2char_format, 'c.planned_at'; |
773
|
0
|
|
|
|
|
0
|
my $tagcol = sprintf $self->_listagg_format, 't.tag'; |
774
|
|
|
|
|
|
|
return map { |
775
|
0
|
|
|
|
|
0
|
$_->{timestamp} = _dt $_->{timestamp}; |
776
|
0
|
0
|
|
|
|
0
|
unless (ref $_->{tags}) { |
777
|
0
|
0
|
|
|
|
0
|
$_->{tags} = $_->{tags} ? [ split / / => $_->{tags} ] : []; |
778
|
|
|
|
|
|
|
} |
779
|
0
|
|
|
|
|
0
|
$_; |
780
|
0
|
|
|
|
|
0
|
} @{ $self->dbh->selectall_arrayref(qq{ |
|
0
|
|
|
|
|
0
|
|
781
|
|
|
|
|
|
|
SELECT c.change_id AS id, c.change AS name, c.project, c.note, |
782
|
|
|
|
|
|
|
$tscol AS "timestamp", c.planner_name, c.planner_email, |
783
|
|
|
|
|
|
|
$tagcol AS tags, c.script_hash |
784
|
|
|
|
|
|
|
FROM changes c |
785
|
|
|
|
|
|
|
LEFT JOIN tags t ON c.change_id = t.change_id |
786
|
|
|
|
|
|
|
WHERE c.project = ? |
787
|
|
|
|
|
|
|
GROUP BY c.change_id, c.change, c.project, c.note, c.planned_at, |
788
|
|
|
|
|
|
|
c.planner_name, c.planner_email, c.committed_at, c.script_hash |
789
|
|
|
|
|
|
|
ORDER BY c.committed_at ASC |
790
|
|
|
|
|
|
|
}, { Slice => {} }, $self->plan->project) }; |
791
|
|
|
|
|
|
|
} |
792
|
|
|
|
|
|
|
|
793
|
|
|
|
|
|
|
sub deployed_changes_since { |
794
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $change ) = @_; |
795
|
0
|
|
|
|
|
0
|
my $tscol = sprintf $self->_ts2char_format, 'c.planned_at'; |
796
|
0
|
|
|
|
|
0
|
my $tagcol = sprintf $self->_listagg_format, 't.tag'; |
797
|
|
|
|
|
|
|
return map { |
798
|
0
|
|
|
|
|
0
|
$_->{timestamp} = _dt $_->{timestamp}; |
799
|
0
|
0
|
|
|
|
0
|
unless (ref $_->{tags}) { |
800
|
0
|
0
|
|
|
|
0
|
$_->{tags} = $_->{tags} ? [ split / / => $_->{tags} ] : []; |
801
|
|
|
|
|
|
|
} |
802
|
0
|
|
|
|
|
0
|
$_; |
803
|
0
|
|
|
|
|
0
|
} @{ $self->dbh->selectall_arrayref(qq{ |
|
0
|
|
|
|
|
0
|
|
804
|
|
|
|
|
|
|
SELECT c.change_id AS id, c.change AS name, c.project, c.note, |
805
|
|
|
|
|
|
|
$tscol AS "timestamp", c.planner_name, c.planner_email, |
806
|
|
|
|
|
|
|
$tagcol AS tags, c.script_hash |
807
|
|
|
|
|
|
|
FROM changes c |
808
|
|
|
|
|
|
|
LEFT JOIN tags t ON c.change_id = t.change_id |
809
|
|
|
|
|
|
|
WHERE c.project = ? |
810
|
|
|
|
|
|
|
AND c.committed_at > (SELECT committed_at FROM changes WHERE change_id = ?) |
811
|
|
|
|
|
|
|
GROUP BY c.change_id, c.change, c.project, c.note, c.planned_at, |
812
|
|
|
|
|
|
|
c.planner_name, c.planner_email, c.committed_at, c.script_hash |
813
|
|
|
|
|
|
|
ORDER BY c.committed_at ASC |
814
|
|
|
|
|
|
|
}, { Slice => {} }, $self->plan->project, $change->id) }; |
815
|
|
|
|
|
|
|
} |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
sub load_change { |
818
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $change_id ) = @_; |
819
|
0
|
|
|
|
|
0
|
my $tscol = sprintf $self->_ts2char_format, 'c.planned_at'; |
820
|
0
|
|
|
|
|
0
|
my $tagcol = sprintf $self->_listagg_format, 't.tag'; |
821
|
0
|
|
0
|
|
|
0
|
my $change = $self->dbh->selectrow_hashref(qq{ |
822
|
|
|
|
|
|
|
SELECT c.change_id AS id, c.change AS name, c.project, c.note, |
823
|
|
|
|
|
|
|
$tscol AS "timestamp", c.planner_name, c.planner_email, |
824
|
|
|
|
|
|
|
$tagcol AS tags, c.script_hash |
825
|
|
|
|
|
|
|
FROM changes c |
826
|
|
|
|
|
|
|
LEFT JOIN tags t ON c.change_id = t.change_id |
827
|
|
|
|
|
|
|
WHERE c.change_id = ? |
828
|
|
|
|
|
|
|
GROUP BY c.change_id, c.change, c.project, c.note, c.planned_at, |
829
|
|
|
|
|
|
|
c.planner_name, c.planner_email, c.script_hash |
830
|
|
|
|
|
|
|
}, undef, $change_id) || return undef; |
831
|
0
|
|
|
|
|
0
|
$change->{timestamp} = _dt $change->{timestamp}; |
832
|
0
|
0
|
|
|
|
0
|
unless (ref $change->{tags}) { |
833
|
0
|
0
|
|
|
|
0
|
$change->{tags} = $change->{tags} ? [ split / / => $change->{tags} ] : []; |
834
|
|
|
|
|
|
|
} |
835
|
0
|
|
|
|
|
0
|
return $change; |
836
|
|
|
|
|
|
|
} |
837
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
sub _offset_op { |
839
|
0
|
|
|
0
|
|
0
|
my ( $self, $offset ) = @_; |
840
|
0
|
0
|
|
|
|
0
|
my ( $dir, $op ) = $offset > 0 ? ( 'ASC', '>' ) : ( 'DESC' , '<' ); |
841
|
0
|
|
|
|
|
0
|
return $dir, $op, 'OFFSET ' . (abs($offset) - 1); |
842
|
|
|
|
|
|
|
} |
843
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
sub change_id_offset_from_id { |
845
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $change_id, $offset ) = @_; |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
# Just return the ID if there is no offset. |
848
|
0
|
0
|
|
|
|
0
|
return $change_id unless $offset; |
849
|
|
|
|
|
|
|
|
850
|
0
|
|
|
|
|
0
|
my ($dir, $op, $offset_expr) = $self->_offset_op($offset); |
851
|
0
|
|
|
|
|
0
|
return $self->dbh->selectcol_arrayref(qq{ |
852
|
|
|
|
|
|
|
SELECT change_id |
853
|
|
|
|
|
|
|
FROM changes |
854
|
|
|
|
|
|
|
WHERE project = ? |
855
|
|
|
|
|
|
|
AND committed_at $op ( |
856
|
|
|
|
|
|
|
SELECT committed_at FROM changes WHERE change_id = ? |
857
|
|
|
|
|
|
|
) |
858
|
|
|
|
|
|
|
ORDER BY committed_at $dir |
859
|
|
|
|
|
|
|
LIMIT 1 $offset_expr |
860
|
|
|
|
|
|
|
}, undef, $self->plan->project, $change_id)->[0]; |
861
|
|
|
|
|
|
|
} |
862
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
sub change_offset_from_id { |
864
|
0
|
|
|
0
|
1
|
0
|
my ( $self, $change_id, $offset ) = @_; |
865
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
# Just return the object if there is no offset. |
867
|
0
|
0
|
|
|
|
0
|
return $self->load_change($change_id) unless $offset; |
868
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
# Are we offset forwards or backwards? |
870
|
0
|
|
|
|
|
0
|
my ($dir, $op, $offset_expr) = $self->_offset_op($offset); |
871
|
0
|
|
|
|
|
0
|
my $tscol = sprintf $self->_ts2char_format, 'c.planned_at'; |
872
|
0
|
|
|
|
|
0
|
my $tagcol = sprintf $self->_listagg_format, 't.tag'; |
873
|
|
|
|
|
|
|
|
874
|
0
|
|
0
|
|
|
0
|
my $change = $self->dbh->selectrow_hashref(qq{ |
875
|
|
|
|
|
|
|
SELECT c.change_id AS id, c.change AS name, c.project, c.note, |
876
|
|
|
|
|
|
|
$tscol AS "timestamp", c.planner_name, c.planner_email, |
877
|
|
|
|
|
|
|
$tagcol AS tags, c.script_hash |
878
|
|
|
|
|
|
|
FROM changes c |
879
|
|
|
|
|
|
|
LEFT JOIN tags t ON c.change_id = t.change_id |
880
|
|
|
|
|
|
|
WHERE c.project = ? |
881
|
|
|
|
|
|
|
AND c.committed_at $op ( |
882
|
|
|
|
|
|
|
SELECT committed_at FROM changes WHERE change_id = ? |
883
|
|
|
|
|
|
|
) |
884
|
|
|
|
|
|
|
GROUP BY c.change_id, c.change, c.project, c.note, c.planned_at, |
885
|
|
|
|
|
|
|
c.planner_name, c.planner_email, c.committed_at, c.script_hash |
886
|
|
|
|
|
|
|
ORDER BY c.committed_at $dir |
887
|
|
|
|
|
|
|
LIMIT 1 $offset_expr |
888
|
|
|
|
|
|
|
}, undef, $self->plan->project, $change_id) || return undef; |
889
|
0
|
|
|
|
|
0
|
$change->{timestamp} = _dt $change->{timestamp}; |
890
|
0
|
0
|
|
|
|
0
|
unless (ref $change->{tags}) { |
891
|
0
|
0
|
|
|
|
0
|
$change->{tags} = $change->{tags} ? [ split / / => $change->{tags} ] : []; |
892
|
|
|
|
|
|
|
} |
893
|
0
|
|
|
|
|
0
|
return $change; |
894
|
|
|
|
|
|
|
} |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
sub _cid_head { |
897
|
0
|
|
|
0
|
|
0
|
my ($self, $project, $change) = @_; |
898
|
0
|
|
|
|
|
0
|
return $self->dbh->selectcol_arrayref(q{ |
899
|
|
|
|
|
|
|
SELECT change_id |
900
|
|
|
|
|
|
|
FROM changes |
901
|
|
|
|
|
|
|
WHERE project = ? |
902
|
|
|
|
|
|
|
AND changes.change = ? |
903
|
|
|
|
|
|
|
ORDER BY committed_at DESC |
904
|
|
|
|
|
|
|
LIMIT 1 |
905
|
|
|
|
|
|
|
}, undef, $project, $change)->[0]; |
906
|
|
|
|
|
|
|
} |
907
|
|
|
|
|
|
|
|
908
|
|
|
|
|
|
|
sub change_id_for { |
909
|
1
|
|
|
1
|
1
|
10
|
my ( $self, %p) = @_; |
910
|
1
|
|
|
|
|
3
|
my $dbh = $self->dbh; |
911
|
|
|
|
|
|
|
|
912
|
1
|
50
|
|
|
|
7
|
if ( my $cid = $p{change_id} ) { |
913
|
|
|
|
|
|
|
# Find by ID. |
914
|
0
|
|
|
|
|
0
|
return $dbh->selectcol_arrayref(q{ |
915
|
|
|
|
|
|
|
SELECT change_id |
916
|
|
|
|
|
|
|
FROM changes |
917
|
|
|
|
|
|
|
WHERE change_id = ? |
918
|
|
|
|
|
|
|
}, undef, $cid)->[0]; |
919
|
|
|
|
|
|
|
} |
920
|
|
|
|
|
|
|
|
921
|
1
|
|
33
|
|
|
4
|
my $project = $p{project} || $self->plan->project; |
922
|
1
|
50
|
|
|
|
4
|
if ( my $change = $p{change} ) { |
923
|
0
|
0
|
|
|
|
0
|
if ( my $tag = $p{tag} ) { |
924
|
|
|
|
|
|
|
# There is nothing before the first tag. |
925
|
0
|
0
|
|
|
|
0
|
return undef if $tag eq 'ROOT'; |
926
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
# Find closest to the end for @HEAD. |
928
|
0
|
0
|
|
|
|
0
|
return $self->_cid_head($project, $change) if $tag eq 'HEAD'; |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
# Find by change name and following tag. |
931
|
0
|
0
|
|
|
|
0
|
my $limit = $self->_can_limit ? "\n LIMIT 1" : ''; |
932
|
0
|
|
|
|
|
0
|
return $dbh->selectcol_arrayref(qq{ |
933
|
|
|
|
|
|
|
SELECT changes.change_id |
934
|
|
|
|
|
|
|
FROM changes |
935
|
|
|
|
|
|
|
JOIN tags |
936
|
|
|
|
|
|
|
ON changes.committed_at <= tags.committed_at |
937
|
|
|
|
|
|
|
AND changes.project = tags.project |
938
|
|
|
|
|
|
|
WHERE changes.project = ? |
939
|
|
|
|
|
|
|
AND changes.change = ? |
940
|
|
|
|
|
|
|
AND tags.tag = ? |
941
|
|
|
|
|
|
|
ORDER BY changes.committed_at DESC$limit |
942
|
|
|
|
|
|
|
}, undef, $project, $change, '@' . $tag)->[0]; |
943
|
|
|
|
|
|
|
} |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
# Find earliest by change name. |
946
|
0
|
|
|
|
|
0
|
my $ids = $dbh->selectcol_arrayref(qq{ |
947
|
|
|
|
|
|
|
SELECT change_id |
948
|
|
|
|
|
|
|
FROM changes |
949
|
|
|
|
|
|
|
WHERE project = ? |
950
|
|
|
|
|
|
|
AND changes.change = ? |
951
|
|
|
|
|
|
|
ORDER BY changes.committed_at ASC |
952
|
|
|
|
|
|
|
}, undef, $project, $change); |
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
# Return the ID. |
955
|
0
|
0
|
|
|
|
0
|
return $ids->[0] if $p{first}; |
956
|
0
|
|
|
|
|
0
|
return $self->_handle_lookup_index($change, $ids); |
957
|
|
|
|
|
|
|
} |
958
|
|
|
|
|
|
|
|
959
|
1
|
50
|
|
|
|
4
|
if ( my $tag = $p{tag} ) { |
960
|
|
|
|
|
|
|
# Just return the latest for @HEAD. |
961
|
0
|
0
|
|
|
|
0
|
return $self->_cid('DESC', 0, $project) if $tag eq 'HEAD'; |
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
# Just return the earliest for @ROOT. |
964
|
0
|
0
|
|
|
|
0
|
return $self->_cid('ASC', 0, $project) if $tag eq 'ROOT'; |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
# Find by tag name. |
967
|
0
|
|
|
|
|
0
|
return $dbh->selectcol_arrayref(q{ |
968
|
|
|
|
|
|
|
SELECT change_id |
969
|
|
|
|
|
|
|
FROM tags |
970
|
|
|
|
|
|
|
WHERE project = ? |
971
|
|
|
|
|
|
|
AND tag = ? |
972
|
|
|
|
|
|
|
}, undef, $project, '@' . $tag)->[0]; |
973
|
|
|
|
|
|
|
} |
974
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
# We got nothin. |
976
|
1
|
|
|
|
|
4
|
return undef; |
977
|
|
|
|
|
|
|
} |
978
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
sub _update_script_hashes { |
980
|
0
|
|
|
0
|
|
|
my $self = shift; |
981
|
0
|
|
|
|
|
|
my $plan = $self->plan; |
982
|
0
|
|
|
|
|
|
my $proj = $plan->project; |
983
|
0
|
|
|
|
|
|
my $dbh = $self->dbh; |
984
|
0
|
|
|
|
|
|
my $sth = $dbh->prepare( |
985
|
|
|
|
|
|
|
'UPDATE changes SET script_hash = ? WHERE change_id = ? AND script_hash = ?' |
986
|
|
|
|
|
|
|
); |
987
|
|
|
|
|
|
|
|
988
|
0
|
|
|
|
|
|
$self->begin_work; |
989
|
0
|
|
|
|
|
|
$sth->execute($_->script_hash, $_->id, $_->id) for $plan->changes; |
990
|
0
|
|
|
|
|
|
$dbh->do(q{ |
991
|
|
|
|
|
|
|
UPDATE changes SET script_hash = NULL |
992
|
|
|
|
|
|
|
WHERE project = ? AND script_hash = change_id |
993
|
|
|
|
|
|
|
}, undef, $proj); |
994
|
|
|
|
|
|
|
|
995
|
0
|
|
|
|
|
|
$self->finish_work; |
996
|
0
|
|
|
|
|
|
return $self; |
997
|
|
|
|
|
|
|
} |
998
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
sub begin_work { |
1001
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
1002
|
|
|
|
|
|
|
# Note: Engines should acquire locks to prevent concurrent Sqitch activity. |
1003
|
0
|
|
|
|
|
|
$self->dbh->begin_work; |
1004
|
0
|
|
|
|
|
|
return $self; |
1005
|
|
|
|
|
|
|
} |
1006
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
sub finish_work { |
1008
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
1009
|
0
|
|
|
|
|
|
$self->dbh->commit; |
1010
|
0
|
|
|
|
|
|
return $self; |
1011
|
|
|
|
|
|
|
} |
1012
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
sub rollback_work { |
1014
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
1015
|
0
|
|
|
|
|
|
$self->dbh->rollback; |
1016
|
0
|
|
|
|
|
|
return $self; |
1017
|
|
|
|
|
|
|
} |
1018
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
1; |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
__END__ |
1022
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
=head1 Name |
1024
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
App::Sqitch::Command::checkout - An engine based on the DBI |
1026
|
|
|
|
|
|
|
|
1027
|
|
|
|
|
|
|
=head1 Synopsis |
1028
|
|
|
|
|
|
|
|
1029
|
|
|
|
|
|
|
package App::Sqitch::Engine::sqlite; |
1030
|
|
|
|
|
|
|
extends 'App::Sqitch::Engine'; |
1031
|
|
|
|
|
|
|
with 'App::Sqitch::Role::DBIEngine'; |
1032
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
=head1 Description |
1034
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
This role encapsulates the common attributes and methods required by |
1036
|
|
|
|
|
|
|
DBI-powered engines. |
1037
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
=head1 Interface |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
=head2 Instance Methods |
1041
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
=head3 C<earliest_change_id> |
1043
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
=head3 C<latest_change_id> |
1045
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
=head3 C<current_state> |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
=head3 C<current_changes> |
1049
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
=head3 C<current_tags> |
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
=head3 C<search_events> |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
=head3 C<registered_projects> |
1055
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
=head3 C<register_project> |
1057
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
=head3 C<is_deployed_change> |
1059
|
|
|
|
|
|
|
|
1060
|
|
|
|
|
|
|
=head3 C<are_deployed_changes> |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
=head3 C<log_deploy_change> |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
=head3 C<log_fail_change> |
1065
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
=head3 C<changes_requiring_change> |
1067
|
|
|
|
|
|
|
|
1068
|
|
|
|
|
|
|
=head3 C<name_for_change_id> |
1069
|
|
|
|
|
|
|
|
1070
|
|
|
|
|
|
|
=head3 C<log_new_tags> |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
=head3 C<log_revert_change> |
1073
|
|
|
|
|
|
|
|
1074
|
|
|
|
|
|
|
=head3 C<begin_work> |
1075
|
|
|
|
|
|
|
|
1076
|
|
|
|
|
|
|
=head3 C<finish_work> |
1077
|
|
|
|
|
|
|
|
1078
|
|
|
|
|
|
|
=head3 C<rollback_work> |
1079
|
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
=head3 C<is_deployed_tag> |
1081
|
|
|
|
|
|
|
|
1082
|
|
|
|
|
|
|
=head3 C<deployed_changes> |
1083
|
|
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
=head3 C<deployed_changes_since> |
1085
|
|
|
|
|
|
|
|
1086
|
|
|
|
|
|
|
=head3 C<load_change> |
1087
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
=head3 C<change_offset_from_id> |
1089
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
=head3 C<change_id_offset_from_id> |
1091
|
|
|
|
|
|
|
|
1092
|
|
|
|
|
|
|
=head3 C<change_id_for> |
1093
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
=head3 C<registry_version> |
1095
|
|
|
|
|
|
|
|
1096
|
|
|
|
|
|
|
=head1 See Also |
1097
|
|
|
|
|
|
|
|
1098
|
|
|
|
|
|
|
=over |
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
=item L<App::Sqitch::Engine::pg> |
1101
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
The PostgreSQL engine. |
1103
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
=item L<App::Sqitch::Engine::sqlite> |
1105
|
|
|
|
|
|
|
|
1106
|
|
|
|
|
|
|
The SQLite engine. |
1107
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
=item L<App::Sqitch::Engine::oracle> |
1109
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
The Oracle engine. |
1111
|
|
|
|
|
|
|
|
1112
|
|
|
|
|
|
|
=item L<App::Sqitch::Engine::mysql> |
1113
|
|
|
|
|
|
|
|
1114
|
|
|
|
|
|
|
The MySQL engine. |
1115
|
|
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
=item L<App::Sqitch::Engine::vertica> |
1117
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
The Vertica engine. |
1119
|
|
|
|
|
|
|
|
1120
|
|
|
|
|
|
|
=item L<App::Sqitch::Engine::exasol> |
1121
|
|
|
|
|
|
|
|
1122
|
|
|
|
|
|
|
The Exasol engine. |
1123
|
|
|
|
|
|
|
|
1124
|
|
|
|
|
|
|
=item L<App::Sqitch::Engine::snowflake> |
1125
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
The Snowflake engine. |
1127
|
|
|
|
|
|
|
|
1128
|
|
|
|
|
|
|
=back |
1129
|
|
|
|
|
|
|
|
1130
|
|
|
|
|
|
|
=head1 Author |
1131
|
|
|
|
|
|
|
|
1132
|
|
|
|
|
|
|
David E. Wheeler <david@justatheory.com> |
1133
|
|
|
|
|
|
|
|
1134
|
|
|
|
|
|
|
=head1 License |
1135
|
|
|
|
|
|
|
|
1136
|
|
|
|
|
|
|
Copyright (c) 2012-2023 iovation Inc., David E. Wheeler |
1137
|
|
|
|
|
|
|
|
1138
|
|
|
|
|
|
|
Permission is hereby granted, free of charge, to any person obtaining a copy |
1139
|
|
|
|
|
|
|
of this software and associated documentation files (the "Software"), to deal |
1140
|
|
|
|
|
|
|
in the Software without restriction, including without limitation the rights |
1141
|
|
|
|
|
|
|
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell |
1142
|
|
|
|
|
|
|
copies of the Software, and to permit persons to whom the Software is |
1143
|
|
|
|
|
|
|
furnished to do so, subject to the following conditions: |
1144
|
|
|
|
|
|
|
|
1145
|
|
|
|
|
|
|
The above copyright notice and this permission notice shall be included in all |
1146
|
|
|
|
|
|
|
copies or substantial portions of the Software. |
1147
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR |
1149
|
|
|
|
|
|
|
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, |
1150
|
|
|
|
|
|
|
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE |
1151
|
|
|
|
|
|
|
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER |
1152
|
|
|
|
|
|
|
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, |
1153
|
|
|
|
|
|
|
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE |
1154
|
|
|
|
|
|
|
SOFTWARE. |
1155
|
|
|
|
|
|
|
|
1156
|
|
|
|
|
|
|
=cut |