App-Sqitch

 view release on metacpan or  search on metacpan

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

    isa      => Bool,
    lazy     => 1,
    default  => sub {
        shift->sqitch->config->get(
            key => 'add.open_editor',
            as  => 'bool',
        ) // 0;
    },
);

sub _check_script($) {
    my $file = file shift;

    hurl add => __x(
        'Template {template} does not exist',
        template => $file,
    ) unless -e $file;

    hurl add => __x(
        'Template {template} is not a file',
        template => $file,

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

use Path::Class qw(file dir);
use List::Util qw(max first);
use namespace::autoclean;
use constant extra_target_keys => qw(target);

extends 'App::Sqitch::Command';
with 'App::Sqitch::Role::TargetConfigCommand';

our $VERSION = 'v1.5.2'; # VERSION

sub _chk_engine($) {
    my $engine = shift;
    hurl engine => __x(
        'Unknown engine "{engine}"', engine => $engine
    ) unless first { $engine eq $_ } App::Sqitch::Command::ENGINES;
}

sub configure {
    # No config; engine config is actually engines.
    return {};
}

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

sub local_file {
    return file $ENV{SQITCH_CONFIG} if $ENV{SQITCH_CONFIG};
    return file shift->confname;
}

sub dir_file { shift->local_file }

# Section keys always have the top section lowercase, and subsections are
# left as-is.
sub _skey($) {
    my $key = shift // return '';
    my ($sec, $sub, $name) = Config::GitLike::_split_key($key);
    return lc $key unless $sec;
    return lc($sec) . '.' . join '.',   grep { defined } $sub, $name;
}

sub get_section {
    my ( $self, %p ) = @_;
    $self->load unless $self->is_loaded;
    my $section = _skey $p{section};

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

            length $_->format_name_with_tags
        } ($plan->changes)[$position + 1..$to_index]
    );

    $self->$meth( $plan, $to_index );
}

# Do a thing similar to Sqitch::Plan::Change::format_name_with_tags,
# but for an output from $self->deployed_changes or
# $self->deployed_changes_since.
sub _format_deployed_change_name_with_tags($) {
    my ( $self, $change ) = @_;

    return join ' ', $change->{name}, map { '@' . $_ } @{$change->{tags}};
}

