view release on metacpan or  search on metacpan

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

         LIMIT 1
    });
    while ($dbh->selectcol_arrayref($sth, undef, $change->project)->[0]) {
        # Sleep for 100 ms.
        require Time::HiRes;
        Time::HiRes::sleep(0.1);
    }

    return $self;
}

sub _set_vars {
    my %vars = shift->variables or return;
    return 'SET ' . join(', ', map {
        (my $k = $_) =~ s/"/""/g;
        (my $v = $vars{$_}) =~ s/'/''/g;
        qq{\@"$k" = '$v'};
    } sort keys %vars) . ";\n";
}

sub _source {
    my ($self, $file) = @_;
    my $set = $self->_set_vars || '';
    return ('--execute' => "${set}source $file");
}

sub _run {
    my $self = shift;
    my $sqitch = $self->sqitch;
    my $pass   = $self->password or return $sqitch->run( $self->mysql, @_ );
    local $ENV{MYSQL_PWD} = $pass;
    return $sqitch->run( $self->mysql, @_ );
}

sub _capture {
    my $self   = shift;
    my $sqitch = $self->sqitch;
    my $pass   = $self->password or return $sqitch->capture( $self->mysql, @_ );
    local $ENV{MYSQL_PWD} = $pass;
    return $sqitch->capture( $self->mysql, @_ );
}

sub _spool {
    my $self   = shift;
    my @fh     = (shift);
    my $sqitch = $self->sqitch;
    if (my $set = $self->_set_vars) {
        open my $sfh, '<:utf8_strict', \$set;
        unshift @fh, $sfh;
    }
    my $pass   = $self->password or return $sqitch->spool( \@fh, $self->mysql, @_ );
    local $ENV{MYSQL_PWD} = $pass;
    return $sqitch->spool( \@fh, $self->mysql, @_ );
}

sub run_file {
    my $self = shift;
    $self->_run( $self->_source(@_) );
}

sub run_verify {
    my $self = shift;
    # Suppress STDOUT unless we want extra verbosity.
    my $meth = $self->can($self->sqitch->verbosity > 1 ? '_run' : '_capture');
    $self->$meth( $self->_source(@_) );
}

sub run_upgrade {
    my ($self, $file) = @_;
    my @cmd = $self->mysql;

    if ((my $idx = firstidx { $_ eq '--database' } @cmd) > 0) {
        # Replace the database name with the registry database.
        $cmd[$idx + 1] = $self->registry;
    } else {
        # Append the registry database name.
        push @cmd => '--database', $self->registry;
    }

    return $self->sqitch->run(
        @cmd,
        $self->_source($self->_prepare_registry_file($file)),
    );
}

# Prepares $file for execution, editing its contents for various MySQL
# configurations.
sub _prepare_registry_file {
    my ($self, $file) = @_;
    my $has_frac = $self->_fractional_seconds;
    return $file if $has_frac;

    # Read in the file to modify it.
    my $sql = $file->slurp;

    if (!$has_frac) {
        # Need to strip out datetime precision.
        $sql =~ s{DATETIME\(\d+\)}{DATETIME}g;

        # Strip out 5.5 stuff on earlier versions.
        $sql =~ s/-- ## BEGIN 5[.]5.+?-- ## END 5[.]5//ms
            if $self->dbh->{mariadb_serverversion} < 50500;
    }

    # Write out a temp file and return it.
    require File::Temp;
    my $fh = File::Temp->new;
    print $fh $sql;
    close $fh;
    return $fh;
}

sub _create_check_function {
    # The checkit() function works sort of like a CHECK: if the first argument
    # is 0 or NULL, it throws the second argument as an exception.
    # Conveniently, verify scripts can also use it to ensure an error is
    # thrown when a change cannot be verified. Requires MySQL 5.5.0 and
    # permission to create an immutable function, so ignore failures in those
    # situations.
    my $self = shift;
    return if $self->dbh->{mariadb_serverversion} < 50500;
    try {
        $self->dbh->do(q{
            CREATE FUNCTION checkit(doit INTEGER, message VARCHAR(256)) RETURNS INTEGER DETERMINISTIC
            BEGIN
                IF doit IS NULL OR doit = 0 THEN
                    SIGNAL SQLSTATE 'ERR0R' SET MESSAGE_TEXT = message;
                END IF;
                RETURN doit;
            END;
        });
    } catch {
        # 1419: You do not have super user privilege and binary logging is
        # enabled.
        die $_ if !$DBI::err || $DBI::err != 1419;
        $self->sqitch->warn(__(
            'Insufficient permissions to create the checkit() function; skipping.',
        ));
    }
}

sub run_handle {
    my ($self, $fh) = @_;
    $self->_spool($fh);
}

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

    my $offexpr = $offset ? " OFFSET $offset" : '';
    return try {
        return $self->dbh->selectcol_arrayref(qq{
            SELECT change_id
              FROM changes
             WHERE project = ?
             ORDER BY committed_at $ord
             LIMIT 1$offexpr
        }, undef, $project || $self->plan->project)->[0];
    } catch {
        # MySQL error code 1049 (ER_BAD_DB_ERROR): Unknown database '%-.192s'
        # MySQL error code 1146 (ER_NO_SUCH_TABLE): Table '%s.%s' doesn't exist
        return if $DBI::err && ($DBI::err == 1049 || $DBI::err == 1146);
        die $_;
    };
}

1;

__END__

=head1 Name

App::Sqitch::Engine::mysql - Sqitch MySQL Engine

=head1 Synopsis