File Coverage

blib/lib/DBIx/QuickDB/Driver/MySQL.pm

Criterion	Covered	Total	%
statement	62	213	29.1
branch	6	90	6.6
condition	4	33	12.1
subroutine	17	38	44.7
pod	11	24	45.8
total	100	398	25.1

package DBIx::QuickDB::Driver::MySQL;
use strict;
use warnings;

our $VERSION = '0.000040';

use Capture::Tiny qw/capture/;
use Carp qw/confess croak/;
use DBIx::QuickDB::Util qw/strip_hash_defaults/;
use IPC::Cmd qw/can_run/;
use Scalar::Util qw/reftype blessed/;

use parent 'DBIx::QuickDB::Driver';
use DBIx::QuickDB::Util::HashBase qw{


    +dbd_driver







};

sub provider        { croak "'$_[0]' does not implement provider" }
sub verify_provider { croak "'$_[0]' does not implement verify_provider" }

sub dbd_driver_order { shift; grep { $_ } @_, 'DBD::MariaDB', 'DBD::mysql' }

sub server_bin_list  { qw/mysqld/ }
sub client_bin_list  { qw/mysql/ }
sub install_bin_list { qw/mysql_install_db/ }
sub server_bin       { $_[0]->provider_info->{server_bin}  }
sub client_bin       { $_[0]->provider_info->{client_bin}  }
sub install_bin      { $_[0]->provider_info->{install_bin} }
sub error_log        { "$_[0]->{+DIR}/error.log" }

my %PROVIDER_CACHE;
sub provider_info {
    my $this = shift;

    my $class = blessed($this) || $this;
    return $PROVIDER_CACHE{$class} if $PROVIDER_CACHE{$class};

    my %found;

    my $viable = 0;
    for my $bin ($this->server_bin_list) {
        if (my $mysqld = can_run($bin)) {
            $found{server_bin} = $mysqld if $this->verify_provider($mysqld);
            last if $found{server_bin};
        }
    }

    return $PROVIDER_CACHE{$class} = {} unless $found{server_bin};

    for my $bin ($this->client_bin_list) {
        if (my $mysql = can_run($bin)) {
            $found{client_bin} = $mysql;
            last;
        }
    }

    return $PROVIDER_CACHE{$class} = {} unless $found{client_bin};

    for my $bin ($this->install_bin_list) {
        if (my $install = can_run($bin)) {
            my ($stdout, $stderr) = capture { system($install) };
            my $output = $stdout . "\n" .  $stderr;
            unless ($output =~ m/is deprecated/) {
                $found{install_bin} = $install;
            }
            last if $found{install_bin};
        }
    }

    return $PROVIDER_CACHE{$class} = \%found;
}

sub choose {
    my $this = shift;

    my $spec = { bootstrap => 1, load_sql => 1 };

    require DBIx::QuickDB::Driver::MariaDB;
    my ($ok, $why) = DBIx::QuickDB::Driver::MariaDB->viable($spec);
    return 'DBIx::QuickDB::Driver::MariaDB' if $ok;

    require DBIx::QuickDB::Driver::MySQLCom;
    ($ok, $why) = DBIx::QuickDB::Driver::MySQLCom->viable($spec);
    return 'DBIx::QuickDB::Driver::MySQLCom' if $ok;

    require DBIx::QuickDB::Driver::Percona;
    ($ok, $why) = DBIx::QuickDB::Driver::Percona->viable($spec);
    return 'DBIx::QuickDB::Driver::Percona' if $ok;

    return undef;
}

sub viable {
    my $this = shift;
    my ($spec) = @_;

    require DBIx::QuickDB::Driver::MariaDB;
    require DBIx::QuickDB::Driver::MySQLCom;
    require DBIx::QuickDB::Driver::Percona;

    my ($ok1, $why1) = DBIx::QuickDB::Driver::MariaDB->viable($spec);
    my ($ok2, $why2) = DBIx::QuickDB::Driver::MySQLCom->viable($spec);
    my ($ok3, $why3) = DBIx::QuickDB::Driver::Percona->viable($spec);

    return (1, undef) if $ok1 || $ok2 || $ok3;

    return (0, join("\n" => $why1, $why2, $why3));
}

sub new {
    my $class = shift;

    if ($class eq __PACKAGE__) {
        my $real_class = $class->choose or croak("Neither MariaDB, MySQL (Oracle/Community), or Percona are viable");
        return $real_class->new(@_);
    }

    my $self = @_ == 1 ? $_[0] : {@_};
    bless($self, $class);
    $self->init();

    return $self;
}

