• Home
  • Features
  • Pricing
  • Docs
  • Announcements
  • Sign In

sqitchers / sqitch / 17898255726

21 Sep 2025 07:57PM UTC coverage: 99.978% (-0.02%) from 100.0%
17898255726

Pull #905

github

web-flow
Merge cbcc55712 into 16d3838e1
Pull Request #905: Adjust workflow `push` and `pull_request` triggers

4584 of 4585 relevant lines covered (99.98%)

70.86 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

99.52
/lib/App/Sqitch.pm
1
package App::Sqitch;
2

3
# ABSTRACT: Sensible database change management
4

5
use 5.010;
46✔
6
use strict;
46✔
7
use warnings;
46✔
8
use utf8;
46✔
9
use Getopt::Long;
46✔
10
use Hash::Merge qw(merge);
46✔
11
use Path::Class;
46✔
12
use Config;
46✔
13
use Locale::TextDomain 1.20 qw(App-Sqitch);
46✔
14
use Locale::Messages qw(bind_textdomain_filter);
46✔
15
use App::Sqitch::X qw(hurl);
46✔
16
use Moo 1.002000;
46✔
17
use Type::Utils qw(where declare);
46✔
18
use App::Sqitch::Types qw(Str UserName UserEmail Maybe Config HashRef);
46✔
19
use Encode ();
46✔
20
use Try::Tiny;
46✔
21
use List::Util qw(first);
46✔
22
use IPC::System::Simple 1.17 qw(runx capturex $EXITVAL);
46✔
23
use namespace::autoclean 0.16;
46✔
24
use constant ISWIN => $^O eq 'MSWin32';
46✔
25

26
# VERSION
27

28
BEGIN {
29
    # Force Locale::TextDomain to encode in UTF-8 and to decode all messages.
30
    $ENV{OUTPUT_CHARSET} = 'UTF-8';
46✔
31
    bind_textdomain_filter 'App-Sqitch' => \&Encode::decode_utf8, Encode::FB_DEFAULT;
46✔
32
}
33

34
# Okay to load Sqitch classes now that types are created.
35
use App::Sqitch::Config;
46✔
36
use App::Sqitch::Command;
46✔
37
use App::Sqitch::Plan;
46✔
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
        binmode $fh, ':utf8_strict';
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
    my $class = shift;
1✔
181
    my @args = @ARGV;
1✔
182

183
    # 1. Parse core options.
184
    my $opts = $class->_parse_core_opts(\@args);
1✔
185

186
    # 2. Load config.
187
    my $config = App::Sqitch::Config->new;
8✔
188

189
    # 3. Instantiate Sqitch.
190
    my $sqitch = $class->new({ options => $opts, config  => $config });
8✔
191

192
    # 4. Find the command.
193
    my $cmd = $class->_find_cmd(\@args);
8✔
194

195
    # 5. Instantiate the command object.
196
    my $command = $cmd->create({
8✔
197
        sqitch => $sqitch,
198
        config => $config,
199
        args   => \@args,
200
    });
201

202
    # IO::Pager respects the PAGER environment variable.
203
    local $ENV{PAGER} = $sqitch->pager_program;
8✔
204

205
    # 6. Execute command.
206
    return try {
207
        $command->execute( @args ) ? 0 : 2;
8✔
208
    } catch {
209
        # Just bail for unknown exceptions.
210
        $sqitch->vent($_) && return 2 unless eval { $_->isa('App::Sqitch::X') };
8✔
211

212
        # It's one of ours.
213
        if ($_->exitval == 1) {
8✔
214
            # Non-fatal exception; just send the message to info.
215
            $sqitch->info($_->message);
6✔
216
        } elsif ($_->ident eq 'DEV') {
217
            # Vent complete details of fatal DEV error.
218
            $sqitch->vent($_->as_string);
6✔
219
        } else {
220
            # Vent fatal error message, trace details.
221
            $sqitch->vent($_->message);
5✔
222
            $sqitch->trace($_->details_string);
1✔
223
        }
224

225
        # Bail.
226
        return $_->exitval;
2✔
227
    };
8✔
228
}
229

