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