sub version_string {
    my ($class_or_self, @other) = @_;

    my $binary;

    # Go in reverse order assuming the last param hash provided is most important
    for my $arg (reverse @_) {
        my $type = reftype($arg) or next;    # skip if not a ref
        next unless $type eq 'HASH';         # We have a hashref, possibly blessed

        # If we find a launcher we are done looping, we want to use this binary.
        if (blessed($arg) && $arg->can('server_bin')) {
            $binary = $arg->server_bin and last;
        }

        for my $l (qw/server_bin mysqld mariadbd/) {
            $binary = $arg->{$l} and last;
        }

        last if $binary;
    }

    unless ($binary) {
        if ($class_or_self eq __PACKAGE__) {
            if (my $sel = $class_or_self->choose) {
                $binary = $sel->server_bin;
            }
        }
        else {
            $binary = $class_or_self->server_bin;
        }
    }

    croak "Could not find a viable server binary" unless $binary;

    # Call the binary with '-V', capturing and returning the output using backticks.
    my ($v, $stderr) = capture { system($binary, '-V') };

    return $v;
}

sub dbd_driver {
    my $in = shift;

    return $in->{+DBD_DRIVER} if blessed($in) && $in->{+DBD_DRIVER};

    for my $driver ($in->dbd_driver_order) {
        my $file = $driver;
        $file =~ s{::}{/}g;
        $file .= ".pm";
        eval { require($file); 1 } or next;

        return $in->{+DBD_DRIVER} = $driver if blessed($in);
        return $driver;
    }

    return undef;
}

sub list_env_vars {
    my $self = shift;
    return (
        $self->SUPER::list_env_vars(),
        qw{
            LIBMYSQL_ENABLE_CLEARTEXT_PLUGIN LIBMYSQL_PLUGINS
            LIBMYSQL_PLUGIN_DIR MYSQLX_TCP_PORT MYSQLX_UNIX_PORT MYSQL_DEBUG
            MYSQL_GROUP_SUFFIX MYSQL_HISTFILE MYSQL_HISTIGNORE MYSQL_HOME
            MYSQL_HOST MYSQL_OPENSSL_UDF_DH_BITS_THRESHOLD
            MYSQL_OPENSSL_UDF_DSA_BITS_THRESHOLD
            MYSQL_OPENSSL_UDF_RSA_BITS_THRESHOLD MYSQL_PS1 MYSQL_PWD
            MYSQL_SERVER_PREPARE MYSQL_TCP_PORT MYSQL_TEST_LOGIN_FILE
            MYSQL_TEST_TRACE_CRASH MYSQL_TEST_TRACE_DEBUG MYSQL_UNIX_PORT
        }
    );
}

sub _default_paths {
    my $class = shift;

    return (
        server => $class->server_bin,
        client => $class->client_bin,
    );
}

sub _default_config {
    my $self = shift;

    my $dir = $self->dir;
    my $data_dir = $self->data_dir;
    my $temp_dir = $self->temp_dir;
    my $pid_file = $self->pid_file;
    my $socket   = $self->socket;

    return (
        client => {
            'socket' => $socket,
        },

        mysql_safe => {
            'socket' => $socket,
        },

        mysql => {
            'socket'         => $socket,
        },

        mysqld => {
            'datadir'  => $data_dir,
            'pid-file' => $pid_file,
            'socket'   => $socket,
            'tmpdir'   => $temp_dir,

            'log_error'                      => "$dir/error.log",
            'secure_file_priv'               => $dir,
            'default_storage_engine'         => 'InnoDB',
            'innodb_buffer_pool_size'        => '20M',
            'key_buffer_size'                => '20M',
            'max_connections'                => '100',
            'server-id'                      => '1',
            'skip_grant_tables'              => '1',
            'skip_external_locking'          => '',
            'skip_networking'                => '1',
            'skip_name_resolve'              => '1',
            'max_allowed_packet'             => '1M',
            'max_binlog_size'                => '20M',
            'myisam_sort_buffer_size'        => '8M',
            'net_buffer_length'              => '8K',
            'read_buffer_size'               => '256K',
            'read_rnd_buffer_size'           => '512K',
            'sort_buffer_size'               => '512K',
            'table_open_cache'               => '64',
            'thread_cache_size'              => '8',
            'thread_stack'                   => '192K',
            'innodb_io_capacity'             => '2000',
            'innodb_max_dirty_pages_pct'     => '0',
            'innodb_max_dirty_pages_pct_lwm' => '0',

            'character_set_server' => $self->{+CHARACTER_SET_SERVER},

            defined($ENV{QDB_MYSQL_SSL_FIPS}) ? ('ssl_fips_mode' => "$ENV{QDB_MYSQL_SSL_FIPS}") : (),
        },
    );
}

