App-Sqitch

 view release on metacpan or  search on metacpan

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

88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
    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

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
use Path::Class qw(file dir);
use List::Util qw(max first);
use constant extra_target_keys => qw(target);
 
extends 'https://metacpan.org/pod/App::Sqitch::Command">App::Sqitch::Command';
with 'https://metacpan.org/pod/App::Sqitch::Role::TargetConfigCommand">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

49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
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

293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
            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

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
use Locale::TextDomain qw(App-Sqitch);
use App::Sqitch::Types qw(DBH Dir ArrayRef);
use List::Util qw(first);
 
extends 'https://metacpan.org/pod/App::Sqitch::Engine">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

271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
# 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

165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
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

423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
    # 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

361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
sub _ts2char_format {
    # The colon has to be inside the quotation marks, because otherwise it
    # generates wayward single quotation marks. Bug report:
    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

175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
}
 
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

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
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

34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
    $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

31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
    '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

199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
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

73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
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

130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
        $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

28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
);
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

571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
    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';



( run in 0.368 second using v1.01-cache-2.11-cpan-55f5a4728d2 )