view release on metacpan or  search on metacpan

lib/Alzabo/RDBMSRules/PostgreSQL.pm  view on Meta::CPAN

package Alzabo::RDBMSRules::PostgreSQL;

use strict;
use vars qw($VERSION);

use Alzabo::Exceptions ( abbr => [ 'recreate_table_exception' ] );
use Alzabo::RDBMSRules;

use Digest::MD5;

use Text::Balanced ();

use base qw(Alzabo::RDBMSRules);

use Params::Validate qw( validate_pos );
Params::Validate::validation_options( on_fail => sub { Alzabo::Exception::Params->throw( error => join '', @_ ) } );

$VERSION = 2.0;

1;

sub new
{
    my $proto = shift;
    my $class = ref $proto || $proto;

    return bless {}, $class;
}

sub validate_schema_name
{
    my $self = shift;
    my $name = shift->name;

    $self->_check_name($name, 'schema');

    Alzabo::Exception::RDBMSRules->throw( error => "Schema name ($name) contains a single quote char (')" )
        if index($name, "'") != -1;
}

sub validate_table_name
{
    my $self = shift;

    $self->_check_name( shift->name, 'table' );
}

sub validate_column_name
{
    my $self = shift;

    $self->_check_name( shift->name, 'column' );
}

sub _check_name
{
    my $self = shift;
    my $name = shift;

    Alzabo::Exception::RDBMSRules->throw( error => "Name ($name) must be at least one character long" )
        unless length $name;
    Alzabo::Exception::RDBMSRules->throw( error => "Name ($name) is too long.  Names must be 31 characters or less." )
        if length $name > 31;
    Alzabo::Exception::RDBMSRules->throw( error => "Name ($name) must start with an alpha or underscore(_) and must contain only alphanumerics and underscores." )
        unless $name =~ /\A[a-zA-Z]\w*\z/;
}

sub validate_column_type
{
    my $self = shift;
    my $type = uc shift;
    my $table = shift;

    if ( $table->primary_key_size > 1 )
    {
        return 'INT4' if $type =~ /^SERIAL4?$/;
        return 'INT8' if $type eq 'BIGSERIAL' or $type eq 'SERIAL8';
    }

    my %simple_types = map { $_ => 1 } qw( ABSTIME
                                           BIT
                                           BIGINT
                                           BIGSERIAL
                                           BOOL
                                           BOOLEAN
                                           BOX
                                           BYTEA
                                           CHAR
                                           CHARACTER
                                           CIDR
                                           CIRCLE
                                           DATE
                                           DECIMAL
                                           FLOAT
                                           FLOAT4
                                           FLOAT8
                                           INET
                                           SMALLINT
                                           INT
                                           INTEGER
                                           INT2
                                           INT4
                                           INT8
                                           INTERVAL
                                           MACADDR
                                           MONEY
                                           NUMERIC
                                           OID
                                           RELTIME
                                           SERIAL
                                           SERIAL4
                                           SERIAL8
                                           TEXT
                                           TIME
                                           TIMESTAMP
                                           TIMESTAMPTZ
                                           TIMETZ
                                           VARBIT
                                           VARCHAR );

    return 'INTEGER' if $type eq 'INT' || $type eq 'INT4';
    return 'SERIAL' if $type eq 'SERIAL4';
    return 'INT8' if $type eq 'BIGINT';

    return $type if $simple_types{$type};

    return $type if $type =~ /BIT\s+VARYING/;

    return $type if $type =~ /CHARACTER\s+VARYING/;

    return $type if $type =~ /\ABOX|CIRCLE|LINE|LSEG|PATH|POINT|POLYGON/;

    Alzabo::Exception::RDBMSRules->throw( error => "Invalid column type: $type" );
}

sub validate_column_length
{
    my $self = shift;
    my $column = shift;

    if ( defined $column->length )
    {
        Alzabo::Exception::RDBMSRules->throw( error => "Length is not supported except for char, varchar, decimal, float, and numeric columns (" . $column->name . " column)" )
            unless $column->type =~ /\A(?:(?:VAR)?CHAR|CHARACTER|DECIMAL|FLOAT|NUMERIC|(?:VAR)?BIT|BIT VARYING)\z/i;
    }

    if ( defined $column->precision )
    {
        Alzabo::Exception::RDBMSRules->throw( error => "Precision is not supported except for decimal, float, and numeric columns" )
            unless $column->type =~ /\A(?:DECIMAL|FLOAT|NUMERIC)\z/i;
    }
}

# placeholder in case we decide to try to do something better later
sub validate_table_attribute { 1 }

sub validate_column_attribute
{
    my $self = shift;
    my %p = @_;

    my $column = $p{column};
    my $type = $column->type;
    my $a = uc $p{attribute};
    $a =~ s/\A\s//;
    $a =~ s/\s\z//;

    return if  $a =~ /\A(?:UNIQUE\z|CHECK|CONSTRAINT|REFERENCES)/i;

    Alzabo::Exception::RDBMSRules->throw( error => "Only column constraints are supported as column attributes" )
}

