view release on metacpan or  search on metacpan

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

#      LEFT JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace
# WHERE c.relkind IN ('r', 'v', 'm', 'f')
#   AND n.nspname !~ '^pg_' AND pg_catalog.pg_table_is_visible(c.oid) AND c.relname != 'sequence_setvals'
# ORDER BY c.oid
# SQL
# AND n.nspname OPERATOR(pg_catalog.~) '^((auth|public))$'
    my $query = <<'EOT';
SELECT
     n.nspname as "schema"
    ,c.relname as "name"
    ,CASE c.relkind WHEN 'r' THEN 'table' WHEN 'v' THEN 'view' WHEN 'm' THEN 'materialized view' WHEN 's' THEN 'special' WHEN 'f' THEN 'foreign table' WHEN 'p' THEN 'table' END as "type"
    ,pg_catalog.pg_get_userbyid(c.relowner) as "owner"
FROM pg_catalog.pg_class c
     LEFT JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace
WHERE c.relkind IN ('r','p','s','v','m','f','')
      AND n.nspname !~ '^(pg_|information_schema$)' 
      AND c.relname != 'sequence_setvals'
ORDER BY 1,2
EOT
    my $sth = $self->{dbh}->prepare_cached( $query ) || return( $self->error( sprintf( "Error while preparing query $query: %s", $self->{dbh}->errstr ) ) );
    $sth->execute() || return( $self->error( sprintf( "Error while executing query $query: %s", $sth->errstr ) ) );
    my $all = $sth->fetchall_arrayref( {} );
    return( $all );
}

# See DB::Object
# sub tables_refresh

# See DB::Object
# sub tie

sub trace($;@)
{
    my $self = shift( @_ );
    # Value is a numeric level; see parse_trace_flag.
    return( $self->error( "Trace can only be used on active connection. Use connect first." ) ) if( !$self->{dbh} );
    if( @_ )
    {
        # my( $opt, $filename ) = @_;
        $self->{dbh}->trace( @_ );
    }
    return( $self->{dbh}->trace );
}

sub trace_msg(@)
{
    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' ) );