view release on metacpan or  search on metacpan

t/lib/DBIEngineTest.pm  view on Meta::CPAN

    engine_err_regex => qr/^ERROR:  /,

Regular expression that matches an error from the database engine. Required.

=item C<test_dbh>

    test_dbh => sub {
        my $dbh = shift;
        # Make sure the sqitch schema is the first in the search path.
        is $dbh->selectcol_arrayref('SELECT current_schema')->[0],
            $reg2, 'The Sqitch schema should be the current schema';
    },

Optional subroutine that tests a database connection once it has been
established. Use to test that connection parameters were properly set or
executed.

=item C<add_second_format>

    add_second_format => 'dateadd(second, 1, %s)',

Optional C<sprintf> format that adds one second to the named timestamp
column, to be filled in for C<%s>. Use for engines without sub-second
timestamp precision.

=item C<no_unique>

  no_unique => 1,

Indicates that the engine being tested does not support unique constraints.
Required for such engines.

=item C<lock_sql>

Anonymous subroutine that returns a hash reference with SQL queries to test
for various lock states. Required only for engines that support locking on
a per-deploy basis. The keys in the returned hash reference must be:

=over

=item C<is_locked>

An SQL query that returns true if a lock is in place. Required.

=item C<try_lock>

An SQL query that returns true when it creates a lock and false when it fails
to create a lock. Required.

=item C<free_lock>

An SQL query that frees a lock. Required.

=item C<wait_time>

Time to pass to C<lock_timeout> to wait for a lock to time out. Defaults to
C<0.005>.

=item C<async_free>

Boolean indicating whether the freeing of a lock is performed asynchronously.
Required only for engines that don't free locks synchronously.

=back

=back

=cut

sub run {
    my ( $self, %p ) = @_;

    my $class         = $p{class};
    my @sqitch_params = @{ $p{sqitch_params} || [] };
    my $user1_name    = 'Marge Simpson';
    my $user1_email   = 'marge@example.com';
    my $mock_sqitch   = Test::MockModule->new('App::Sqitch');

    # Mock script hashes using lines from the README.
    my $mock_change = Test::MockModule->new('App::Sqitch::Plan::Change');
    my @lines = grep { $_ } file('README.md')->slurp(
        chomp  => 1,
        iomode => '<:raw'
    );

    # Each change should retain its own hash.
    my $orig_deploy_hash;
    $mock_change->mock(_deploy_hash => sub {
        my $self = shift;
        $self->$orig_deploy_hash || sha1_hex shift @lines;
    });
    $orig_deploy_hash = $mock_change->original('_deploy_hash');

    can_ok $class, qw(
        initialized
        initialize
        run_file
        run_handle
        log_deploy_change
        log_fail_change
        log_revert_change
        earliest_change_id
        latest_change_id
        is_deployed_tag
        is_deployed_change
        change_id_for
        change_id_for_depend
        name_for_change_id
        change_offset_from_id
        change_id_offset_from_id
        load_change
        lock_destination
        try_lock
        wait_lock
    );

    subtest 'live database' => sub {
        my $sqitch = App::Sqitch->new(
            @sqitch_params,
            user_name  => $user1_name,
            user_email => $user1_email,
            config => TestConfig->new(