sub init {
    my $self = shift;
    $self->SUPER::init();

    $self->dbd_driver; # Vivify this

    $self->{+CHARACTER_SET_SERVER} //= 'UTF8MB4';

    $self->{+DATA_DIR} = $self->{+DIR} . '/data';
    $self->{+TEMP_DIR} = $self->{+DIR} . '/temp';
    $self->{+CFG_FILE} = $self->{+DIR} . '/my.cfg';
    $self->{+PID_FILE} = $self->{+DIR} . '/mysql.pid';
    $self->{+SOCKET} ||= $self->{+DIR} . '/mysql.sock';

    $self->{+USERNAME} ||= 'root';

    my %defaults = $self->_default_paths;
    $self->{$_} ||= $defaults{$_} for keys %defaults;

    my %cfg_defs = $self->_default_config;
    my $cfg = { %{$self->{+CONFIG} || {}} };
    $self->{+CONFIG} = $cfg;

    for my $key (keys %cfg_defs) {
        if (defined $cfg->{$key}) {
            my $subdft = $cfg_defs{$key};
            my $subcfg = { %{$cfg->{$key}} };
            $cfg->{$key} = $subcfg;

            for my $skey (keys %$subdft) {
                next if defined $subcfg->{$skey};
                $subcfg->{$skey} = $subdft->{$skey};
            }
        }
        else {
            $cfg->{$key} = $cfg_defs{$key};
        }
    }
}

sub clone_data {
    my $self = shift;

    my $config = strip_hash_defaults(
        $self->{+CONFIG},
        {$self->_default_config},
    );

    return (
        $self->SUPER::clone_data(),

        CONFIG()     => $config,
        DBD_DRIVER() => $self->{+DBD_DRIVER},
    );
}

sub write_config {
    my $self = shift;
    my (%params) = @_;

    my $cfg_file = $self->{+CFG_FILE};
    open(my $cfh, '>', $cfg_file) or die "Could not open config file: $!";
    my $conf = $self->{+CONFIG};
    for my $section (sort keys %$conf) {
        my $override = $params{$section} // {};

        my $sconf = $conf->{$section} or next;

        $sconf = { %$sconf, %{$override->{add}} } if $override->{add};

        print $cfh "[$section]\n";
        for my $key (sort keys %$sconf) {
            my $val = $sconf->{$key};
            next unless defined $val;

            next if $override->{skip} && ($key =~ $override->{skip} || $val =~ $override->{skip});

            if (length($val)) {
                print $cfh "$key = $val\n";
            }
            else {
                print $cfh "$key\n";
            }
        }

        print $cfh "\n";
    }
    close($cfh);

    return;
}

sub bootstrap {
    my $self = shift;

    my $data_dir = $self->{+DATA_DIR};
    my $temp_dir = $self->{+TEMP_DIR};

    mkdir($data_dir) or die "Could not create data dir: $!";
    mkdir($temp_dir) or die "Could not create temp dir: $!";

    my $init_file = "$self->{+DIR}/init.sql";
    open(my $init, '>', $init_file) or die "Could not open init file: $!";
    print $init "CREATE DATABASE quickdb;\n";
    close($init);

    return $init_file;
}

sub load_sql {
    my $self = shift;
    my ($db_name, $file) = @_;

    my $cfg_file = $self->{+CFG_FILE};

    $self->run_command(
        [
            $self->client_bin,
            "--defaults-file=$cfg_file",
            '-u' => 'root',
            $db_name,
        ],
        {stdin => $file},
    );
}

sub shell_command {
    my $self = shift;
    my ($db_name) = @_;

    my $cfg_file = $self->{+CFG_FILE};
    return ($self->client_bin, "--defaults-file=$cfg_file", $db_name);
}

sub start_command {
    my $self = shift;

    my $cfg_file = $self->{+CFG_FILE};
    return ($self->server_bin, "--defaults-file=$cfg_file", '--skip-grant-tables');
}

sub connect_string {
    my $self = shift;
    my ($db_name) = @_;
    $db_name = 'quickdb' unless defined $db_name;

    my $socket = $self->{+SOCKET};

    if ($self->dbd_driver eq 'DBD::MariaDB') {
        return "dbi:MariaDB:dbname=$db_name;mariadb_socket=$socket";
    }
    else {
        return "dbi:mysql:dbname=$db_name;mysql_socket=$socket";
    }
}


1;

__END__