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