230
sub _core_opts {
231
    return qw(
34✔
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
    my ( $self, $args ) = @_;
14✔
245
    my %opts;
17✔
246
    Getopt::Long::Configure(qw(bundling pass_through));
20✔
247
    Getopt::Long::GetOptionsFromArray(
248
        $args,
249
        map {
250
            ( my $k = $_ ) =~ s/[|=+:!].*//;
20✔
251
            $k =~ s/-/_/g;
104✔
252
            $_ => \$opts{$k};
104✔
253
        } $self->_core_opts
254
    ) or $self->_pod2usage('sqitchusage', '-verbose' => 99 );
255

256
    # Handle documentation requests.
257
    if ($opts{help} || $opts{man}) {
76✔
258
        $self->_pod2usage(
259
            $opts{help} ? 'sqitchcommands' : 'sqitch',
66✔
260
            '-exitval' => 0,
261
            '-verbose' => 2,
262
        );
263
    }
264

265
    # Handle version request.
266
    if ( delete $opts{version} ) {
76✔
267
        $self->emit( _bn($0), ' (', __PACKAGE__, ') ', __PACKAGE__->VERSION );
9✔
268
        exit;
1✔
269
    }
270

271
    # Handle --etc-path.
272
    if ( $opts{etc_path} ) {
19✔
273
        $self->emit( App::Sqitch::Config->class->system_dir );
1✔
274
        exit;
1✔
275
    }
276

277
    # Handle --chdir
278
    if ( my $dir = delete $opts{chdir} ) {
18✔
279
        chdir $dir or hurl fs => __x(
4✔
280
            'Cannot change to directory {directory}: {error}',
281
            directory => $dir,
282
            error   => $!,
283
        );
284
    }
285

286
    # Normalize the options (remove undefs) and return.
287
    $opts{verbosity} = delete $opts{verbose};
9✔
288
    $opts{verbosity} = 0 if delete $opts{quiet};
17✔
289
    delete $opts{$_} for grep { !defined $opts{$_} } keys %opts;
9✔
290
    return \%opts;
17✔
291
}
292

293
sub _find_cmd {
294
    my ( $class, $args ) = @_;
27✔
295
    my (@tried, $prev);
59✔
296
    for (my $i = 0; $i <= $#$args; $i++) {
27✔
297
        my $arg = $args->[$i] or next;
48✔
298
        if ($arg =~ /^-/) {
48✔
299
            last if $arg eq '--';
31✔
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
            $i++ if $arg =~ /^(?:-[duhp])|(?:--(?:db-\w+|client|engine|extension|plan-file|registry|top-dir))$/;
30✔
304
            next;
30✔
305
        }
306
        push @tried => $arg;
17✔
307
        my $cmd = try { App::Sqitch::Command->class_for($class, $arg) } or next;
17✔
308
        splice @{ $args }, $i, 1;
20✔
309
        return $cmd;
20✔
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
    )) for @tried;
15✔
317
    $class->_pod2usage('sqitchcommands');
15✔
318
}
319

320
sub _pod2usage {
321
    my ( $self, $doc ) = ( shift, shift );
9✔
322
    require App::Sqitch::Command::help;
1✔
323
    # Help does not need the Sqitch command; since it's required, fake it.
324
    my $help = App::Sqitch::Command::help->new( sqitch => bless {}, $self );
1✔
325
    $help->find_and_show( $doc || 'sqitch', '-exitval' => 2, @_ );
1✔
326
}
327

328
sub run {
329
    my $self = shift;
22✔
330
    local $SIG{__DIE__} = sub {
331
        ( my $msg = shift ) =~ s/\s+at\s+.+/\n/ms;
×
332
        hurl ipc => $msg;
2✔
333
    };
22✔
334
    if (ISWIN && IPC::System::Simple->VERSION < 1.28) {
24✔
335
        runx ( shift, $self->quote_shell(@_) );
336
        return $self;
337
    }
338
    runx @_;
23✔
339
    return $self;
23✔
340
}
341

342
sub shell {
343
    my ($self, $cmd) = @_;
2✔
344
    local $SIG{__DIE__} = sub {
345
        ( my $msg = shift ) =~ s/\s+at\s+.+/\n/ms;
1✔
346
        hurl ipc => $msg;
2✔
347
    };
2✔
348
    IPC::System::Simple::run $cmd;
2✔
349
    return $self;
1✔
350
}
351

