view release on metacpan or  search on metacpan

lib/Geoffrey/Converter/Pg.pm  view on Meta::CPAN

        real             => 'real',
        refcursor        => 'refcursor',
        regclass         => 'regclass',
        regconfig        => 'regconfig',
        regdictionary    => 'regdictionary',
        regoper          => 'regoper',
        regoperator      => 'regoperator',
        regproc          => 'regproc',
        regprocedure     => 'regprocedure',
        regtype          => 'regtype',
        reltime          => 'reltime',
        serial           => 'serial',
        smallint         => 'smallint',
        smallserial      => 'smallserial',
        smgr             => 'smgr',
        text             => 'text',
        tid              => 'tid',
        timestamp        => 'timestamp without time zone',
        timestamp_tz     => 'timestamp with time zone',
        time             => 'time without time zone',
        time_tz          => 'time with time zone',
        tinterval        => 'tinterval',
        tsquery          => 'tsquery',
        tsrange          => 'tsrange',
        tstzrange        => 'tstzrange',
        tsvector         => 'tsvector',
        txid_snapshot    => 'txid_snapshot',
        uuid             => 'uuid',
        xid              => 'xid',
        xml              => 'xml',
    };
} ## end sub types

sub select_get_table {
    return q~SELECT t.table_name AS table_name FROM information_schema.tables t WHERE t.table_type = 'BASE TABLE' AND t.table_schema = ? AND t.table_name = ?~;
}

sub convert_defaults {
    my ( $self, $params ) = @_;
    $params->{default} ? $params->{default} =~ s/^'(.*)'$/$1/ : undef;
    if ( $params->{default} && $params->{type} eq 'bit' ) {
        return qq~$params->{default}::bit~;
    }
    return $params->{default};
} ## end sub convert_defaults

sub parse_default {
    my ( $self, $default_value ) = @_;
    return $1 * 1 if ( $default_value =~ m/\w+\s*(?:\((\d+)\))::(.*)(?:\;|\s)/ );
    return $default_value;
}

sub can_create_empty_table { return 1 }

sub colums_information {
    my ( $self, $ar_raw_data ) = @_;
    return [] if scalar @{$ar_raw_data} == 0;
    my $table_row = shift @{$ar_raw_data};
    $table_row->{sql} =~ s/^.*(CREATE|create) .*\(//g;
    my $columns = [];
    for ( split m/,/, $table_row->{sql} ) {
        s/^\s*(.*)\s*$/$1/g;
        my $rx_not_null      = 'NOT NULL';
        my $rx_primary_key   = 'PRIMARY KEY';
        my $rx_default       = 'SERIAL|DEFAULT';
        my $rx_column_values = qr/($rx_not_null)*\s($rx_primary_key)*.*($rx_default \w{1,})*/;
        my @column           = m/^(\w+)\s([[:upper:]]+)(\(\d*\))*\s$rx_column_values$/;
        next                                            if scalar @column == 0;
        $column[$I_CONST_LENGTH_VALUE] =~ s/([\(\)])//g if $column[$I_CONST_LENGTH_VALUE];
        push @{$columns},
            {
            name => $column[0],
            type => $column[1],
            ( $column[$I_CONST_LENGTH_VALUE]      ? ( length      => $column[$I_CONST_LENGTH_VALUE] )      : () ),
            ( $column[$I_CONST_NOT_NULL_VALUE]    ? ( not_null    => $column[$I_CONST_NOT_NULL_VALUE] )    : () ),
            ( $column[$I_CONST_PRIMARY_KEY_VALUE] ? ( primary_key => $column[$I_CONST_PRIMARY_KEY_VALUE] ) : () ),
            ( $column[$I_CONST_DEFAULT_VALUE]     ? ( default     => $column[$I_CONST_DEFAULT_VALUE] )     : () ),
            };
    } ## end for ( split m/,/, $table_row...)
    return $columns;
} ## end sub colums_information

sub index_information {
    my ( $self, $ar_raw_data ) = @_;
    my @mapped = ();
    for ( @{$ar_raw_data} ) {
        next if !$_->{sql};
        my ($s_columns) = $_->{sql} =~ m/\((.*)\)$/;
        my @columns     = split m/,/, $s_columns;
        s/^\s+|\s+$//g for @columns;
        push @mapped, { name => $_->{name}, table => $_->{tbl_name}, columns => \@columns };
    } ## end for ( @{$ar_raw_data} )
    return \@mapped;
} ## end sub index_information

sub view_information {
    my ( $self, $ar_raw_data ) = @_;
    return [] unless $ar_raw_data;
    return [ map { { name => $_->{name}, sql => $_->{sql} } } @{$ar_raw_data} ];
}

sub constraints {
    return shift->_get_value( 'constraints', 'Geoffrey::Converter::Pg::Constraints', 1 );
}

sub index {
    my ( $self, $new_value ) = @_;
    $self->{index} = $new_value if defined $new_value;
    return $self->_get_value( 'index', 'Geoffrey::Converter::Pg::Index' );
}

sub table {
    return shift->_get_value( 'table', 'Geoffrey::Converter::Pg::Tables' );
}

sub view {
    return shift->_get_value( 'view', 'Geoffrey::Converter::Pg::View', 1 );
}

sub foreign_key {
    my ( $self, $new_value ) = @_;
    $self->{foreign_key} = $new_value if defined $new_value;
    return $self->_get_value( 'foreign_key', 'Geoffrey::Converter::Pg::ForeignKey', 1 );
}

sub trigger {
    return shift->_get_value( 'trigger', 'Geoffrey::Converter::Pg::Trigger', 1 );
}

sub primary_key {
    return shift->_get_value( 'primary_key', 'Geoffrey::Converter::Pg::PrimaryKey', 1 );
}

sub unique {
    return shift->_get_value( 'unique', 'Geoffrey::Converter::Pg::UniqueIndex', 1 );
}

sub sequence {
    return shift->_get_value( 'sequence', 'Geoffrey::Converter::Pg::Sequence', 1 );
}

sub _get_value {
    my ( $self, $key, $s_package_name, $b_ignore_require ) = @_;
    $self->{$key} //= $self->_set_value( $key, $s_package_name, $b_ignore_require );
    return $self->{$key};
}

sub _set_value {
    my ( $self, $key, $s_package_name, $b_ignore_require ) = @_;