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              
2             # ABSTRACT: Sensible database change management
3              
4             use 5.010;
5 50     50   4892370 use strict;
  50         584  
6 50     50   357 use warnings;
  50         85  
  50         1073  
7 50     50   213 use utf8;
  50         81  
  50         1332  
8 50     50   6682 use Getopt::Long;
  50         223  
  50         293  
9 50     50   32644 use Hash::Merge qw(merge);
  50         510174  
  50         223  
10 50     50   29383 use Path::Class;
  50         405233  
  50         2663  
11 50     50   16960 use Config;
  50         1275685  
  50         2520  
12 50     50   413 use Locale::TextDomain 1.20 qw(App-Sqitch);
  50         87  
  50         1853  
13 50     50   19707 use Locale::Messages qw(bind_textdomain_filter);
  50         618731  
  50         314  
14 50     50   872083 use App::Sqitch::X qw(hurl);
  50         104  
  50         2027  
15 50     50   18220 use Moo 1.002000;
  50         156  
  50         255  
16 50     50   12086 use Type::Utils qw(where declare);
  50         1210  
  50         270  
17 50     50   41773 use App::Sqitch::Types qw(Str UserName UserEmail Maybe Config HashRef);
  50         218528  
  50         479  
18 50     50   47813 use Encode ();
  50         156  
  50         588  
19 50     50   69306 use Try::Tiny;
  50         100  
  50         807  
20 50     50   18547 use List::Util qw(first);
  50         44496  
  50         2545  
21 50     50   324 use IPC::System::Simple 1.17 qw(runx capturex $EXITVAL);
  50         91  
  50         2638  
22 50     50   24493 use namespace::autoclean 0.16;
  50         269001  
  50         6531  
23 50     50   21866 use constant ISWIN => $^O eq 'MSWin32';
  50         509323  
  50         243  
24 50     50   3381  
  50         124  
  50         4652  
25             our $VERSION = 'v1.3.0'; # 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   547 bind_textdomain_filter 'App-Sqitch' => \&Encode::decode_utf8, Encode::FB_DEFAULT;
31 50         310 }
32              
33             # Okay to load Sqitch classes now that types are created.
34             use App::Sqitch::Config;
35 50     50   1546 use App::Sqitch::Command;
  50         113  
  50         1077  
36 50     50   22275 use App::Sqitch::Plan;
  50         130  
  50         1536  
37 50     50   27619  
  50         151  
  50         146673  
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   571  
  2         25  
  2         1018  
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 23020  
181 6         24 # 1. Parse core options.
182             my $opts = $class->_parse_core_opts(\@args);
183              
184 6         34 # 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         391 # 4. Find the command.
191             my $cmd = $class->_find_cmd(\@args);
192              
193 6         378 # 5. Instantiate the command object.
194             my $command = $cmd->create({
195             sqitch => $sqitch,
196 6         56 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         3654 # 6. Execute command.
204             return try {
205             $command->execute( @args ) ? 0 : 2;
206             } catch {
207 6 50   6   393 # Just bail for unknown exceptions.
208             $sqitch->vent($_) && return 2 unless eval { $_->isa('App::Sqitch::X') };
209              
210 4 100 50 4   59 # It's one of ours.
  4         21  
211             if ($_->exitval == 1) {
212             # Non-fatal exception; just send the message to info.
213 3 100       9 $sqitch->info($_->message);
214             } else {
215 1         6 # Fatal exception; vent.
216             $sqitch->vent($_->message);
217              
218 2         24 # 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       13 }
222 2         39  
223             # Bail.
224             return $_->exitval;
225             };
226 3         323 }
227 6         948  
228             return qw(
229             chdir|cd|C=s
230             etc-path
231 38     38   2814 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   5082 $args,
245 18         33 map {
246 18         67 ( my $k = $_ ) =~ s/[|=+:!].*//;
247             $k =~ s/-/_/g;
248             $_ => \$opts{$k};
249             } $self->_core_opts
250 18 50       668 ) or $self->_pod2usage('sqitchusage', '-verbose' => 99 );
  144         279  
251 144         213  
252 144         331 # Handle documentation requests.
253             if ($opts{help} || $opts{man}) {
254             $self->_pod2usage(
255             $opts{help} ? 'sqitchcommands' : 'sqitch',
256             '-exitval' => 0,
257 18 100 100     9469 '-verbose' => 2,
258             );
259 2 100       10 }
260              
261             # Handle version request.
262             if ( delete $opts{version} ) {
263             $self->emit( _bn($0), ' (', __PACKAGE__, ') ', __PACKAGE__->VERSION );
264             exit;
265             }
266 18 100       54  
267 1         11 # Handle --etc-path.
268 1         11 if ( $opts{etc_path} ) {
269             $self->emit( App::Sqitch::Config->class->system_dir );
270             exit;
271             }
272 17 100       40  
273 1         4 # Handle --chdir
274 1         128 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       36 error => $!,
279 4 100       11 );
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         43 }
288 15 100       28  
289 15         47 my ( $class, $args ) = @_;
  75         141  
