view release on metacpan or  search on metacpan

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

        warn( "The options '", join( ', ', @errors ), "' were either not recognized or malformed and thus were ignored.\n" );
    }
    # Check statement
    my $select = '';
    if( $sth && ref( $sth ) && ( $sth->isa( "DB::Object::Postgres::Statement" ) || $sth->can( 'as_string' ) ) )
    {
        $select = $sth->as_string();
        if( $select !~ /^\s*(?:IGNORE|REPLACE)*\s*\bSELECT\s+/ )
        {
            return( $self->error( "SELECT statement to use to create table is invalid:\n$select" ) );
        }
    }
    if( $self->exists() == 0 )
    {
        my $query = 'CREATE ' . ( $temp ? 'TEMPORARY ' : '' ) . "TABLE $table ";
        # Structure of table if any - 
        # structure may very well be provided using a select statement, such as:
        # CREATE TEMPORARY TABLE ploppy TYPE=HEAP COMMENT='this is kewl' MAX_ROWS=10 SELECT * FROM some_table LIMIT 0,0
        my $def    = "(\n" . CORE::join( ",\n", @$data ) . "\n)" if( $data && ref( $data ) && @$data );
        $def      .= " INHERITS (" . $opt->{ 'inherits' } . ")" if( $opt->{ 'inherits' } );
        my $tdef   = CORE::join( ' ', map{ "\U$_\E = $opt->{ $_ }" } @options );
        if( !$def && !$select )
        {
            return( $self->error( "Lacking table '$table' structure information to create it." ) );
        }
        $query .= join( ' ', $def, $tdef, $select );
        my $new = $self->database_object->prepare( $query ) ||
        return( $self->error( "Error while preparing query to create table '$table':\n$query", $self->database_object->errstr() ) );
        # Trick so other method may follow, such as as_string(), fetchrow(), rows()
        if( !defined( wantarray() ) )
        {
            # print( STDERR "create(): wantarrays in void context.\n" );
            $new->execute() ||
            return( $self->error( "Error while executing query to create table '$table':\n$query", $new->errstr() ) );
        }
        $self->reset_structure;
        $self->database_object->table_push( $table );
        return( $new );
    }
    else
    {
        return( $self->error( "Table '$table' already exists." ) );
    }
}

sub create_info
{
    my $self    = shift( @_ );
    my $table   = $self->{table};
    $self->structure || return( $self->pass_error );
    my $struct  = $self->{structure};
    my $fields  = $self->{fields};
    my $default = $self->{default};
    my $primary = $self->{primary};
    my @output = ();
    foreach my $field ( sort{ $fields->{ $a } <=> $fields->{ $b } } keys( %$fields ) )
    {
        push( @output, "$field $struct->{ $field }" );
    }
    push( @output, "PRIMARY KEY(" . CORE::join( ',', @$primary ) . ")" ) if( $primary && @$primary );
    my $info = $self->stat( $table );
    my @opt  = ();
    my $addons = $info->{create_options};
    if( $addons )
    {
        $addons =~ s/(\A|\s+)([\w\_]+)\s*=\s*/$1\U$2\E=/g;
        push( @opt, $addons );
    }
    push( @opt, "COMMENT='" . quotemeta( $info->{ 'comment' } ) . "'" ) if( $info->{comment} );
    my $str = "CREATE TABLE $table (\n\t" . CORE::join( ",\n\t", @output ) . "\n)";
    $str   .= ' ' . CORE::join( ' ', @opt ) if( @opt );
    $str   .= ';';
    return( @output ? $str : undef() );
}

# NOTE: sub default is inherited from DB::Object::Tables
# sub default

# <https://www.postgresql.org/docs/10/sql-altertable.html>
sub disable_trigger
{
    my $self  = shift( @_ );
    my $table = $self->{table} || 
        return( $self->error( "No table was provided to disable trigger." ) );
    my $opts  = $self->_get_args_as_hash( @_ );
    $opts->{all} //= 0;
    # This feature exists only since version 8.1
    unless( $self->database_object->version >= version->declare( '8.1' ) )
    {
        return( $self->error( "Disabling trigger on a table requires PostgreSQL version 8.1 or higher." ) );
    }
    my $query = 'ALTER TABLE ' . $table . ' DISABLE TRIGGER ';
    if( defined( $opts->{name} ) && length( $opts->{name} ) )
    {
        $query .= $opts->{name};
    }
    else
    {
        $query .= $opts->{all} ? 'ALL' : 'USER';
    }
    my $sth = $self->database_object->prepare( $query ) ||
        return( $self->error( "Error while preparing query to disable trigger for table '$table':\n$query", $self->database_object->errstr() ) );
    if( !defined( wantarray() ) )
    {
        $sth->execute() ||
        return( $self->error( "Error while executing query to disable trigger for table '$table':\n$query", $sth->errstr() ) );
    }
    return( $sth );
}

