view release on metacpan or  search on metacpan

lib/DB/Object/Mysql.pm  view on Meta::CPAN

sub unlock
{
    my $self = shift( @_ );
    my $str  = shift( @_ ) ||
    return( $self->error( "No lock string identifier provided." ) );
    # my $res = $self->select( "RELEASE_LOCK( '$str' )" )->fetchrow();
    my $sth = $self->{dbh}->prepare( "SELECT RELEASE_LOCK( '$str' )" ) ||
    return( $self->error( "Error while preparing query to release lock '$str': ", $self->errstr() ) );
    $sth->execute() ||
    return( $self->error( "Error while executing query to release lock '$str': ", $sth->errstr() ) );
    my $res = $sth->fetchrow;
    $sth->finish();
    # Take out the lock from the saved locks pile (used by DESTROY)
    my $locks = $self->{ '_locks' } ||= [];
    my @new   = grep{ !/$str/ } @$locks;
    $locks = [ @new ];
    return( $res eq 'NULL' ? undef() : $res );
}

sub variables
{
    my $self = shift( @_ );
    my $type = shift( @_ );
    $self->error( "Variable '$type' is a read-only value." ) if( @_ );
    my $vars = $self->{ 'variables' } ||= {};
    if( !%$vars )
    {
        my $sth = $self->{dbh}->prepare( "SHOW VARIABLES" ) ||
        return( $self->error( "SHOW VARIABLES is not supported." ) );
        $sth->execute();
        my $ref = $self->fetchall_arrayref();
        my %vars = map{ lc( $_->[ 0 ] ) => $_->[ 1 ] } @$ref;
        $vars = \%vars if( %vars );
        $sth->finish();
    }
    my @found = grep{ /$type/i } keys( %$vars );
    return( '' ) if( !scalar( @found ) );
    return( $vars->{ $found[ 0 ] } );
}

# https://dev.mysql.com/doc/refman/8.0/en/show-variables.html
sub version
{
    my $self  = shift( @_ );
    # If we already have the information, let's use our cache instead of making a query
    return( $self->{_db_version} ) if( length( $self->{_db_version} ) );
    my $sql = 'SELECT @@innodb_version';
    my $sth = $self->do( $sql ) || return( $self->error( "Unable to issue the sql statement '$sql' to get the server version: ", $self->errstr ) );
    my $ver = $sth->fetchrow;
    $sth->finish;
    # We cache it
    $self->{_db_version} = version->parse( $ver );
    return( $ver );
}

sub _connection_options
{
    my $self  = shift( @_ );
    my $param = shift( @_ );
    # This should really not be an option. This decode utf8 in database
    $param->{mysql_enable_utf8} = 1 if( !CORE::exists( $param->{mysql_enable_utf8} ) );
    my @mysql_params = grep( /^mysql_/, keys( %$param ) );
    my $opt = $self->SUPER::_connection_options( $param );
    @$opt{ @mysql_params } = @$param{ @mysql_params };
    return( $opt );
}

# NOTE: sub _connection_params2hash_driver is not necessary here. We use our parent's one.

sub _connection_parameters
{
    my $self  = shift( @_ );
    my $param = shift( @_ );
    my $core = [qw( db login passwd host port driver database server opt uri debug cache_connections cache_dir cache_query cache_table unknown_field use_cache )];
    my @mysql_params = grep( /^mysql_/, keys( %$param ) );
    # See DBD::mysql for the list of valid parameters
    # E.g.: mysql_client_found_rows, mysql_compression mysql_connect_timeout mysql_write_timeout mysql_read_timeout mysql_init_command mysql_skip_secure_auth mysql_read_default_file mysql_read_default_group mysql_socket mysql_ssl mysql_ssl_client_key...
    push( @$core, @mysql_params );
    return( $core );
}

sub _dsn
{
    my $self = shift( @_ );
    # "DBI:mysql:database=$sql_db;host=$sql_host;port=$sql_port;mysql_read_default_file=/etc/my.cnf"
    my @params = ( sprintf( 'dbi:%s:database=%s', @$self{ qw( driver database ) } ) );
    if( $self->{host} )
    {
        $self->_load_class( 'Net::IP' ) || return( $self->pass_error );
        my $ip = Net::IP->new( $self->{host} );
        if( $ip )
        {
            if( $ip->version == 6 )
            {
                push( @params, sprintf( 'host=[%s]', $ip->ip ) );
            }
            else
            {
                push( @params, sprintf( 'host=%s', $ip->ip ) );
            }
        }
        else
        {
            push( @params, sprintf( 'host=%s', $self->{host} ) );
        }
    }
    # my @params = sprintf( "dbi:%s:database=%s;host=%s", @$self{ qw( driver database server ) } );
    push( @params, sprintf( 'port=%d', $self->{port} ) ) if( $self->{port} );
    push( @params, sprintf( 'mysql_read_default_file=%s', $self->{mysql_read_default_file} ) ) if( $self->{mysql_read_default_file} );
    return( join( ';', @params ) );
}

sub _placeholder_regexp { return( $PLACEHOLDER_REGEXP ) }

# NOTE: DESTROY
DESTROY
{
    # <https://perldoc.perl.org/perlobj#Destructors>
    CORE::local( $., $@, $!, $^E, $? );
    CORE::return if( ${^GLOBAL_PHASE} eq 'DESTRUCT' );
    my $self = CORE::shift( @_ );