290 15         78 my (@tried, $prev);
291             for (my $i = 0; $i <= $#$args; $i++) {
292             my $arg = $args->[$i] or next;
293             if ($arg =~ /^-/) {
294 25     25   10974 last if $arg eq '--';
295 25         38 # Skip the next argument if this looks like a pre-0.9999 option.
296 25         83 # There shouldn't be many since we now recommend putting options
297 46 50       89 # after the command. XXX Remove at some future date.
298 46 100       118 $i++ if $arg =~ /^(?:-[duhp])|(?:--(?:db-\w+|client|engine|extension|plan-file|registry|top-dir))$/;
299 23 100       43 next;
300             }
301             push @tried => $arg;
302             my $cmd = try { App::Sqitch::Command->class_for($class, $arg) } or next;
303 22 50       73 splice @{ $args }, $i, 1;
304 22         44 return $cmd;
305             }
306 23         48  
307 23 100   23   134 # No valid command found. Report those we tried.
  23         1276  
308 18         250 $class->vent(__x(
  18         49  
309 18         88 '"{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         163 require App::Sqitch::Command::help;
317 7         713 # 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   35315  
322 1         6 my $self = shift;
323             local $SIG{__DIE__} = sub {
324 1         9 ( my $msg = shift ) =~ s/\s+at\s+.+/\n/ms;
325 1   50     2425 die $msg;
326             };
327             if (ISWIN && IPC::System::Simple->VERSION < 1.28) {
328             runx ( shift, $self->quote_shell(@_) );
329 2     2 1 6701 return $self;
330             }
331 1     1   9911 runx @_;
332 1         78 return $self;
333 2         27 }
334 2         9  
335             my ($self, $cmd) = @_;
336             local $SIG{__DIE__} = sub {
337             ( my $msg = shift ) =~ s/\s+at\s+.+/\n/ms;
338 2         18 die $msg;
339 1         5254 };
340             IPC::System::Simple::run $cmd;
341             return $self;
342             }
343 2     2   5699  
344             my $self = shift;
345 1     1   6885 if (ISWIN) {
346 1         57 require Win32::ShellQuote;
347 2         25 return Win32::ShellQuote::quote_native(@_);
348 2         14 }
349 1         9221 require String::ShellQuote;
350             return String::ShellQuote::shell_quote(@_);
351             }
352              
353 5     5   7494 my $self = shift;
354 5         19 local $SIG{__DIE__} = sub {
355             ( my $msg = shift ) =~ s/\s+at\s+.+/\n/ms;
356             die $msg;
357             };
358 5         1796 return capturex ( shift, $self->quote_shell(@_) )
359 5         2766 if ISWIN && IPC::System::Simple->VERSION <= 1.25;
360             capturex @_;
361             }
362              
363 13     13 1 8196 return -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ; # Pipe?
364             }
365 6     6   31157  
366 6         11119802 my $self = shift;
367 13         119 return !$self->_is_interactive && eof STDIN;
368 13         34 }
369              
370 13         81 my $self = shift;
371             return undef if $self->_is_unattended;
372             my $answer = <STDIN>;
373             chomp $answer if defined $answer;
374 2   33 2   1335 return $answer;
375             }
376              
377             my $self = shift;
378 1     1   309 my $msg = shift or hurl 'prompt() called without a prompt message';
379 1   33     3  
380             # use a list to distinguish a default of undef() from no default
381             my @def;
382             @def = (shift) if @_;
383 2     2   2190 # use dispdef for output
384 2 100       8 my @dispdef = scalar(@def)
385 1         13 ? ('[', (defined($def[0]) ? $def[0] : ''), '] ')
386 1 50       4 : ('', '');
387 1         6  
388             # Don't use emit because it adds a newline.
389             local $|=1;
390             print $msg, ' ', @dispdef;
391 1     1 1 21  
392 4 100       6382 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       4392 print "$dispdef[1]\n";
397             }
398 4 100       72  
    100          