352
sub quote_shell {
353
    my $self = shift;
8✔
354
    if (ISWIN) {
9✔
355
        require Win32::ShellQuote;
356
        return Win32::ShellQuote::quote_native(@_);
357
    }
358
    require String::ShellQuote;
8✔
359
    return String::ShellQuote::shell_quote(@_);
9✔
360
}
361

362
sub capture {
363
    my $self = shift;
48✔
364
    local $SIG{__DIE__} = sub {
365
        ( my $msg = shift ) =~ s/\s+at\s+.+/\n/ms;
2✔
366
        hurl ipc => $msg;
3✔
367
    };
48✔
368
    return capturex ( shift, $self->quote_shell(@_) )
49✔
369
        if ISWIN && IPC::System::Simple->VERSION <= 1.25;
370
    capturex @_;
47✔
371
}
372

373
sub _is_interactive {
374
  return -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT)) ;   # Pipe?
1✔
375
}
376

377
sub _is_unattended {
378
    my $self = shift;
3✔
379
    return !$self->_is_interactive && eof STDIN;
3✔
380
}
381

382
sub _readline {
383
    my $self = shift;
2✔
384
    return undef if $self->_is_unattended;
1✔
385
    my $answer = <STDIN>;
1✔
386
    chomp $answer if defined $answer;
2✔
387
    return $answer;
2✔
388
}
389

390
sub prompt {
391
    my $self = shift;
1✔
392
    my $msg  = shift or hurl 'prompt() called without a prompt message';
1✔
393

394
    # use a list to distinguish a default of undef() from no default
395
    my @def;
1✔
396
    @def = (shift) if @_;
32✔
397
    # use dispdef for output
398
    my @dispdef = scalar(@def)
32✔
399
        ? ('[', (defined($def[0]) ? $def[0] : ''), '] ')
400
        : ('', '');
401

402
    # Don't use emit because it adds a newline.
403
    local $|=1;
31✔
404
    print $msg, ' ', @dispdef;
31✔
405

406
    if ($self->_is_unattended) {
31✔
407
        hurl io => __(
31✔
408
            'Sqitch seems to be unattended and there is no default value for this question'
409
        ) unless @def;
410
        print "$dispdef[1]\n";
31✔
411
    }
412

413
    my $ans = $self->_readline;
31✔
414

415
    if ( !defined $ans or !length $ans ) {
2✔
416
        # Ctrl-D or user hit return;
417
        $ans = @def ? $def[0] : '';
1✔
418
    }
419

420
    return $ans;
30✔
421
}
422

423
sub ask_yes_no {
424
    my ($self, @msg) = (shift, shift);
30✔
425
    hurl 'ask_yes_no() called without a prompt message' unless $msg[0];
7✔
426

427
    my $y = __p 'Confirm prompt answer yes', 'Yes';
30✔
428
    my $n = __p 'Confirm prompt answer no',  'No';
22✔
429
    push @msg => $_[0] ? $y : $n if @_;
22✔
430

431
    my $answer;
20✔
432
    my $i = 3;
20✔
433
    while ($i--) {
20✔
434
        $answer = $self->prompt(@msg);
20✔
435
        return 1 if $y =~ /^\Q$answer/i;
20✔
436
        return 0 if $n =~ /^\Q$answer/i;
20✔
437
        $self->emit(__ 'Please answer "y" or "n".');
24✔
438
    }
439

440
    hurl io => __ 'No valid answer after 3 attempts; aborting';
24✔
441
}
442

443
sub ask_y_n {
444
    my $self = shift;
15✔
445
    $self->warn('The ask_y_n() method has been deprecated. Use ask_yes_no() instead.');
6✔
446
    return $self->ask_yes_no(@_) unless @_ > 1;
2✔
447

448
    my ($msg, $def) = @_;
9✔
449
    hurl 'Invalid default value: ask_y_n() default must be "y" or "n"'
9✔
450
        if $def && $def !~ /^[yn]/i;
451
    return $self->ask_yes_no($msg, $def =~ /^y/i ? 1 : 0);
9✔
452
}
453

