File Coverage

blib/lib/App/Sqitch.pm
Criterion Covered Total %
statement 240 240 100.0
branch 61 66 92.4
condition 11 18 61.1
subroutine 65 67 97.0
pod 17 17 100.0
total 394 408 96.5


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