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;
    my $col  = shift;
    my $type = uc $col->type;

    return 1 if $type eq 'DATE' || $self->type_is_datetime($col);
}

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