454
sub spool {
455
    my ($self, $fh) = (shift, shift);
3✔
456
    local $SIG{__WARN__} = sub { }; # Silence warning.
3✔
457
    my $pipe;
2✔
458
    if (ISWIN) {
4✔
459
        no warnings;
46✔
460
        open $pipe, '|' . $self->quote_shell(@_) or hurl io => __x(
461
            'Cannot exec {command}: {error}',
462
            command => $_[0],
463
            error   => $!,
464
        );
465
    } else {
466
        no warnings;
46✔
467
        open $pipe, '|-', @_ or hurl io => __x(
4✔
468
            'Cannot exec {command}: {error}',
469
            command => $_[0],
470
            error   => $!,
471
        );
472
    }
473

474
    local $SIG{PIPE} = sub { die 'spooler pipe broke' };
4✔
475
    if (ref $fh eq 'ARRAY') {
4✔
476
        for my $h (@{ $fh }) {
3✔
477
            print $pipe $_ while <$h>;
3✔
478
        }
479
    } else {
480
        print $pipe $_ while <$fh>;
1✔
481
    }
482

483
    close $pipe or hurl io => $! ? __x(
1✔
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
    return $self;
2✔
493
}
494

495
sub probe {
496
    my ($ret) = shift->capture(@_);
24✔
497
    chomp $ret if $ret;
25✔
498
    return $ret;
24✔
499
}
500

501
sub _bn {
502
    require File::Basename;
2✔
503
    File::Basename::basename($0);
2✔
504
}
505

506
sub _prepend {
507
    my $prefix = shift;
11✔
508
    my $msg = join '', map { $_ // '' } @_;
11✔
509
    $msg =~ s/^/$prefix /gms;
20✔
510
    return $msg;
20✔
511
}
512

513
sub page {
514
    my $pager = shift->pager;
30✔
515
    return $pager->say(@_);
10✔
516
}
517

518
sub page_literal {
519
    my $pager = shift->pager;
10✔
520
    return $pager->print(@_);
1✔
521
}
522

523
sub trace {
524
    my $self = shift;
3✔
525
    $self->emit( _prepend 'trace:', @_ ) if $self->verbosity > 2;
3✔
526
}
527

528
sub trace_literal {
529
    my $self = shift;
3✔
530
    $self->emit_literal( _prepend 'trace:', @_ ) if $self->verbosity > 2;
4✔
531
}
532

533
sub debug {
534
    my $self = shift;
32✔
535
    $self->emit( _prepend 'debug:', @_ ) if $self->verbosity > 1;
32✔
536
}
537

538
sub debug_literal {
539
    my $self = shift;
4✔
540
    $self->emit_literal( _prepend 'debug:', @_ ) if $self->verbosity > 1;
4✔
541
}
542

543
sub info {
544
    my $self = shift;
4✔
545
    $self->emit(@_) if $self->verbosity;
4✔
546
}
547

548
sub info_literal {
549
    my $self = shift;
4✔
550
    $self->emit_literal(@_) if $self->verbosity;
4✔
551
}
552

553
sub comment {
554
    my $self = shift;
4✔
555
    $self->emit( _prepend '#', @_ );
4✔
556
}
557

558
sub comment_literal {
559
    my $self = shift;
4✔
560
    $self->emit_literal( _prepend '#', @_ );
4✔
561
}
562

563
sub emit {
564
    shift;
9✔
565
    local $|=1;
9✔
566
    say @_;
9✔
567
}
568

569
sub emit_literal {
570
    shift;
28✔
571
    local $|=1;
28✔
572
    print @_;
28✔
573
}
574

575
sub vent {
576
    shift;
10✔
577
    my $fh = select;
10✔
578
    select STDERR;
10✔
579
    local $|=1;
5✔
580
    say STDERR @_;
5✔
581
    select $fh;
5✔
582
}
583

584
sub vent_literal {
585
    shift;
3✔
586
    my $fh = select;
3✔
587
    select STDERR;
3✔
588
    local $|=1;
3✔
589
    print STDERR @_;
3✔
590
    select $fh;
3✔
591
}
592

593
sub warn {
594
    my $self = shift;
3✔
595
    $self->vent(_prepend 'warning:', @_);
3✔
596
}
597

598
sub warn_literal {
599
    my $self = shift;
3✔
600
    $self->vent_literal(_prepend 'warning:', @_);
2✔
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-2025 David E. Wheeler, 2012-2021 iovation Inc.
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
STATUS · Troubleshooting · Open an Issue · Sales · Support · CAREERS · ENTERPRISE · START FREE · SCHEDULE DEMO
ANNOUNCEMENTS · TWITTER · TOS & SLA · Supported CI Services · What's a CI service? · Automated Testing

© 2025 Coveralls, Inc