line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
# ABSTRACT: Sensible database change management |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
use 5.010; |
5
|
50
|
|
|
50
|
|
4992780
|
use strict; |
|
50
|
|
|
|
|
587
|
|
6
|
50
|
|
|
50
|
|
254
|
use warnings; |
|
50
|
|
|
|
|
75
|
|
|
50
|
|
|
|
|
964
|
|
7
|
50
|
|
|
50
|
|
190
|
use utf8; |
|
50
|
|
|
|
|
108
|
|
|
50
|
|
|
|
|
1334
|
|
8
|
50
|
|
|
50
|
|
7385
|
use Getopt::Long; |
|
50
|
|
|
|
|
232
|
|
|
50
|
|
|
|
|
289
|
|
9
|
50
|
|
|
50
|
|
33317
|
use Hash::Merge qw(merge); |
|
50
|
|
|
|
|
520708
|
|
|
50
|
|
|
|
|
245
|
|
10
|
50
|
|
|
50
|
|
29962
|
use Path::Class; |
|
50
|
|
|
|
|
417796
|
|
|
50
|
|
|
|
|
2776
|
|
11
|
50
|
|
|
50
|
|
17932
|
use Config; |
|
50
|
|
|
|
|
1313480
|
|
|
50
|
|
|
|
|
2617
|
|
12
|
50
|
|
|
50
|
|
418
|
use Locale::TextDomain 1.20 qw(App-Sqitch); |
|
50
|
|
|
|
|
130
|
|
|
50
|
|
|
|
|
1986
|
|
13
|
50
|
|
|
50
|
|
21282
|
use Locale::Messages qw(bind_textdomain_filter); |
|
50
|
|
|
|
|
640549
|
|
|
50
|
|
|
|
|
299
|
|
14
|
50
|
|
|
50
|
|
901697
|
use App::Sqitch::X qw(hurl); |
|
50
|
|
|
|
|
118
|
|
|
50
|
|
|
|
|
1998
|
|
15
|
50
|
|
|
50
|
|
19042
|
use Moo 1.002000; |
|
50
|
|
|
|
|
176
|
|
|
50
|
|
|
|
|
240
|
|
16
|
50
|
|
|
50
|
|
12631
|
use Type::Utils qw(where declare); |
|
50
|
|
|
|
|
1200
|
|
|
50
|
|
|
|
|
283
|
|
17
|
50
|
|
|
50
|
|
42632
|
use App::Sqitch::Types qw(Str UserName UserEmail Maybe Config HashRef); |
|
50
|
|
|
|
|
220409
|
|
|
50
|
|
|
|
|
502
|
|
18
|
50
|
|
|
50
|
|
49414
|
use Encode (); |
|
50
|
|
|
|
|
169
|
|
|
50
|
|
|
|
|
615
|
|
19
|
50
|
|
|
50
|
|
68747
|
use Try::Tiny; |
|
50
|
|
|
|
|
100
|
|
|
50
|
|
|
|
|
806
|
|
20
|
50
|
|
|
50
|
|
20306
|
use List::Util qw(first); |
|
50
|
|
|
|
|
45068
|
|
|
50
|
|
|
|
|
2506
|
|
21
|
50
|
|
|
50
|
|
323
|
use IPC::System::Simple 1.17 qw(runx capturex $EXITVAL); |
|
50
|
|
|
|
|
86
|
|
|
50
|
|
|
|
|
2665
|
|
22
|
50
|
|
|
50
|
|
25170
|
use namespace::autoclean 0.16; |
|
50
|
|
|
|
|
271462
|
|
|
50
|
|
|
|
|
6422
|
|
23
|
50
|
|
|
50
|
|
23043
|
use constant ISWIN => $^O eq 'MSWin32'; |
|
50
|
|
|
|
|
523282
|
|
|
50
|
|
|
|
|
238
|
|
24
|
50
|
|
|
50
|
|
3432
|
|
|
50
|
|
|
|
|
122
|
|
|
50
|
|
|
|
|
4615
|
|
25
|
|
|
|
|
|
|
our $VERSION = 'v1.3.1'; # VERSION |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
BEGIN { |
28
|
|
|
|
|
|
|
# Force Locale::TextDomain to encode in UTF-8 and to decode all messages. |
29
|
|
|
|
|
|
|
$ENV{OUTPUT_CHARSET} = 'UTF-8'; |
30
|
50
|
|
|
50
|
|
526
|
bind_textdomain_filter 'App-Sqitch' => \&Encode::decode_utf8, Encode::FB_DEFAULT; |
31
|
50
|
|
|
|
|
313
|
} |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# Okay to load Sqitch classes now that types are created. |
34
|
|
|
|
|
|
|
use App::Sqitch::Config; |
35
|
50
|
|
|
50
|
|
1552
|
use App::Sqitch::Command; |
|
50
|
|
|
|
|
95
|
|
|
50
|
|
|
|
|
992
|
|
36
|
50
|
|
|
50
|
|
23146
|
use App::Sqitch::Plan; |
|
50
|
|
|
|
|
149
|
|
|
50
|
|
|
|
|
1517
|
|
37
|
50
|
|
|
50
|
|
28649
|
|
|
50
|
|
|
|
|
147
|
|
|
50
|
|
|
|
|
149495
|
|
38
|
|
|
|
|
|
|
has options => ( |
39
|
|
|
|
|
|
|
is => 'ro', |
40
|
|
|
|
|
|
|
isa => HashRef, |
41
|
|
|
|
|
|
|
default => sub { {} }, |
42
|
|
|
|
|
|
|
); |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
has verbosity => ( |
45
|
|
|
|
|
|
|
is => 'ro', |
46
|
|
|
|
|
|
|
lazy => 1, |
47
|
|
|
|
|
|
|
default => sub { |
48
|
|
|
|
|
|
|
my $self = shift; |
49
|
|
|
|
|
|
|
$self->options->{verbosity} // $self->config->get( key => 'core.verbosity' ) // 1; |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
); |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
has sysuser => ( |
54
|
|
|
|
|
|
|
is => 'ro', |
55
|
|
|
|
|
|
|
isa => Maybe[Str], |
56
|
|
|
|
|
|
|
lazy => 1, |
57
|
|
|
|
|
|
|
default => sub { |
58
|
|
|
|
|
|
|
$ENV{ SQITCH_ORIG_SYSUSER } || do { |
59
|
|
|
|
|
|
|
# Adapted from User.pm. |
60
|
|
|
|
|
|
|
require Encode::Locale; |
61
|
|
|
|
|
|
|
return Encode::decode( locale => getlogin ) |
62
|
|
|
|
|
|
|
|| Encode::decode( locale => scalar getpwuid( $< ) ) |
63
|
|
|
|
|
|
|
|| $ENV{ LOGNAME } |
64
|
|
|
|
|
|
|
|| $ENV{ USER } |
65
|
|
|
|
|
|
|
|| $ENV{ USERNAME } |
66
|
|
|
|
|
|
|
|| try { |
67
|
|
|
|
|
|
|
require Win32; |
68
|
|
|
|
|
|
|
Encode::decode( locale => Win32::LoginName() ) |
69
|
|
|
|
|
|
|
}; |
70
|
|
|
|
|
|
|
}; |
71
|
|
|
|
|
|
|
}, |
72
|
|
|
|
|
|
|
); |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
has user_name => ( |
75
|
|
|
|
|
|
|
is => 'ro', |
76
|
|
|
|
|
|
|
lazy => 1, |
77
|
|
|
|
|
|
|
isa => UserName, |
78
|
|
|
|
|
|
|
default => sub { |
79
|
|
|
|
|
|
|
my $self = shift; |
80
|
|
|
|
|
|
|
$ENV{ SQITCH_FULLNAME } |
81
|
|
|
|
|
|
|
|| $self->config->get( key => 'user.name' ) |
82
|
|
|
|
|
|
|
|| $ENV{ SQITCH_ORIG_FULLNAME } |
83
|
|
|
|
|
|
|
|| do { |
84
|
|
|
|
|
|
|
my $sysname = $self->sysuser || hurl user => __( |
85
|
|
|
|
|
|
|
'Cannot find your name; run sqitch config --user user.name "YOUR NAME"' |
86
|
|
|
|
|
|
|
); |
87
|
|
|
|
|
|
|
if (ISWIN) { |
88
|
|
|
|
|
|
|
try { require Win32API::Net } || return $sysname; |
89
|
|
|
|
|
|
|
# https://stackoverflow.com/q/12081246/79202 |
90
|
|
|
|
|
|
|
Win32API::Net::UserGetInfo( $ENV{LOGONSERVER}, $sysname, 10, my $info = {} ); |
91
|
|
|
|
|
|
|
return $sysname unless $info->{fullName}; |
92
|
|
|
|
|
|
|
require Encode::Locale; |
93
|
|
|
|
|
|
|
return Encode::decode( locale => $info->{fullName} ); |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
require User::pwent; |
96
|
|
|
|
|
|
|
my $name = User::pwent::getpwnam($sysname) || return $sysname; |
97
|
|
|
|
|
|
|
$name = ($name->gecos)[0] || return $sysname; |
98
|
|
|
|
|
|
|
require Encode::Locale; |
99
|
|
|
|
|
|
|
return Encode::decode( locale => $name ); |
100
|
|
|
|
|
|
|
}; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
); |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
has user_email => ( |
105
|
|
|
|
|
|
|
is => 'ro', |
106
|
|
|
|
|
|
|
lazy => 1, |
107
|
|
|
|
|
|
|
isa => UserEmail, |
108
|
|
|
|
|
|
|
default => sub { |
109
|
|
|
|
|
|
|
my $self = shift; |
110
|
|
|
|
|
|
|
$ENV{ SQITCH_EMAIL } |
111
|
|
|
|
|
|
|
|| $self->config->get( key => 'user.email' ) |
112
|
|
|
|
|
|
|
|| $ENV{ SQITCH_ORIG_EMAIL } |
113
|
|
|
|
|
|
|
|| do { |
114
|
|
|
|
|
|
|
my $sysname = $self->sysuser || hurl user => __( |
115
|
|
|
|
|
|
|
'Cannot infer your email address; run sqitch config --user user.email you@host.com' |
116
|
|
|
|
|
|
|
); |
117
|
|
|
|
|
|
|
require Sys::Hostname; |
118
|
|
|
|
|
|
|
"$sysname@" . Sys::Hostname::hostname(); |
119
|
|
|
|
|
|
|
}; |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
); |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
has config => ( |
124
|
|
|
|
|
|
|
is => 'ro', |
125
|
|
|
|
|
|
|
isa => Config, |
126
|
|
|
|
|
|
|
lazy => 1, |
127
|
|
|
|
|
|
|
default => sub { |
128
|
|
|
|
|
|
|
App::Sqitch::Config->new; |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
); |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
has editor => ( |
133
|
|
|
|
|
|
|
is => 'ro', |
134
|
|
|
|
|
|
|
lazy => 1, |
135
|
|
|
|
|
|
|
default => sub { |
136
|
|
|
|
|
|
|
return |
137
|
|
|
|
|
|
|
$ENV{SQITCH_EDITOR} |
138
|
|
|
|
|
|
|
|| shift->config->get( key => 'core.editor' ) |
139
|
|
|
|
|
|
|
|| $ENV{VISUAL} |
140
|
|
|
|
|
|
|
|| $ENV{EDITOR} |
141
|
|
|
|
|
|
|
|| ( ISWIN ? 'notepad.exe' : 'vi' ); |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
); |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
has pager_program => ( |
146
|
|
|
|
|
|
|
is => "ro", |
147
|
|
|
|
|
|
|
lazy => 1, |
148
|
|
|
|
|
|
|
default => sub { |
149
|
|
|
|
|
|
|
my $self = shift; |
150
|
|
|
|
|
|
|
return |
151
|
|
|
|
|
|
|
$ENV{SQITCH_PAGER} |
152
|
|
|
|
|
|
|
|| $self->config->get(key => "core.pager") |
153
|
|
|
|
|
|
|
|| $ENV{PAGER}; |
154
|
|
|
|
|
|
|
}, |
155
|
|
|
|
|
|
|
); |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
has pager => ( |
158
|
|
|
|
|
|
|
is => 'ro', |
159
|
|
|
|
|
|
|
lazy => 1, |
160
|
|
|
|
|
|
|
isa => declare('Pager', where { |
161
|
|
|
|
|
|
|
eval { $_->isa('IO::Pager') || $_->isa('IO::Handle') } |
162
|
|
|
|
|
|
|
}), |
163
|
|
|
|
|
|
|
default => sub { |
164
|
|
|
|
|
|
|
# Dupe and configure STDOUT. |
165
|
|
|
|
|
|
|
require IO::Handle; |
166
|
|
|
|
|
|
|
my $fh = IO::Handle->new_from_fd(*STDOUT, 'w'); |
167
|
|
|
|
|
|
|
binmode $fh, ':utf8_strict'; |
168
|
2
|
|
|
2
|
|
625
|
|
|
2
|
|
|
|
|
21
|
|
|
2
|
|
|
|
|
1014
|
|
169
|
|
|
|
|
|
|
# Just return if no pager is wanted or there is no TTY. |
170
|
|
|
|
|
|
|
return $fh if shift->options->{no_pager} || !(-t *STDOUT); |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
# Load IO::Pager and tie the handle to it. |
173
|
|
|
|
|
|
|
eval "use IO::Pager 0.34"; die $@ if $@; |
174
|
|
|
|
|
|
|
return IO::Pager->new($fh, ':utf8_strict'); |
175
|
|
|
|
|
|
|
}, |
176
|
|
|
|
|
|
|
); |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
my $class = shift; |
179
|
|
|
|
|
|
|
my @args = @ARGV; |
180
|
6
|
|
|
6
|
1
|
23394
|
|
181
|
6
|
|
|
|
|
20
|
# 1. Parse core options. |
182
|
|
|
|
|
|
|
my $opts = $class->_parse_core_opts(\@args); |
183
|
|
|
|
|
|
|
|
184
|
6
|
|
|
|
|
24
|
# 2. Load config. |
185
|
|
|
|
|
|
|
my $config = App::Sqitch::Config->new; |
186
|
|
|
|
|
|
|
|
187
|
6
|
|
|
|
|
25
|
# 3. Instantiate Sqitch. |
188
|
|
|
|
|
|
|
my $sqitch = $class->new({ options => $opts, config => $config }); |
189
|
|
|
|
|
|
|
|
190
|
6
|
|
|
|
|
381
|
# 4. Find the command. |
191
|
|
|
|
|
|
|
my $cmd = $class->_find_cmd(\@args); |
192
|
|
|
|
|
|
|
|
193
|
6
|
|
|
|
|
437
|
# 5. Instantiate the command object. |
194
|
|
|
|
|
|
|
my $command = $cmd->create({ |
195
|
|
|
|
|
|
|
sqitch => $sqitch, |
196
|
6
|
|
|
|
|
52
|
config => $config, |
197
|
|
|
|
|
|
|
args => \@args, |
198
|
|
|
|
|
|
|
}); |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
# IO::Pager respects the PAGER environment variable. |
201
|
|
|
|
|
|
|
local $ENV{PAGER} = $sqitch->pager_program; |
202
|
|
|
|
|
|
|
|
203
|
6
|
|
|
|
|
3826
|
# 6. Execute command. |
204
|
|
|
|
|
|
|
return try { |
205
|
|
|
|
|
|
|
$command->execute( @args ) ? 0 : 2; |
206
|
|
|
|
|
|
|
} catch { |
207
|
6
|
50
|
|
6
|
|
398
|
# Just bail for unknown exceptions. |
208
|
|
|
|
|
|
|
$sqitch->vent($_) && return 2 unless eval { $_->isa('App::Sqitch::X') }; |
209
|
|
|
|
|
|
|
|
210
|
4
|
100
|
50
|
4
|
|
65
|
# It's one of ours. |
|
4
|
|
|
|
|
30
|
|
211
|
|
|
|
|
|
|
if ($_->exitval == 1) { |
212
|
|
|
|
|
|
|
# Non-fatal exception; just send the message to info. |
213
|
3
|
100
|
|
|
|
12
|
$sqitch->info($_->message); |
214
|
|
|
|
|
|
|
} else { |
215
|
1
|
|
|
|
|
12
|
# Fatal exception; vent. |
216
|
|
|
|
|
|
|
$sqitch->vent($_->message); |
217
|
|
|
|
|
|
|
|
218
|
2
|
|
|
|
|
7
|
# Emit the stack trace. DEV errors should be vented; otherwise trace. |
219
|
|
|
|
|
|
|
my $meth = $_->ident eq 'DEV' ? 'vent' : 'trace'; |
220
|
|
|
|
|
|
|
$sqitch->$meth($_->stack_trace->as_string); |
221
|
2
|
100
|
|
|
|
12
|
} |
222
|
2
|
|
|
|
|
48
|
|
223
|
|
|
|
|
|
|
# Bail. |
224
|
|
|
|
|
|
|
return $_->exitval; |
225
|
|
|
|
|
|
|
}; |
226
|
3
|
|
|
|
|
349
|
} |
227
|
6
|
|
|
|
|
963
|
|
228
|
|
|
|
|
|
|
return qw( |
229
|
|
|
|
|
|
|
chdir|cd|C=s |
230
|
|
|
|
|
|
|
etc-path |
231
|
38
|
|
|
38
|
|
2923
|
no-pager |
232
|
|
|
|
|
|
|
quiet |
233
|
|
|
|
|
|
|
verbose|V|v+ |
234
|
|
|
|
|
|
|
help |
235
|
|
|
|
|
|
|
man |
236
|
|
|
|
|
|
|
version |
237
|
|
|
|
|
|
|
); |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
my ( $self, $args ) = @_; |
241
|
|
|
|
|
|
|
my %opts; |
242
|
|
|
|
|
|
|
Getopt::Long::Configure(qw(bundling pass_through)); |
243
|
|
|
|
|
|
|
Getopt::Long::GetOptionsFromArray( |
244
|
18
|
|
|
18
|
|
6086
|
$args, |
245
|
18
|
|
|
|
|
28
|
map { |
246
|
18
|
|
|
|
|
100
|
( my $k = $_ ) =~ s/[|=+:!].*//; |
247
|
|
|
|
|
|
|
$k =~ s/-/_/g; |
248
|
|
|
|
|
|
|
$_ => \$opts{$k}; |
249
|
|
|
|
|
|
|
} $self->_core_opts |
250
|
18
|
50
|
|
|
|
767
|
) or $self->_pod2usage('sqitchusage', '-verbose' => 99 ); |
|
144
|
|
|
|
|
287
|
|
251
|
144
|
|
|
|
|
220
|
|
252
|
144
|
|
|
|
|
374
|
# Handle documentation requests. |
253
|
|
|
|
|
|
|
if ($opts{help} || $opts{man}) { |
254
|
|
|
|
|
|
|
$self->_pod2usage( |
255
|
|
|
|
|
|
|
$opts{help} ? 'sqitchcommands' : 'sqitch', |
256
|
|
|
|
|
|
|
'-exitval' => 0, |
257
|
18
|
100
|
100
|
|
|
10329
|
'-verbose' => 2, |
258
|
|
|
|
|
|
|
); |
259
|
2
|
100
|
|
|
|
12
|
} |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
# Handle version request. |
262
|
|
|
|
|
|
|
if ( delete $opts{version} ) { |
263
|
|
|
|
|
|
|
$self->emit( _bn($0), ' (', __PACKAGE__, ') ', __PACKAGE__->VERSION ); |
264
|
|
|
|
|
|
|
exit; |
265
|
|
|
|
|
|
|
} |
266
|
18
|
100
|
|
|
|
74
|
|
267
|
1
|
|
|
|
|
8
|
# Handle --etc-path. |
268
|
1
|
|
|
|
|
15
|
if ( $opts{etc_path} ) { |
269
|
|
|
|
|
|
|
$self->emit( App::Sqitch::Config->class->system_dir ); |
270
|
|
|
|
|
|
|
exit; |
271
|
|
|
|
|
|
|
} |
272
|
17
|
100
|
|
|
|
44
|
|
273
|
1
|
|
|
|
|
7
|
# Handle --chdir |
274
|
1
|
|
|
|
|
150
|
if ( my $dir = delete $opts{chdir} ) { |
275
|
|
|
|
|
|
|
chdir $dir or hurl fs => __x( |
276
|
|
|
|
|
|
|
'Cannot change to directory {directory}: {error}', |
277
|
|
|
|
|
|
|
directory => $dir, |
278
|
16
|
100
|
|
|
|
37
|
error => $!, |
279
|
4
|
100
|
|
|
|
20
|
); |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
# Normalize the options (remove undefs) and return. |
283
|
|
|
|
|
|
|
$opts{verbosity} = delete $opts{verbose}; |
284
|
|
|
|
|
|
|
$opts{verbosity} = 0 if delete $opts{quiet}; |
285
|
|
|
|
|
|
|
delete $opts{$_} for grep { !defined $opts{$_} } keys %opts; |
286
|
|
|
|
|
|
|
return \%opts; |
287
|
15
|
|
|
|
|
53
|
} |
288
|
15
|
100
|
|
|
|
56
|
|
289
|
15
|
|
|
|
|
57
|
my ( $class, $args ) = @_; |
|
75
|
|
|
|
|
145
|
|
290
|
15
|
|
|
|
|
75
|
my (@tried, $prev); |
291
|
|
|
|
|
|
|
for (my $i = 0; $i <= $#$args; $i++) { |
292
|
|
|
|
|
|
|
my $arg = $args->[$i] or next; |
293
|
|
|
|
|
|
|
if ($arg =~ /^-/) { |
294
|
25
|
|
|
25
|
|
12225
|
last if $arg eq '--'; |
295
|
25
|
|
|
|
|
51
|
# Skip the next argument if this looks like a pre-0.9999 option. |
296
|
25
|
|
|
|
|
116
|
# There shouldn't be many since we now recommend putting options |
297
|
46
|
50
|
|
|
|
116
|
# after the command. XXX Remove at some future date. |
298
|
46
|
100
|
|
|
|
191
|
$i++ if $arg =~ /^(?:-[duhp])|(?:--(?:db-\w+|client|engine|extension|plan-file|registry|top-dir))$/; |
299
|
23
|
100
|
|
|
|
71
|
next; |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
push @tried => $arg; |
302
|
|
|
|
|
|
|
my $cmd = try { App::Sqitch::Command->class_for($class, $arg) } or next; |
303
|
22
|
50
|
|
|
|
124
|
splice @{ $args }, $i, 1; |
304
|
22
|
|
|
|
|
61
|
return $cmd; |
305
|
|
|
|
|
|
|
} |
306
|
23
|
|
|
|
|
61
|
|
307
|
23
|
100
|
|
23
|
|
203
|
# No valid command found. Report those we tried. |
|
23
|
|
|
|
|
1286
|
|
308
|
18
|
|
|
|
|
334
|
$class->vent(__x( |
|
18
|
|
|
|
|
57
|
|
309
|
18
|
|
|
|
|
146
|
'"{command}" is not a valid command', |
310
|
|
|
|
|
|
|
command => $_, |
311
|
|
|
|
|
|
|
)) for @tried; |
312
|
|
|
|
|
|
|
$class->_pod2usage('sqitchcommands'); |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
my ( $self, $doc ) = ( shift, shift ); |
316
|
7
|
|
|
|
|
195
|
require App::Sqitch::Command::help; |
317
|
7
|
|
|
|
|
990
|
# Help does not need the Sqitch command; since it's required, fake it. |
318
|
|
|
|
|
|
|
my $help = App::Sqitch::Command::help->new( sqitch => bless {}, $self ); |
319
|
|
|
|
|
|
|
$help->find_and_show( $doc || 'sqitch', '-exitval' => 2, @_ ); |
320
|
|
|
|
|
|
|
} |
321
|
1
|
|
|
1
|
|
40928
|
|
322
|
1
|
|
|
|
|
14
|
my $self = shift; |
323
|
|
|
|
|
|
|
local $SIG{__DIE__} = sub { |
324
|
1
|
|
|
|
|
17
|
( my $msg = shift ) =~ s/\s+at\s+.+/\n/ms; |
325
|
1
|
|
50
|
|
|
2899
|
die $msg; |
326
|
|
|
|
|
|
|
}; |
327
|
|
|
|
|
|
|
if (ISWIN && IPC::System::Simple->VERSION < 1.28) { |
328
|
|
|
|
|
|
|
runx ( shift, $self->quote_shell(@_) ); |
329
|
2
|
|
|
2
|
1
|
7112
|
return $self; |
330
|
|
|
|
|
|
|
} |
331
|
1
|
|
|
1
|
|
7520
|
runx @_; |
332
|
1
|
|
|
|
|
60
|
return $self; |
333
|
2
|
|
|
|
|
27
|
} |
334
|
2
|
|
|
|
|
13
|
|
335
|
|
|
|
|
|
|
my ($self, $cmd) = @_; |
336
|
|
|
|
|
|
|
local $SIG{__DIE__} = sub { |
337
|
|
|
|
|
|
|
( my $msg = shift ) =~ s/\s+at\s+.+/\n/ms; |
338
|
2
|
|
|
|
|
23
|
die $msg; |
339
|
1
|
|
|
|
|
10188
|
}; |
340
|
|
|
|
|
|
|
IPC::System::Simple::run $cmd; |
341
|
|
|
|
|
|
|
return $self; |
342
|
|
|
|
|
|
|
} |
343
|
2
|
|
|
2
|
|
5841
|
|
344
|
|
|
|
|
|
|
my $self = shift; |
345
|
1
|
|
|
1
|
|
7073
|
if (ISWIN) { |
346
|
1
|
|
|
|
|
61
|
require Win32::ShellQuote; |
347
|
2
|
|
|
|
|
31
|
return Win32::ShellQuote::quote_native(@_); |
348
|
2
|
|
|
|
|
14
|
} |
349
|
1
|
|
|
|
|
8742
|
require String::ShellQuote; |
350
|
|
|
|
|
|
|
return String::ShellQuote::shell_quote(@_); |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
|
353
|
5
|
|
|
5
|
|
7750
|
my $self = shift; |
354
|
5
|
|
|
|
|
13
|
local $SIG{__DIE__} = sub { |
355
|
|
|
|
|
|
|
( my $msg = shift ) =~ s/\s+at\s+.+/\n/ms; |
356
|
|
|
|
|
|
|
die $msg; |
357
|
|
|
|
|
|
|
}; |
358
|
5
|
|
|
|
|
2288
|
return capturex ( shift, $self->quote_shell(@_) ) |
359
|
5
|
|
|
|
|
3057
|
if ISWIN && IPC::System::Simple->VERSION <= 1.25; |
360
|
|
|
|
|
|
|
capturex @_; |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
|
363
|
13
|
|
|
13
|
1
|
13413
|
return -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ; # Pipe? |
364
|
|
|
|
|
|
|
} |
365
|
6
|
|
|
6
|
|
32828
|
|
366
|
6
|
|
|
|
|
11472031
|
my $self = shift; |
367
|
13
|
|
|
|
|
126
|
return !$self->_is_interactive && eof STDIN; |
368
|
13
|
|
|
|
|
33
|
} |
369
|
|
|
|
|
|
|
|
370
|
13
|
|
|
|
|
84
|
my $self = shift; |
371
|
|
|
|
|
|
|
return undef if $self->_is_unattended; |
372
|
|
|
|
|
|
|
my $answer = <STDIN>; |
373
|
|
|
|
|
|
|
chomp $answer if defined $answer; |
374
|
2
|
|
33
|
2
|
|
1348
|
return $answer; |
375
|
|
|
|
|
|
|
} |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
my $self = shift; |
378
|
1
|
|
|
1
|
|
329
|
my $msg = shift or hurl 'prompt() called without a prompt message'; |
379
|
1
|
|
33
|
|
|
5
|
|
380
|
|
|
|
|
|
|
# use a list to distinguish a default of undef() from no default |
381
|
|
|
|
|
|
|
my @def; |
382
|
|
|
|
|
|
|
@def = (shift) if @_; |
383
|
2
|
|
|
2
|
|
2149
|
# use dispdef for output |
384
|
2
|
100
|
|
|
|
7
|
my @dispdef = scalar(@def) |
385
|
1
|
|
|
|
|
8
|
? ('[', (defined($def[0]) ? $def[0] : ''), '] ') |
386
|
1
|
50
|
|
|
|
4
|
: ('', ''); |
387
|
1
|
|
|
|
|
10
|
|
388
|
|
|
|
|
|
|
# Don't use emit because it adds a newline. |
389
|
|
|
|
|
|
|
local $|=1; |
390
|
|
|
|
|
|
|
print $msg, ' ', @dispdef; |
391
|
1
|
|
|
1
|
1
|
17
|
|
392
|
4
|
100
|
|
|
|
6475
|
if ($self->_is_unattended) { |
393
|
|
|
|
|
|
|
hurl io => __( |
394
|
|
|
|
|
|
|
'Sqitch seems to be unattended and there is no default value for this question' |
395
|
4
|
|
|
|
|
91
|
) unless @def; |
396
|
4
|
100
|
|
|
|
4598
|
print "$dispdef[1]\n"; |
397
|
|
|
|
|
|
|
} |
398
|
4
|
100
|
|
|
|
81
|
|
|
|
100
|
|
|
|
|
|
399
|
|
|
|
|
|
|
my $ans = $self->_readline; |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
if ( !defined $ans or !length $ans ) { |
402
|
|
|
|
|
|
|
# Ctrl-D or user hit return; |
403
|
18
|
|
|
|
|
4706
|
$ans = @def ? $def[0] : ''; |
404
|
18
|
|
|
|
|
389
|
} |
405
|
|
|
|
|
|
|
|
406
|
4
|
100
|
|
|
|
4486
|
return $ans; |
407
|
4
|
100
|
|
|
|
80
|
} |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
my ($self, @msg) = (shift, shift); |
410
|
4
|
|
|
|
|
4456
|
hurl 'ask_yes_no() called without a prompt message' unless $msg[0]; |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
my $y = __p 'Confirm prompt answer yes', 'Yes'; |
413
|
4
|
|
|
|
|
72
|
my $n = __p 'Confirm prompt answer no', 'No'; |
414
|
|
|
|
|
|
|
push @msg => $_[0] ? $y : $n if @_; |
415
|
4
|
|
|
|
|
4410
|
|
416
|
|
|
|
|
|
|
my $answer; |
417
|
4
|
|
|
|
|
76
|
my $i = 3; |
418
|
|
|
|
|
|
|
while ($i--) { |
419
|
|
|
|
|
|
|
$answer = $self->prompt(@msg); |
420
|
4
|
|
|
|
|
4429
|
return 1 if $y =~ /^\Q$answer/i; |
421
|
|
|
|
|
|
|
return 0 if $n =~ /^\Q$answer/i; |
422
|
|
|
|
|
|
|
$self->emit(__ 'Please answer "y" or "n".'); |
423
|
|
|
|
|
|
|
} |
424
|
4
|
|
|
4
|
1
|
19
|
|
425
|
4
|
|
|
|
|
4448
|
hurl io => __ 'No valid answer after 3 attempts; aborting'; |
426
|
|
|
|
|
|
|
} |
427
|
4
|
|
|
|
|
21
|
|
428
|
20
|
|
|
|
|
5719
|
my $self = shift; |
429
|
20
|
|
|
|
|
78
|
$self->warn('The ask_y_n() method has been deprecated. Use ask_yes_no() instead.'); |
430
|
|
|
|
|
|
|
return $self->ask_yes_no(@_) unless @_ > 1; |
431
|
20
|
|
|
|
|
687
|
|
432
|
18
|
|
|
|
|
7072
|
my ($msg, $def) = @_; |
433
|
18
|
|
|
|
|
78
|
hurl 'Invalid default value: ask_y_n() default must be "y" or "n"' |
434
|
18
|
|
|
|
|
647
|
if $def && $def !~ /^[yn]/i; |
435
|
5
|
|
|
|
|
1597
|
return $self->ask_yes_no($msg, $def =~ /^y/i ? 1 : 0); |
436
|
5
|
|
|
|
|
27
|
} |
437
|
5
|
|
|
|
|
24
|
|
438
|
|
|
|
|
|
|
my ($self, $fh) = (shift, shift); |
439
|
|
|
|
|
|
|
local $SIG{__WARN__} = sub { }; # Silence warning. |
440
|
5
|
|
|
|
|
46
|
my $pipe; |
441
|
|
|
|
|
|
|
if (ISWIN) { |
442
|
|
|
|
|
|
|
no warnings; |
443
|
|
|
|
|
|
|
open $pipe, '|' . $self->quote_shell(@_) or hurl io => __x( |
444
|
41
|
|
|
41
|
1
|
42072
|
'Cannot exec {command}: {error}', |
445
|
41
|
|
|
|
|
121
|
command => $_[0], |
446
|
40
|
100
|
|
|
|
101
|
error => $!, |
447
|
|
|
|
|
|
|
); |
448
|
34
|
|
|
|
|
72
|
} else { |
449
|
34
|
100
|
100
|
|
|
160
|
no warnings; |
450
|
|
|
|
|
|
|
open $pipe, '|-', @_ or hurl io => __x( |
451
|
33
|
100
|
|
|
|
142
|
'Cannot exec {command}: {error}', |
452
|
|
|
|
|
|
|
command => $_[0], |
453
|
|
|
|
|
|
|
error => $!, |
454
|
|
|
|
|
|
|
); |
455
|
35
|
|
|
26
|
1
|
11297
|
} |
456
|
35
|
|
|
0
|
|
220
|
|
457
|
6
|
|
|
|
|
31
|
local $SIG{PIPE} = sub { die 'spooler pipe broke' }; |
458
|
5
|
|
|
|
|
29
|
if (ref $fh eq 'ARRAY') { |
459
|
50
|
|
|
50
|
|
525
|
for my $h (@{ $fh }) { |
|
50
|
|
|
|
|
111
|
|
|
50
|
|
|
|
|
4984
|
|
460
|
|
|
|
|
|
|
print $pipe $_ while <$h>; |
461
|
|
|
|
|
|
|
} |
462
|
|
|
|
|
|
|
} else { |
463
|
|
|
|
|
|
|
print $pipe $_ while <$fh>; |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
|
466
|
50
|
|
|
50
|
|
366
|
close $pipe or hurl io => $! ? __x( |
|
50
|
|
|
|
|
116
|
|
|
50
|
|
|
|
|
45440
|
|
467
|
34
|
100
|
|
|
|
19163
|
'Error closing pipe to {command}: {error}', |
468
|
|
|
|
|
|
|
command => $_[0], |
469
|
|
|
|
|
|
|
error => $!, |
470
|
|
|
|
|
|
|
) : __x( |
471
|
|
|
|
|
|
|
'{command} unexpectedly returned exit value {exitval}', |
472
|
|
|
|
|
|
|
command => $_[0], |
473
|
|
|
|
|
|
|
exitval => ($? >> 8), |
474
|
33
|
|
|
0
|
|
407
|
); |
|
7
|
|
|
|
|
29
|
|
475
|
33
|
100
|
|
|
|
174
|
return $self; |
476
|
23
|
|
|
|
|
27364
|
} |
|
23
|
|
|
|
|
75
|
|
477
|
22
|
|
|
|
|
111
|
|
478
|
|
|
|
|
|
|
my ($ret) = shift->capture(@_); |
479
|
|
|
|
|
|
|
chomp $ret if $ret; |
480
|
22
|
|
|
|
|
1264
|
return $ret; |
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
|
483
|
23
|
100
|
|
|
|
7662
|
require File::Basename; |
|
|
100
|
|
|
|
|
|
484
|
|
|
|
|
|
|
File::Basename::basename($0); |
485
|
|
|
|
|
|
|
} |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
my $prefix = shift; |
488
|
|
|
|
|
|
|
my $msg = join '', map { $_ // '' } @_; |
489
|
|
|
|
|
|
|
$msg =~ s/^/$prefix /gms; |
490
|
|
|
|
|
|
|
return $msg; |
491
|
|
|
|
|
|
|
} |
492
|
22
|
|
|
|
|
247
|
|
493
|
|
|
|
|
|
|
my $pager = shift->pager; |
494
|
|
|
|
|
|
|
return $pager->say(@_); |
495
|
|
|
|
|
|
|
} |
496
|
27
|
|
|
7
|
1
|
5146
|
|
497
|
22
|
100
|
|
|
|
20527
|
my $pager = shift->pager; |
498
|
26
|
|
|
|
|
215
|
return $pager->print(@_); |
499
|
|
|
|
|
|
|
} |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
my $self = shift; |
502
|
26
|
|
|
2
|
|
657
|
$self->emit( _prepend 'trace:', @_ ) if $self->verbosity > 2; |
503
|
17
|
|
|
|
|
348
|
} |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
my $self = shift; |
506
|
|
|
|
|
|
|
$self->emit_literal( _prepend 'trace:', @_ ) if $self->verbosity > 2; |
507
|
26
|
|
|
20
|
|
265
|
} |
508
|
22
|
|
50
|
|
|
70
|
|
|
60
|
|
|
|
|
184
|
|
509
|
20
|
|
|
|
|
156
|
my $self = shift; |
510
|
20
|
|
|
|
|
130
|
$self->emit( _prepend 'debug:', @_ ) if $self->verbosity > 1; |
511
|
|
|
|
|
|
|
} |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
my $self = shift; |
514
|
5
|
|
|
4
|
1
|
170
|
$self->emit_literal( _prepend 'debug:', @_ ) if $self->verbosity > 1; |
515
|
5
|
|
|
|
|
72
|
} |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
my $self = shift; |
518
|
|
|
|
|
|
|
$self->emit(@_) if $self->verbosity; |
519
|
3
|
|
|
18
|
1
|
1523
|
} |
520
|
3
|
|
|
|
|
11
|
|
521
|
|
|
|
|
|
|
my $self = shift; |
522
|
|
|
|
|
|
|
$self->emit_literal(@_) if $self->verbosity; |
523
|
|
|
|
|
|
|
} |
524
|
3
|
|
|
4
|
|
11
|
|
525
|
3
|
|
|
|
|
15
|
my $self = shift; |
526
|
|
|
|
|
|
|
$self->emit( _prepend '#', @_ ); |
527
|
|
|
|
|
|
|
} |
528
|
|
|
|
|
|
|
|
529
|
3
|
|
|
4
|
1
|
102
|
my $self = shift; |
530
|
3
|
|
|
|
|
34
|
$self->emit_literal( _prepend '#', @_ ); |
531
|
|
|
|
|
|
|
} |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
shift; |
534
|
2
|
|
|
4
|
1
|
3166
|
local $|=1; |
535
|
2
|
|
|
|
|
11
|
say @_; |
536
|
|
|
|
|
|
|
} |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
shift; |
539
|
2
|
|
|
4
|
1
|
3158
|
local $|=1; |
540
|
2
|
|
|
|
|
9
|
print @_; |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
shift; |
544
|
|
|
|
4
|
|
|
my $fh = select; |
545
|
|
|
|
|
|
|
select STDERR; |
546
|
|
|
|
|
|
|
local $|=1; |
547
|
|
|
|
|
|
|
say STDERR @_; |
548
|
|
|
|
|
|
|
select $fh; |
549
|
|
|
|
20
|
1
|
|
} |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
shift; |
552
|
|
|
|
|
|
|
my $fh = select; |
553
|
|
|
|
|
|
|
select STDERR; |
554
|
|
|
|
18
|
1
|
|
local $|=1; |
555
|
|
|
|
|
|
|
print STDERR @_; |
556
|
|
|
|
|
|
|
select $fh; |
557
|
|
|
|
|
|
|
} |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
5
|
1
|
|
my $self = shift; |
560
|
|
|
|
|
|
|
$self->vent(_prepend 'warning:', @_); |
561
|
|
|
|
|
|
|
} |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
my $self = shift; |
564
|
|
|
|
3
|
|
|
$self->vent_literal(_prepend 'warning:', @_); |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
1; |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
|
570
|
|
|
|
2
|
1
|
|
=head1 Name |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
App::Sqitch - Sensible database change management |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
=head1 Synopsis |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
2
|
|
|
use App::Sqitch; |
577
|
|
|
|
|
|
|
exit App::Sqitch->go; |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
=head1 Description |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
This module provides the implementation for L<sqitch>. You probably want to |
582
|
|
|
|
|
|
|
read L<its documentation|sqitch>, or L<the tutorial|sqitchtutorial>. Unless |
583
|
|
|
|
|
|
|
you want to hack on Sqitch itself, or provide support for a new engine or |
584
|
|
|
|
|
|
|
L<command|Sqitch::App::Command>. In which case, you will find this API |
585
|
|
|
|
|
|
|
documentation useful. |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
=head1 Interface |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
=head2 Class Methods |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
=head3 C<go> |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
App::Sqitch->go; |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
Called from C<sqitch>, this class method parses command-line options and |
596
|
|
|
|
|
|
|
arguments in C<@ARGV>, parses the configuration file, constructs an |
597
|
|
|
|
|
|
|
App::Sqitch object, constructs a command object, and runs it. |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
=head2 Constructor |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
=head3 C<new> |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
my $sqitch = App::Sqitch->new(\%params); |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
Constructs and returns a new Sqitch object. The supported parameters include: |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
=over |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
=item C<options> |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
=item C<user_name> |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
=item C<user_email> |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
=item C<editor> |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
=item C<verbosity> |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
=back |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
=head2 Accessors |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
=head3 C<user_name> |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
=head3 C<user_email> |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
=head3 C<editor> |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
=head3 C<options> |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
my $options = $sqitch->options; |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
Returns a hashref of the core command-line options. |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
=head3 C<config> |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
my $config = $sqitch->config; |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
Returns the full configuration, combined from the project, user, and system |
640
|
|
|
|
|
|
|
configuration files. |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
=head3 C<verbosity> |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
=head2 Instance Methods |
645
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
=head3 C<run> |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
$sqitch->run('echo', '-n', 'hello'); |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
Runs a system command and waits for it to finish. Throws an exception on |
651
|
|
|
|
|
|
|
error. Does not use the shell, so arguments must be passed as a list. Use |
652
|
|
|
|
|
|
|
C<shell> to run a command and its arguments as a single string. |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
=over |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
=item C<target> |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
The name of the target, as passed. |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
=item C<uri> |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
A L<database URI|URI::db> object, to be used to connect to the target |
663
|
|
|
|
|
|
|
database. |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
=item C<registry> |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
The name of the Sqitch registry in the target database. |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
=back |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
If the C<$target> argument looks like a database URI, it will simply returned |
673
|
|
|
|
|
|
|
in the hash reference. If the C<$target> argument corresponds to a target |
674
|
|
|
|
|
|
|
configuration key, the target configuration will be returned, with the C<uri> |
675
|
|
|
|
|
|
|
value a upgraded to a L<URI> object. Otherwise returns C<undef>. |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
=head3 C<shell> |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
$sqitch->shell('echo -n hello'); |
680
|
|
|
|
|
|
|
|
681
|
|
|
|
|
|
|
Shells out a system command and waits for it to finish. Throws an exception on |
682
|
|
|
|
|
|
|
error. Always uses the shell, so a single string must be passed encapsulating |
683
|
|
|
|
|
|
|
the entire command and its arguments. Use C<quote_shell> to assemble strings |
684
|
|
|
|
|
|
|
into a single shell command. Use C<run> to execute a list without a shell. |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
=head3 C<quote_shell> |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
my $cmd = $sqitch->quote_shell('echo', '-n', 'hello'); |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
Assemble a list into a single string quoted for execution by C<shell>. Useful |
691
|
|
|
|
|
|
|
for combining a specified command, such as C<editor()>, which might include |
692
|
|
|
|
|
|
|
the options in the string, for example: |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
$sqitch->shell( $sqitch->editor, $sqitch->quote_shell($file) ); |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
=head3 C<capture> |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
my @files = $sqitch->capture(qw(ls -lah)); |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
Runs a system command and captures its output to C<STDOUT>. Returns the output |
701
|
|
|
|
|
|
|
lines in list context and the concatenation of the lines in scalar context. |
702
|
|
|
|
|
|
|
Throws an exception on error. |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
=head3 C<probe> |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
my $git_version = $sqitch->capture(qw(git --version)); |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
Like C<capture>, but returns just the C<chomp>ed first line of output. |
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
=head3 C<spool> |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
$sqitch->spool($sql_file_handle, 'sqlite3', 'my.db'); |
713
|
|
|
|
|
|
|
$sqitch->spool(\@file_handles, 'sqlite3', 'my.db'); |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
Like run, but spools the contents of one or ore file handle to the standard |
716
|
|
|
|
|
|
|
input the system command. Returns true on success and throws an exception on |
717
|
|
|
|
|
|
|
failure. |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
=head3 C<trace> |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
=head3 C<trace_literal> |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
$sqitch->trace_literal('About to fuzzle the wuzzle.'); |
724
|
|
|
|
|
|
|
$sqitch->trace('Done.'); |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
Send trace information to C<STDOUT> if the verbosity level is 3 or higher. |
727
|
|
|
|
|
|
|
Trace messages will have C<trace: > prefixed to every line. If it's lower than |
728
|
|
|
|
|
|
|
3, nothing will be output. C<trace> appends a newline to the end of the |
729
|
|
|
|
|
|
|
message while C<trace_literal> does not. |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
=head3 C<debug> |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
=head3 C<debug_literal> |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
$sqitch->debug('Found snuggle in the crib.'); |
736
|
|
|
|
|
|
|
$sqitch->debug_literal('ITYM "snuggie".'); |
737
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
Send debug information to C<STDOUT> if the verbosity level is 2 or higher. |
739
|
|
|
|
|
|
|
Debug messages will have C<debug: > prefixed to every line. If it's lower than |
740
|
|
|
|
|
|
|
2, nothing will be output. C<debug> appends a newline to the end of the |
741
|
|
|
|
|
|
|
message while C<debug_literal> does not. |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
=head3 C<info> |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
=head3 C<info_literal> |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
$sqitch->info('Nothing to deploy (up-to-date)'); |
748
|
|
|
|
|
|
|
$sqitch->info_literal('Going to frobble the shiznet.'); |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
Send informational message to C<STDOUT> if the verbosity level is 1 or higher, |
751
|
|
|
|
|
|
|
which, by default, it is. Should be used for normal messages the user would |
752
|
|
|
|
|
|
|
normally want to see. If verbosity is lower than 1, nothing will be output. |
753
|
|
|
|
|
|
|
C<info> appends a newline to the end of the message while C<info_literal> does |
754
|
|
|
|
|
|
|
not. |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
=head3 C<comment> |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
=head3 C<comment_literal> |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
$sqitch->comment('On database flipr_test'); |
761
|
|
|
|
|
|
|
$sqitch->comment_literal('Uh-oh...'); |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
Send comments to C<STDOUT> if the verbosity level is 1 or higher, which, by |
764
|
|
|
|
|
|
|
default, it is. Comments have C<# > prefixed to every line. If verbosity is |
765
|
|
|
|
|
|
|
lower than 1, nothing will be output. C<comment> appends a newline to the end |
766
|
|
|
|
|
|
|
of the message while C<comment_literal> does not. |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
=head3 C<emit> |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
=head3 C<emit_literal> |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
$sqitch->emit('core.editor=emacs'); |
773
|
|
|
|
|
|
|
$sqitch->emit_literal('Getting ready...'); |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
Send a message to C<STDOUT>, without regard to the verbosity. Should be used |
776
|
|
|
|
|
|
|
only if the user explicitly asks for output, such as for C<sqitch config --get |
777
|
|
|
|
|
|
|
core.editor>. C<emit> appends a newline to the end of the message while |
778
|
|
|
|
|
|
|
C<emit_literal> does not. |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
=head3 C<vent> |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
=head3 C<vent_literal> |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
$sqitch->vent('That was a misage.'); |
785
|
|
|
|
|
|
|
$sqitch->vent_literal('This is going to be bad...'); |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
Send a message to C<STDERR>, without regard to the verbosity. Should be used |
788
|
|
|
|
|
|
|
only for error messages to be printed before exiting with an error, such as |
789
|
|
|
|
|
|
|
when reverting failed changes. C<vent> appends a newline to the end of the |
790
|
|
|
|
|
|
|
message while C<vent_literal> does not. |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
=head3 C<page> |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
=head3 C<page_literal> |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
$sqitch->page('Search results:'); |
797
|
|
|
|
|
|
|
$sqitch->page("Here we go\n"); |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
Like C<emit()>, but sends the output to a pager handle rather than C<STDOUT>. |
800
|
|
|
|
|
|
|
Unless there is no TTY (such as when output is being piped elsewhere), in |
801
|
|
|
|
|
|
|
which case it I<is> sent to C<STDOUT>. C<page> appends a newline to the end of |
802
|
|
|
|
|
|
|
the message while C<page_literal> does not. Meant to be used to send a lot of |
803
|
|
|
|
|
|
|
data to the user at once, such as when display the results of searching the |
804
|
|
|
|
|
|
|
event log: |
805
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
$iter = $engine->search_events; |
807
|
|
|
|
|
|
|
while ( my $change = $iter->() ) { |
808
|
|
|
|
|
|
|
$sqitch->page(join ' - ', @{ $change }{ qw(change_id event change) }); |
809
|
|
|
|
|
|
|
} |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
=head3 C<warn> |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
=head3 C<warn_literal> |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
$sqitch->warn('Could not find nerble; using nobble instead.'); |
816
|
|
|
|
|
|
|
$sqitch->warn_literal("Cannot read file: $!\n"); |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
Send a warning messages to C<STDERR>. Warnings will have C<warning: > prefixed |
819
|
|
|
|
|
|
|
to every line. Use if something unexpected happened but you can recover from |
820
|
|
|
|
|
|
|
it. C<warn> appends a newline to the end of the message while C<warn_literal> |
821
|
|
|
|
|
|
|
does not. |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
=head3 C<prompt> |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
my $ans = $sqitch->('Why would you want to do this?', 'because'); |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
Prompts the user for input and returns that input. Pass in an optional default |
828
|
|
|
|
|
|
|
value for the user to accept or to be used if Sqitch is running unattended. An |
829
|
|
|
|
|
|
|
exception will be thrown if there is no prompt message or if Sqitch is |
830
|
|
|
|
|
|
|
unattended and there is no default value. |
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
=head3 C<ask_yes_no> |
833
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
if ( $sqitch->ask_yes_no('Are you sure?', 1) ) { # do it! } |
835
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
Prompts the user with a "yes" or "no" question. Returns true if the user |
837
|
|
|
|
|
|
|
replies in the affirmative and false if the reply is in the negative. If the |
838
|
|
|
|
|
|
|
optional second argument is passed and true, the answer will default to the |
839
|
|
|
|
|
|
|
affirmative. If the second argument is passed but false, the answer will |
840
|
|
|
|
|
|
|
default to the negative. When a translation library is in use, the affirmative |
841
|
|
|
|
|
|
|
and negative replies from the user should be localized variants of "yes" and |
842
|
|
|
|
|
|
|
"no", and will be matched as such. If no translation library is in use, the |
843
|
|
|
|
|
|
|
answers will default to the English "yes" and "no". |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
If the user inputs an invalid value three times, an exception will be thrown. |
846
|
|
|
|
|
|
|
An exception will also be thrown if there is no message. As with C<prompt()>, |
847
|
|
|
|
|
|
|
an exception will be thrown if Sqitch is running unattended and there is no |
848
|
|
|
|
|
|
|
default. |
849
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
=head3 C<ask_y_n> |
851
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
This method has been deprecated in favor of C<ask_yes_no()> and will be |
853
|
|
|
|
|
|
|
removed in a future version of Sqitch. |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
=head2 Constants |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
=head3 C<ISWIN> |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
my $app = 'sqitch' . ( ISWIN ? '.bat' : '' ); |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
True when Sqitch is running on Windows, and false when it's not. |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
=head1 Author |
865
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
David E. Wheeler <david@justatheory.com> |
867
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
=head1 License |
869
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
Copyright (c) 2012-2022 iovation Inc., David E. Wheeler |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
Permission is hereby granted, free of charge, to any person obtaining a copy |
873
|
|
|
|
|
|
|
of this software and associated documentation files (the "Software"), to deal |
874
|
|
|
|
|
|
|
in the Software without restriction, including without limitation the rights |
875
|
|
|
|
|
|
|
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell |
876
|
|
|
|
|
|
|
copies of the Software, and to permit persons to whom the Software is |
877
|
|
|
|
|
|
|
furnished to do so, subject to the following conditions: |
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
The above copyright notice and this permission notice shall be included in all |
880
|
|
|
|
|
|
|
copies or substantial portions of the Software. |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR |
883
|
|
|
|
|
|
|
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, |
884
|
|
|
|
|
|
|
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE |
885
|
|
|
|
|
|
|
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER |
886
|
|
|
|
|
|
|
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, |
887
|
|
|
|
|
|
|
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE |
888
|
|
|
|
|
|
|
SOFTWARE. |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
=cut |