view release on metacpan or  search on metacpan

lib/MariaDB/NonBlocking/Promises/Pool.pm  view on Meta::CPAN

package MariaDB::NonBlocking::Promises::Pool;

use constant DEBUG => $ENV{MariaDB_NonBlocking_DEBUG} // $ENV{DEBUG_ALL} // 0;
sub TELL (@) {
    say STDERR __PACKAGE__, ': ', join " ", @_;
}

use v5.18.2;
use warnings;
use Sub::StrictDecl;

use constant OUR_DEFAULT_WAIT_TIMEOUT => 60;
use constant MYSQL_MAX_SLAVE_RETRIES  => 4; # magic number

use Data::Dumper;

use Carp ();
BEGIN {
    $Carp::Internal{+__PACKAGE__}     = 1;
    $Carp::CarpInternal{+__PACKAGE__} = 1;
}

use Ref::Util    qw(is_arrayref is_hashref);
use Time::HiRes  qw(time);  # for high-res time
use List::Util   qw(shuffle sum);
use Scalar::Util qw(weaken refaddr);

use MariaDB::NonBlocking::Promises qw(); # our default connector class

use if DEBUG, 'Digest::MD5' => qw(md5_hex); # dumb fingerprinting when DEBUG is true
BEGIN { *md5_hex = sub {} unless DEBUG };

use constant {
    PENDING_QUERY      => 1,            # tuple of [$query, $bind values]
    PENDING_ATTR       => 2,            # options for the query (timeout, etc)
    PENDING_DEFERRED   => 3,            # the Promises::Deferred object
    PENDING_STACKTRACE => 4,            # Stacktrace from the place the query was scheduled
    PENDING_RETRIES_REMAINING => 5,     # ...
    PENDING_SCHEDULED_TIME    => 6,      # hires unix timestamp of when the query was scheduled, for eventlog purposes
};

use constant {
    MYSQL_POOL_EXTEND_STRATEGY_MINIMUM_CONNECTIONS => 'min',
    MYSQL_POOL_EXTEND_STRATEGY_MAXIMUM_CONNECTIONS => 'max',
};

sub _format_connection_error { # Override
    my ($pool, $error, $connection_args) = @_;
    return $error;
}

sub _format_query_error { # Override
    my ($pool, $query, $error, $conn, $query_start_time, $cpu_start_time) = @_;
    return $error;
}

sub _log_time_to_connect { # Override
    my ($pool, $connection_args, $connect_start_time) = @_;
}

sub _log_time_to_be_scheduled { # Override
    my ($pool, $query_scheduled_time) = @_;
}

sub _log_query_timings { # Override
    my ($pool, $conn, $query, $query_start_time, $cpu_start_time) = @_;
}

sub _deal_with_query_warnings { # Override
    my ($pool, $query, $warnings, $raw_stacktrace) = @_;
}

sub _preprocess_query { # Override
    my ($pool, $conn, $query, $bind) = @_;
    return AnyEvent::XSPromises::resolved();
}

sub _postprocess_query { # Override
    my ($pool, $conn, $query, $query_start_time, $raw_stack) = @_;
}

sub get_raw_stacktrace { # Override
    my ($pool, $stracktrace_ignore) = @_;