sub drop
{
    my $self  = shift( @_ );
    my $table = $self->{table} || 
    return( $self->error( "No table was provided to drop." ) );
    my $opts  = $self->_get_args_as_hash( @_ );
    my $query = 'DROP TABLE';
    $query   .= ' IF EXISTS' if( $opts->{ 'if-exists' } || $opts->{if_exists} );
    $query   .= " $table";
    if( $opts->{cascade} )
    {

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

sub on_conflict
{
    my $self = shift( @_ );
    my $q = $self->_reset_query;
    # Void
    return( $q->on_conflict( @_ ) ) if( !defined( wantarray() ) );
    if( wantarray() )
    {
        my( @val ) = $q->on_conflict( @_ ) || return( $self->pass_error( $q->error ) );
        return( @val );
    }
    else
    {
        my $val = $q->on_conflict( @_ );
        return( $self->pass_error( $q->error ) ) if( !defined( $val ) );
        return( $val );
    }
}

sub optimize { return( shift->error( "optimize() is not implemented PostgreSQL." ) ); }

sub parent { return( shift->_set_get_scalar( 'parent', @_ ) ); }

sub qualified_name
{
    my $self = shift( @_ );
    my @val = ();
    CORE::push( @val, $self->database_object->database ) if( $self->{prefixed} > 2 );
    CORE::push( @val, $self->schema ) if( $self->{prefixed} > 1 && $self->schema );
    CORE::push( @val, $self->name );
    return( CORE::join( '.', @val ) );
}

sub rename
{
    my $self  = shift( @_ );
    my $table = $self->{table} ||
        return( $self->error( 'No table was provided to rename' ) );
    my $new   = shift( @_ ) ||
        return( $self->error( "No new table name was provided to rename table '$table'." ) );
    if( $new !~ /^[\w\_]+$/ )
    {
        return( $self->error( "Bad new table name '$new'." ) );
    }
    my $query = "ALTER TABLE $table RENAME TO $new";
    my $sth   = $self->database_object->prepare( $query ) ||
        return( $self->error( "Error while preparing query to rename table '$table' into '$new':\n$query", $self->database_object->errstr() ) );
    if( !defined( wantarray() ) )
    {
        $sth->execute() ||
            return( $self->error( "Error while executing query to rename table '$table' into '$new':\n$query", $sth->errstr() ) );
    }
    $self->reset_structure;
    return( $sth );
}

sub repair { return( shift->error( "repair() is not implemented PostgreSQL." ) ); }

sub reset { return( shift->DB::Object::Tables::reset( @_ ) ); }

sub stat { return( shift->error( "stat() is not implemented PostgreSQL." ) ); }

sub structure
{
    my $self  = shift( @_ );
    return( $self->_clone( $self->{_cache_structure} ) ) if( $self->{_cache_structure} && !CORE::length( $self->{_reset_structure} // '' ) );
    my $table = $self->{table} ||
        return( $self->error( "No table provided to get its structure." ) );
    my $struct  = $self->{structure} // {};
    my $fields  = $self->{fields} // {};
    my $types_dict = $self->database_object->datatype_dict;
    $self->_load_class( 'DB::Object::Fields::Field' ) || return( $self->pass_error );
    my $q = $self->_reset_query;
    # <https://stackoverflow.com/questions/6777456/list-all-index-names-column-names-and-its-table-name-of-a-postgresql-database>

    # If we have a cache, use it instead of reprocessing it.
    # <https://stackoverflow.com/questions/52376045/why-does-atttypmod-differ-from-character-maximum-length>
#     my $query = <<EOT;
# SELECT
#      a.table_schema AS "schema_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 "table_type"
#     ,a.column_name AS "field"
#     ,a.ordinal_position AS "field_num"
#     ,a.column_default AS "default"
#     ,a.*
# FROM information_schema.columns a
# LEFT JOIN pg_catalog.pg_class c ON c.relname = a.table_name
# WHERE a.table_name = ?
# ORDER BY a.ordinal_position
# EOT
    # <https://www.postgresql.org/docs/14/catalog-pg-attrdef.html>
    # We could use:
    # generate_subscripts(i.indkey, 1)
    # instead of:
    # generate_series(1,array_upper(string_to_array(i.indkey::text, ' ' )::int2[],1))
    # but this is not supported by PostgreSQL v8.0; only from v8.4 onward
    my $query = <<EOT;
SELECT 
     n.nspname AS "schema_name"
    ,c.relname AS "table_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 "table_type"
    ,a.attname AS "field"
    ,a.attnum AS "field_num"
    ,CASE
        WHEN a.atttypmod = -1 THEN null
        WHEN t.oid IN (1042, 1043) THEN a.atttypmod - 4
        WHEN t.oid IN (1560, 1562) THEN a.atttypmod
        ELSE NULL
     END AS "character_maximum_length"
    ,CASE SUBSTRING(t.typname,1,1)
        WHEN '_' THEN SUBSTRING(t.typname,2)
        ELSE t.typname
     END AS "data_type"
    ,pg_catalog.format_type(a.atttypid,a.atttypmod) AS "format_type"