399             my $ans = $self->_readline;
400              
401             if ( !defined $ans or !length $ans ) {
402             # Ctrl-D or user hit return;
403 18         4567 $ans = @def ? $def[0] : '';
404 18         371 }
405              
406 4 100       4383 return $ans;
407 4 100       78 }
408              
409             my ($self, @msg) = (shift, shift);
410 4         4379 hurl 'ask_yes_no() called without a prompt message' unless $msg[0];
411              
412             my $y = __p 'Confirm prompt answer yes', 'Yes';
413 4         71 my $n = __p 'Confirm prompt answer no', 'No';
414             push @msg => $_[0] ? $y : $n if @_;
415 4         4367  
416             my $answer;
417 4         71 my $i = 3;
418             while ($i--) {
419             $answer = $self->prompt(@msg);
420 4         4656 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 13  
425 4         4328 hurl io => __ 'No valid answer after 3 attempts; aborting';
426             }
427 4         15  
428 20         5707 my $self = shift;
429 20         82 $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         665  
432 18         6931 my ($msg, $def) = @_;
433 18         72 hurl 'Invalid default value: ask_y_n() default must be "y" or "n"'
434 18         580 if $def && $def !~ /^[yn]/i;
435 5         1558 return $self->ask_yes_no($msg, $def =~ /^y/i ? 1 : 0);
436 5         40 }
437 5         29  
438             my ($self, $fh) = (shift, shift);
439             local $SIG{__WARN__} = sub { }; # Silence warning.
440 5         55 my $pipe;
441             if (ISWIN) {
442             no warnings;
443             open $pipe, '|' . $self->quote_shell(@_) or hurl io => __x(
444 41     41 1 41057 'Cannot exec {command}: {error}',
445 41         113 command => $_[0],
446 40 100       104 error => $!,
447             );
448 34         83 } else {
449 34 100 100     159 no warnings;
450             open $pipe, '|-', @_ or hurl io => __x(
451 33 100       127 'Cannot exec {command}: {error}',
452             command => $_[0],
453             error => $!,
454             );
455 35     26 1 10482 }
456 35     0   194  
457 6         32 local $SIG{PIPE} = sub { die 'spooler pipe broke' };
458 5         35 if (ref $fh eq 'ARRAY') {
459 50     50   514 for my $h (@{ $fh }) {
  50         111  
  50         4617  
460             print $pipe $_ while <$h>;
461             }
462             } else {
463             print $pipe $_ while <$fh>;
464             }
465              
466 50     50   374 close $pipe or hurl io => $! ? __x(
  50         120  
  50         45472  
467 34 100       13624 '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         23  
475 33 100       172 return $self;
476 23         26414 }
  23         82  
477 22         105  
478             my ($ret) = shift->capture(@_);
479             chomp $ret if $ret;
480 22         1273 return $ret;
481             }
482              
483 23 100       6308 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         230  
493             my $pager = shift->pager;
494             return $pager->say(@_);
495             }
496 27     7 1 4518  
497 22 100       19883 my $pager = shift->pager;
498 26         179 return $pager->print(@_);
499             }
500              
501             my $self = shift;
502 26     2   631 $self->emit( _prepend 'trace:', @_ ) if $self->verbosity > 2;
503 17         316 }
504              
505             my $self = shift;
506             $self->emit_literal( _prepend 'trace:', @_ ) if $self->verbosity > 2;
507 26     20   252 }
508 22   50     56  
  60         168  
509 20         137 my $self = shift;
510 20         92 $self->emit( _prepend 'debug:', @_ ) if $self->verbosity > 1;
511             }
512              
513             my $self = shift;
514 5     4 1 247 $self->emit_literal( _prepend 'debug:', @_ ) if $self->verbosity > 1;
515 5         80 }
516              
517             my $self = shift;
518             $self->emit(@_) if $self->verbosity;
519 3     18 1 1564 }
520 3         10  
521             my $self = shift;
522             $self->emit_literal(@_) if $self->verbosity;
523             }
524 3     4   7  
525 3         12 my $self = shift;
526             $self->emit( _prepend '#', @_ );
527             }
528              
529 3     4 1 76 my $self = shift;
530 3         36 $self->emit_literal( _prepend '#', @_ );
531             }
532              
533             shift;
534 2     4 1 3113 local $|=1;
535 2         23 say @_;
536             }
537              
538             shift;
539 2     4 1 3128 local $|=1;
540 2         13 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