sub validate_primary_key
{
    my $self = shift;
    my $col = shift;

    my $serial_col = (grep { $_->type =~ /^(?:SERIAL(?:4|8)?|BIGSERIAL)$/ } $col->table->primary_key)[0];
    if ( defined $serial_col &&
         $serial_col->name ne $col->name )
    {
        $serial_col->set_type( $serial_col->type =~ /^SERIAL4?$/
                               ? 'INT4'
                               : 'INT8' );
    }
}

sub validate_sequenced_attribute
{
    my $self = shift;
    my $col = shift;

    Alzabo::Exception::RDBMSRules->throw( error => 'Non-number columns cannot be sequenced' )
        unless $col->is_integer || $col->is_floating_point;
}

sub validate_index
{
    my $self = shift;
    my $index = shift;

    foreach my $c ( $index->columns )
    {
        Alzabo::Exception::RDBMSRules->throw( error => "PostgreSQL does not support index prefixes" )
            if defined $index->prefix($c)
    }

    Alzabo::Exception::RDBMSRules->throw( error => "PostgreSQL does not support fulltext indexes" )
        if $index->fulltext;
}

sub type_is_integer
{
    my $self = shift;
    my $col  = shift;
    my $type = uc $col->type;

    return 1 if $type =~ /\A(?:
                             INT(?:2|4|8)?|
                             SMALLINT|
                             INTEGER|
                             OID|
                             SERIAL(?:4|8)?|
                             BIGSERIAL
                            )
                          \z
                         /x;
}

sub type_is_floating_point
{
    my $self = shift;
    my $col  = shift;
    my $type = uc $col->type;

    return 1 if $type =~ /\A(?:
                             DECIMAL|
                             FLOAT(?:4|8)?|
                             MONEY|
                             NUMERIC
                            )
                          \z
                         /x;
}

sub type_is_char
{
    my $self = shift;
    my $col  = shift;
    my $type = uc $col->type;

    return 1 if $type =~ /(?:CHAR|CHARACTER|TEXT)\z/;
}

sub type_is_date
{
    my $self = shift;

lib/Alzabo/RDBMSRules/PostgreSQL.pm  view on Meta::CPAN

    my $type = uc $col->type;

    return 1 if $type =~ /\ABYTEA\z/;
}

sub blob_type { return 'BYTEA' }

sub column_types
{
    return ( qw( INTEGER
                 INT2
                 INT8
                 NUMERIC
                 FLOAT
                 FLOAT4

                 CHAR
                 VARCHAR
                 TEXT

                 BYTEA

                 DATE
                 TIME
                 TIMESTAMP
                 INTERVAL

                 SERIAL
                 BIGSERIAL

                 BOOLEAN

                 BIT
               ),
               'BIT VARYING',

             qw( INET
                 CIDR
                 MACADDR ) );
}

my %features = map { $_ => 1 } qw ( extended_column_types
                                    constraints
                                    functional_indexes
                                    allows_raw_default
                                  );
sub feature
{
    shift;
    return $features{+shift};
}

sub quote_identifiers { 1 }

sub quote_identifiers_character { '"' }

sub schema_sql
{
    my $self = shift;

    validate_pos( @_, { isa => 'Alzabo::Schema' } );

    my $schema = shift;

    my @sql = $self->SUPER::schema_sql($schema);

    # This has to come at the end because we don't know which tables
    # reference other tables.
    foreach my $t ( $schema->tables )
    {
        foreach my $con ( grep { /\s*(?:check|constraint)/i } $t->attributes )
        {
            push @sql, $self->table_constraint_sql($t);
        }


        foreach my $fk ( $t->all_foreign_keys )
        {
            push @sql, $self->foreign_key_sql($fk);
        }
    }

    return @sql;
}

sub table_sql
{
    my $self = shift;
    my $table = shift;

    my $create_sequence = shift;

    # Create table sequence by default
    $create_sequence = 1 unless defined $create_sequence;

    my $sql = qq|CREATE TABLE "| . $table->name . qq|" (\n  |;

    $sql .= join ",\n  ", map { $self->column_sql($_) } $table->columns;

    my @att = $table->attributes;

    if (my @pk = $table->primary_key)
    {
        $sql .= ",\n";
        $sql .= '  PRIMARY KEY (';
        $sql .= join ', ', map { '"' . $_->name . '"' } @pk;
        $sql .= ")\n";
    }

    $sql .= ")\n";

    my @sql = ($sql);

    foreach my $i ( $table->indexes )
    {
        push @sql, $self->index_sql($i);
    }

    if ($create_sequence)
    {
        foreach my $c ( grep { $_->sequenced } $table->columns )