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   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