view release on metacpan or  search on metacpan

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

{
    my $self = shift( @_ );
    return( $self->error( "Trace can only be used on active connection. Use connect first." ) ) if( !$self->{dbh} );
    # $dbh->trace_msg( $message_text, $min_level );
    return( $self->{dbh}->trace_msg( @_ ) );
}

# sub unix_timestamp

sub unlock
{
    shift->error( "unlock() does not work with Postgres." );
}

# See DB::Object
# sub update

# See DB::Object
# sub use

# See DB::Object
# sub use_cache

# See DB::Object
# sub use_bind

sub variables
{
    return( shift->error( "variables is currently unsupported in Postgres" ) );
}

# See DB::Object
# sub where

# https://www.postgresql.org/docs/10/sql-show.html
# show something exists since at lease from 7.1
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} ) );
    # e.g. 10.4
    my $sql = 'SHOW server_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;
    # e.g.:
    # 12.1 (Ubuntu 12.1-1.pgdg16.04+1)
    # 10.4
    $ver =~ s/^(\d+(?:\.\S+)?).*?$/$1/;
    # We cache it
    $self->{_db_version} = version->parse( $ver );
    return( $ver );
}

sub _check_connect_param
{
    my $self  = shift( @_ );
    my $param = $self->SUPER::_check_connect_param( @_ ) || return( $self->pass_error );
    # This is also what the psql command line tool does
    $param->{login}    = ( getpwuid( $> ) )[0] if( !$param->{login} );
    $param->{database} = 'postgres' if( !$param->{database} );
    # By default
    $param->{port}     = 5432 if( !CORE::exists( $param->{port} ) );
    return( $param );
}

# Called from connect once all check was done to see if there are default to set
sub _check_default_option
{
    my $self = shift( @_ );
    my $opts = $self->_get_args_as_hash( @_ );
    return( $self->error( "Provided option is not a hash reference." ) ) if( !$self->_is_hash( $opts => 'strict' ) );
    $opts->{client_encoding} = 'utf8' if( !CORE::exists( $opts->{client_encoding} ) );
    # Enabled but with auto-guess
    $opts->{pg_enable_utf8} = -1 if( !CORE::exists( $opts->{pg_enable_utf8} ) && ( $opts->{client_encoding} eq 'utf8' || $opts->{client_encoding} eq 'utf-8' ) );
    return( $opts );
}

# Called by _check_connect_param
sub _connection_options
{
    my $self  = shift( @_ );
    my $param = shift( @_ );
    my @pg_params = grep( /^pg_/, keys( %$param ) );
    my $opt = $self->SUPER::_connection_options( $param ) || return( $self->pass_error );
    @$opt{ @pg_params } = @$param{ @pg_params };
    return( $opt );
}

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

# Called by _check_connect_param
sub _connection_parameters
{
    my $self  = shift( @_ );
    my $param = shift( @_ );
    my $core = [qw(
        db login passwd host port driver database schema server opt uri debug
        cache_connections cache_dir cache_query cache_table connect_via unknown_field
        use_cache
    )];
    my @pg_params = grep( /^pg_/, 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, @pg_params );
    return( $core );
}

sub _dsn
{
    my $self = shift( @_ );
    my @params = ();
    # See pg_service.conf
    if( $self->{service} )
    {
        @params = ( sprintf( 'dbi:%s:%s', @$self{ qw( driver service ) } ) );
    }
    else
    {
        # It ends with ':'