sub revert {
    # $to = revert up to (but not including) this change. May be undefined.
    # $prompt = If true, we ask for confirmation; if false, we don't.
    # $prompt_default = Default if the user just hits enter at the prompt.
    my ( $self, $to, $prompt, $prompt_default ) = @_;

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

use Locale::TextDomain qw(App-Sqitch);
use App::Sqitch::Types qw(DBH Dir ArrayRef);
use App::Sqitch::Plan::Change;
use List::Util qw(first);
use namespace::autoclean;

extends 'App::Sqitch::Engine';

our $VERSION = 'v1.5.2'; # VERSION

sub _dt($) {
    require App::Sqitch::DateTime;
    return App::Sqitch::DateTime->new(split /:/ => shift);
}

sub key    { 'exasol' }
sub name   { 'Exasol' }
sub driver { 'DBD::ODBC 1.59' }
sub default_client { 'exaplus' }

BEGIN {

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

# Override to unlock the tables, otherwise future transactions on this
# connection can fail.
sub finish_work {
    my $self = shift;
    my $dbh = $self->dbh;
    $dbh->commit;
    $dbh->func( 'ib_set_tx_param' );         # reset parameters
    return $self;
}

sub _dt($) {
    require App::Sqitch::DateTime;
    return App::Sqitch::DateTime->new(split /:/ => shift);
}

sub _no_table_error  {
    return $DBI::errstr && $DBI::errstr =~ /^-Table unknown|No such file or directory/m;
}

sub _no_column_error  {
    return $DBI::errstr && $DBI::errstr =~ /^-Column unknown/m;

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

sub _regex_op { 'REGEXP_LIKE(%s, ?)' }

sub _simple_from { ' FROM dual' }

sub _multi_values {
    my ($self, $count, $expr) = @_;
    return join "\nUNION ALL ", ("SELECT $expr FROM dual") x $count;
}

sub _dt($) {
    require App::Sqitch::DateTime;
    return App::Sqitch::DateTime->new(split /:/ => shift);
}

sub _cid {
    my ( $self, $ord, $offset, $project ) = @_;

    return try {
        return $self->dbh->selectcol_arrayref(qq{
            SELECT change_id FROM (

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

    # Delete the change record.
    $dbh->do(
        'DELETE FROM changes where change_id = ?',
        undef, $change->id,
    );

    # Log it.
    return $self->_log_event( revert => $change, $del_tags, $req, $conf );
}

sub _dt($) {
    require App::Sqitch::DateTime;
    return App::Sqitch::DateTime->new(split /:/ => shift);
}

sub _no_table_error  {
    return 0 unless $DBI::state && $DBI::state eq '42P01'; # undefined_table
    my $dbh = shift->dbh;
    return 1 unless $dbh->{pg_server_version} >= 90000;

    # Try to avoid confusion for people monitoring the Postgres error log by

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

sub _ts2char_format {
    # The colon has to be inside the quotation marks, because otherwise it
    # generates wayward single quotation marks. Bug report:
    # https://support.snowflake.net/s/case/5000Z000010wTkKQAU/
    qq{to_varchar(CONVERT_TIMEZONE('UTC', %s), '"year:"YYYY":month:"MM":day:"DD":hour:"HH24":minute:"MI":second:"SS":time_zone:UTC"')};
}

sub _char2ts { $_[1]->as_string(format => 'iso') }

sub _dt($) {
    require App::Sqitch::DateTime;
    return App::Sqitch::DateTime->new(split /:/ => shift);
}

sub _regex_op { 'REGEXP' } # XXX But not used; see regex_expr() below.

sub _simple_from { ' FROM dual' }

sub _cid {
    my ( $self, $ord, $offset, $project ) = @_;

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

}

sub _no_column_error  {
    return $DBI::state && $DBI::state eq '42703'; # ERRCODE_UNDEFINED_COLUMN
}

sub _unique_error  {
    return $DBI::state && $DBI::state eq '23505'; # ERRCODE_UNIQUE_VIOLATION
}

sub _dt($) {
    require App::Sqitch::DateTime;
    return App::Sqitch::DateTime->new(split /:/ => shift);
}

sub _multi_values {
    my ($self, $count, $expr) = @_;
    return join "\nUNION ALL ", ("SELECT $expr") x $count;
}

sub _dependency_placeholders {

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

sub count       { scalar @{ shift->{list} } }
sub changes     { @{ shift->{list} } }
sub tags        { map { $_->tags } @{ shift->{list} } }
sub items       { @{ shift->{list} } }
sub change_at   { shift->{list}[shift] }
sub last_change { return shift->{list}[ -1 ] }

# Like [:punct:], but excluding _. Copied from perlrecharclass.
my $punct = q{-!"#$%&'()*+,./:;<=>?@[\\]^`{|}~};

sub _offset($) {
    # Look for symbolic references.
    if ( $_[0] =~ s{(?<![$punct])([~^])(?:(\1)|(\d+))?\z}{} ) {
        my $offset = $3 // ($2 ? 2 : 1);
        $offset *= -1 if $1 eq '^';
        return $offset;
    } else {
        return 0;
    }
}

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

    $self->_no_registry(1);
    return;
}

after use_driver => sub {
    DBI->trace(1) if $_[0]->sqitch->verbosity > 2;
};

sub _dsn { shift->target->uri->dbi_dsn }

sub _dt($) {
    require App::Sqitch::DateTime;
    return App::Sqitch::DateTime->new(split /:/ => shift);
}

sub _log_tags_param {
    join ' ' => map { $_->format_name } $_[1]->tags;
}

sub _log_requires_param {
    join ',' => map { $_->as_string } $_[1]->requires;

t/add.t  view on Meta::CPAN

    'Load a sqitch sqitch object';

isa_ok my $add = App::Sqitch::Command->load({
    sqitch  => $sqitch,
    command => 'add',
    config  => $config,
    args    => [],
}), $CLASS, 'add command';
my $target = $add->default_target;

sub dep($$) {
    my $dep = App::Sqitch::Plan::Depend->new(
        %{ App::Sqitch::Plan::Depend->parse( $_[1] ) },
        plan      => $add->default_target->plan,
        conflicts => $_[0],
    );
    $dep->project;
    return $dep;
}

can_ok $CLASS, qw(

t/change.t  view on Meta::CPAN

my $date = App::Sqitch::DateTime->new(
    year   => 2012,
    month  => 7,
    day    => 16,
    hour   => 17,
    minute => 25,
    second => 7,
    time_zone => 'UTC',
);

sub dep($) {
    App::Sqitch::Plan::Depend->new(
        %{ App::Sqitch::Plan::Depend->parse(shift) },
        plan    => $target->plan,
        project => 'change',
    )
}

ok my $change2 = $CLASS->new(
    name      => 'yo/howdy',
    plan      => $plan,

t/plan.t  view on Meta::CPAN

my $ts = App::Sqitch::DateTime->new(
    year      => 2012,
    month     => 7,
    day       => 16,
    hour      => 17,
    minute    => 25,
    second    => 7,
    time_zone => 'UTC',
);

sub ts($) {
    my $str = shift || return $ts;
    my @parts = split /[-:T]/ => $str;
    return App::Sqitch::DateTime->new(
        year      => $parts[0],
        month     => $parts[1],
        day       => $parts[2],
        hour      => $parts[3],
        minute    => $parts[4],
        second    => $parts[5],
        time_zone => 'UTC',
    );
}

my $vivify = 0;
my $project;

sub dep($) {
    App::Sqitch::Plan::Depend->new(
        plan    => $plan,
        (defined $project ? (project => $project) : ()),
        %{ App::Sqitch::Plan::Depend->parse(shift) },
    )
}

sub change($) {
    my $p = shift;
    if ( my $op = delete $p->{op} ) {
        @{ $p }{ qw(lopspace operator ropspace) } = split /([+-])/, $op;
        $p->{$_} //= '' for qw(lopspace ropspace);
    }

    $p->{requires} = [ map { dep $_ } @{ $p->{requires} } ]
        if $p->{requires};
    $p->{conflicts} = [ map { dep "!$_" } @{ $p->{conflicts} }]
        if $p->{conflicts};

t/plan.t  view on Meta::CPAN

        $duped->add_rework_tags(map { $seen{$_}-> tags } @{ $p->{rtag} });
    }
    $seen{ $p->{name} } = $prev_change;
    if ($vivify) {
        $prev_change->id;
        $prev_change->tags;
    }
    return $prev_change;
}

sub tag($) {
    my $p = shift;
    my $ret = delete $p->{ret};
    $prev_tag = App::Sqitch::Plan::Tag->new(
        plan          => $plan,
        change        => $prev_change,
        timestamp     => ts delete $p->{ts},
        planner_name  => 'Barack Obama',
        planner_email => 'potus@whitehouse.gov',
        %{ $p },
    );

t/rework.t  view on Meta::CPAN

);
ok my $sqitch = App::Sqitch->new(config  => $config), 'Load a sqitch object';

isa_ok my $rework = App::Sqitch::Command->load({
    sqitch  => $sqitch,
    command => 'rework',
    config  => $config,
}), $CLASS, 'rework command';
my $target = $rework->default_target;

sub dep($) {
    my $dep = App::Sqitch::Plan::Depend->new(
        conflicts => 0,
        %{ App::Sqitch::Plan::Depend->parse(shift) },
        plan      => $rework->default_target->plan,
    );
    $dep->project;
    return $dep;
}

can_ok $CLASS, qw(

t/target.t  view on Meta::CPAN

    isa_ok $target->reworked_deploy_dir, 'Path::Class::Dir', 'Reworked deploy dir';
    is $target->reworked_revert_dir, 'foorevr', 'Reworked revert dir should be "foorevr"';
    isa_ok $target->reworked_revert_dir, 'Path::Class::Dir', 'Reworked revert dir';
    is $target->reworked_verify_dir, 'fooverr', 'Reworked verify dir should be "fooverr"';
    isa_ok $target->reworked_verify_dir, 'Path::Class::Dir', 'Reworked verify dir';
    is $target->extension, 'fooddl', 'Extension should be "fooddl"';
    is_deeply $target->variables, {x => 'ex', y => 'why', z => 'zie', a => 'ay'},
        'Variables should be read from engine., and target.variables';
}

sub _load($) {
    my $config = App::Sqitch::Config->new;
    $config->load_file(file 't', "$_[0].conf");
    return $config;
}

ALL: {
    # Let's test loading all targets. Start with only core.
    my $config = TestConfig->from(local => file qw(t core.conf) );
    my $sqitch = App::Sqitch->new(config => $config);
    ok my @targets = $CLASS->all_targets(sqitch => $sqitch), 'Load all targets';