view release on metacpan or  search on metacpan

lib/App/Sqitch.pm  view on Meta::CPAN

    );
}

sub _parse_core_opts {
    my ( $self, $args ) = @_;
    my %opts;
    Getopt::Long::Configure(qw(bundling pass_through));
    Getopt::Long::GetOptionsFromArray(
        $args,
        map {
            ( my $k = $_ ) =~ s/[|=+:!].*//;
            $k =~ s/-/_/g;
            $_ => \$opts{$k};
        } $self->_core_opts
    ) or $self->_pod2usage('sqitchusage', '-verbose' => 99 );

    # Handle documentation requests.
    if ($opts{help} || $opts{man}) {
        $self->_pod2usage(
            $opts{help} ? 'sqitchcommands' : 'sqitch',
            '-exitval' => 0,
            '-verbose' => 2,
        );
    }

    # Handle version request.
    if ( delete $opts{version} ) {
        $self->emit( _bn($0), ' (', __PACKAGE__, ') ', __PACKAGE__->VERSION );
        exit;
    }

    # Handle --etc-path.
    if ( $opts{etc_path} ) {
        $self->emit( App::Sqitch::Config->class->system_dir );
        exit;
    }

    # Handle --chdir
    if ( my $dir = delete $opts{chdir} ) {
        chdir $dir or hurl fs => __x(
            'Cannot change to directory {directory}: {error}',
            directory => $dir,
            error   => $!,
        );
    }

    # Normalize the options (remove undefs) and return.
    $opts{verbosity} = delete $opts{verbose};
    $opts{verbosity} = 0 if delete $opts{quiet};
    delete $opts{$_} for grep { !defined $opts{$_} } keys %opts;
    return \%opts;
}

sub _find_cmd {
    my ( $class, $args ) = @_;
    my (@tried, $prev);
    for (my $i = 0; $i <= $#$args; $i++) {
        my $arg = $args->[$i] or next;
        if ($arg =~ /^-/) {
            last if $arg eq '--';
            # Skip the next argument if this looks like a pre-0.9999 option.
            # There shouldn't be many since we now recommend putting options
            # after the command. XXX Remove at some future date.
            $i++ if $arg =~ /^(?:-[duhp])|(?:--(?:db-\w+|client|engine|extension|plan-file|registry|top-dir))$/;
            next;
        }
        push @tried => $arg;
        my $cmd = try { App::Sqitch::Command->class_for($class, $arg) } or next;
        splice @{ $args }, $i, 1;
        return $cmd;
    }

    # No valid command found. Report those we tried.
    $class->vent(__x(
        '"{command}" is not a valid command',
        command => $_,
    )) for @tried;
    $class->_pod2usage('sqitchcommands');
}

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

sub run {
    my $self = shift;
    local $SIG{__DIE__} = sub {
        ( my $msg = shift ) =~ s/\s+at\s+.+/\n/ms;
        hurl ipc => $msg;
    };
    if (ISWIN && IPC::System::Simple->VERSION < 1.28) {
        runx ( shift, $self->quote_shell(@_) );
        return $self;
    }
    runx @_;
    return $self;
}

sub shell {
    my ($self, $cmd) = @_;
    local $SIG{__DIE__} = sub {
        ( my $msg = shift ) =~ s/\s+at\s+.+/\n/ms;
        hurl ipc => $msg;
    };
    IPC::System::Simple::run $cmd;
    return $self;
}

sub quote_shell {
    my $self = shift;
    if (ISWIN) {
        require Win32::ShellQuote;
        return Win32::ShellQuote::quote_native(@_);
    }
    require String::ShellQuote;
    return String::ShellQuote::shell_quote(@_);
}

lib/App/Sqitch.pm  view on Meta::CPAN

=item C<user_email>

=item C<editor>

=item C<verbosity>

=back

=head2 Accessors

=head3 C<user_name>

=head3 C<user_email>

=head3 C<editor>

=head3 C<options>

  my $options = $sqitch->options;

Returns a hashref of the core command-line options.

=head3 C<config>

  my $config = $sqitch->config;

Returns the full configuration, combined from the project, user, and system
configuration files.

=head3 C<verbosity>

=head2 Instance Methods

=head3 C<run>

  $sqitch->run('echo', '-n', 'hello');

Runs a system command and waits for it to finish. Throws an exception on
error. Does not use the shell, so arguments must be passed as a list. Use
C<shell> to run a command and its arguments as a single string.

=over

=item C<target>

The name of the target, as passed.

=item C<uri>

A L<database URI|URI::db> object, to be used to connect to the target
database.


=item C<registry>

The name of the Sqitch registry in the target database.

=back

If the C<$target> argument looks like a database URI, it will simply returned
in the hash reference. If the C<$target> argument corresponds to a target
configuration key, the target configuration will be returned, with the C<uri>
value a upgraded to a L<URI> object. Otherwise returns C<undef>.

=head3 C<shell>

  $sqitch->shell('echo -n hello');

Shells out a system command and waits for it to finish. Throws an exception on
error. Always uses the shell, so a single string must be passed encapsulating
the entire command and its arguments. Use C<quote_shell> to assemble strings
into a single shell command. Use C<run> to execute a list without a shell.

=head3 C<quote_shell>

  my $cmd = $sqitch->quote_shell('echo', '-n', 'hello');

Assemble a list into a single string quoted for execution by C<shell>. Useful
for combining a specified command, such as C<editor()>, which might include
the options in the string, for example:

  $sqitch->shell( $sqitch->editor, $sqitch->quote_shell($file) );

=head3 C<capture>

  my @files = $sqitch->capture(qw(ls -lah));

Runs a system command and captures its output to C<STDOUT>. Returns the output
lines in list context and the concatenation of the lines in scalar context.
Throws an exception on error.

=head3 C<probe>

  my $git_version = $sqitch->capture(qw(git --version));

Like C<capture>, but returns just the C<chomp>ed first line of output.

=head3 C<spool>

  $sqitch->spool($sql_file_handle, 'sqlite3', 'my.db');
  $sqitch->spool(\@file_handles, 'sqlite3', 'my.db');

Like run, but spools the contents of one or ore file handle to the standard
input the system command. Returns true on success and throws an exception on
failure.

=head3 C<trace>

=head3 C<trace_literal>

  $sqitch->trace_literal('About to fuzzle the wuzzle.');
  $sqitch->trace('Done.');

Send trace information to C<STDOUT> if the verbosity level is 3 or higher.
Trace messages will have C<trace: > prefixed to every line. If it's lower than
3, nothing will be output. C<trace> appends a newline to the end of the
message while C<trace_literal> does not.

=head3 C<debug>