view release on metacpan or  search on metacpan

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

    my $sql = "CREATE DATABASE " . ( $opts->{if_not_exists} ? 'IF NOT EXISTS ' : '' ) . $name;
    if( scalar( @$params ) )
    {
        $sql .= ' ' . join( ' ', @$params );
    }
    my $dbh = $self->{dbh} || return( $self->error( "Could not find database handler." ) );
    my( $sth, $rc );
    # try-catch
    local $@;
    $sth = eval
    {
        $dbh->prepare( $sql );
    };
    if( $@ )
    {
        return( $self->error( "An error occured while prepareing SQL query to create database: ", $@ ) );
    }
    $sth or return( $self->error( "An error occured while prepareing SQL query to create database: ", $dbh->errstr ) );

    $rc = eval
    {
        $dbh->prepare( $sql );
    };
    if( $@ )
    {
        return( $self->error( "An error occured while prepareing SQL query to create database: ", $@ ) );
    }
    $rc or return( $self->error( "An error occured while prepareing SQL query to create database: ", $dbh->errstr ) );

    # try-catch
    eval
    {
        $sth->finish;
    };
    if( $@ )
    {
        return( $self->error( "An unexpected error occurred while trying to finish the SQL query to create database: ", $@, "\n$sql" ) );
    }

    my $ref = {};
    my @keys = qw( host port login passwd opt debug );
    @$ref{ @keys } = @$self{ @keys };
    $ref->{database} = $name;
    $dbh = $self->connect( $ref ) || return( $self->error( "I could create the database \"$name\" but oddly enough, I could not connect to it with user \"$ref->{login}\" on host \"$ref->{host}\" with port \"$ref->{port}\"." ) );
    return( $dbh );
}

sub databases
{
    my $self = shift( @_ );
    # return( $self->error( "Not connected to PostgreSQL server yet. Issue $dbh->connect first." ) ) if( !$self->{ 'dbh' } );
    my $dbh;
    # If there is no connection yet, then create one using the postgres login.
    # There should not be a live user and database just to check what databases there are.
    if( !$self->{dbh} )
    {
        my $con = 
        {
        'database' => 'mysql',
        };
        $con->{mysql_read_default_file} = '/etc/my.cnf' if( -f( '/etc/my.cnf' ) );
        if( CORE::exists( $ENV{ 'DB_MYSQL_CON' } ) )
        {
            @$con{ qw( host login passwd ) } = split( /;/, $ENV{ 'DB_MYSQL_CON' } );
        }
        else
        {
            @$con{ qw( host login passwd ) } = @_;
        }

        # try-catch
        local $@;
        $dbh = eval
        {
            $self->connect( $con );
        };
        if( $@ )
        {
            return( $self->error( "Error trying to connect to the MySQL server: $@" ) );
        }
        $dbh or return( $self->pass_error );
    }
    else
    {
        $dbh = $self;
    }
    my $temp = $dbh->do( "SHOW DATABASES" )->fetchall_arrayref;
    my @dbases = map( $_->[0], @$temp );
    return( @dbases );
}

# NOTE: sub datatype_dict is inherited

# NOTE: sub datatype_to_constant is inherited

# NOTE: sub datatypes is in inherited

sub get_sql_type
{
    my $self = shift( @_ );
    my $type = shift( @_ ) || return( $self->error( "No sql type was provided to get its constant." ) );
    $type = lc( $type );
    if( CORE::exists( $DATATYPES_DICT->{ $type } ) &&
        $type ne $DATATYPES_DICT->{ $type }->{type} )
    {
        $type = $DATATYPES_DICT->{ $type }->{type};
    }
    my $const;
    if( substr( $type, 0, 4 ) eq 'sql_' )
    {
        $const = $self->{dbh}->can( "DBI::\U${type}\E" );
    }
    else
    {
        $const = $self->{dbh}->can( "DBI::SQL_\U${type}\E" );
    }
    return( '' ) if( !defined( $const ) );
    return( $const->() );
}

# Specific to Mysql (Postgres also uses it)

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

    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( @_ );
    CORE::return if( !CORE::defined( $self ) );
    my $class = ref( $self ) || $self;
    if( $self->{sth} )
    {
        print( STDERR "DESTROY(): Terminating sth '$self' for query:\n$self->{query}\n" ) if( $DEBUG || $self->{debug} );
        $self->{sth}->finish();
    }
    elsif( $self->{dbh} && $class eq 'DB::Object' )
    {
        local( $SIG{__WARN__} ) = sub { };
        # $self->{ 'dbh' }->disconnect();
        if( $DEBUG || $self->{debug} )
        {
            my( $pack, $file, $line, $sub ) = ( caller(0) )[0, 1, 2, 3];
            my( $pack2, $file2, $line2, $sub2 ) = ( caller(1) ) [0, 1, 2, 3];
            print( STDERR "DESTROY database handle ($self) [$self->{query}]\ncalled within sub '$sub' ($sub2) from package '$pack' ($pack2) in file '$file' ($file2) at line '$line' ($line2).\n" );
        }
        $self->disconnect();
    }
    my $locks = $self->{_locks};
    if( $locks && $self->_is_array( $locks ) )
    {
        foreach my $name ( @$locks )
        {
            $self->unlock( $name );
        }
    }
}

1;
# NOTE: POD
__END__

=encoding utf8

=head1 NAME

DB::Object::Mysql - Mysql Database Object

=head1 SYNOPSIS

    use DB::Object;

    my $dbh = DB::Object->connect({
    driver => 'mysql',
    conf_file => 'db-settings.json',
    database => 'webstore',
    host => 'localhost',