view release on metacpan or  search on metacpan

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

package Alzabo::RDBMSRules::MySQL;

use strict;
use vars qw($VERSION);

use Alzabo::RDBMSRules;

use base qw(Alzabo::RDBMSRules);

$VERSION = 2.0;

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

    return bless {}, $class;
}

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

    Alzabo::Exception::RDBMSRules->throw( error => "Schema name must be at least one character long" )
        unless length $name;

    # These are characters that are illegal in a dir name.  I'm trying
    # to accomodate both Win32 and UNIX here.
    foreach my $c ( qw( : \ / ) )
    {
        Alzabo::Exception::RDBMSRules->throw( error => "Schema name contains an illegal character ($c)" )
            if index($name, $c) != -1;
    }
}

# Note: These rules are valid for MySQL 3.22.x.  MySQL 3.23.x is
# actually less restrictive but this should be enough freedom.

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

    Alzabo::Exception::RDBMSRules->throw( error => "Table name must be at least one character long" )
        unless length $name;
    Alzabo::Exception::RDBMSRules->throw( error => "Table name is too long.  Names must be 64 characters or less." )
        if length $name >= 64;
    Alzabo::Exception::RDBMSRules->throw( error => "Table name must only contain alphanumerics or underscore(_)." )
        if $name =~ /\W/;
}

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

    Alzabo::Exception::RDBMSRules->throw( error => "Column name must be at least one character long" )
        unless length $name;
    Alzabo::Exception::RDBMSRules->throw( error => 'Name is too long.  Names must be 64 characters or less.' )
        if length $name >= 64;
    Alzabo::Exception::RDBMSRules->throw( error =>
                                          'Name contains characters that are not alphanumeric or the dollar sign ($).' )
        if $name =~ /[^\w\$]/;
    Alzabo::Exception::RDBMSRules->throw( error =>
                                          'Name contains only digits.  Names must contain at least one alpha character.' )
        unless $name =~ /[^\W\d]/;
}

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

    $type = 'INTEGER' if uc $type eq 'INT';

    # Columns which take no modifiers.
    my %simple_types = map {$_ => 1} ( qw( DATE
                                           DATETIME
                                           TIME
                                           TINYBLOB
                                           TINYTEXT
                                           BLOB
                                           TEXT
                                           MEDIUMBLOB
                                           MEDIUMTEXT
                                           LONGBLOB
                                           LONGTEXT
                                           INTEGER
                                           TINYINT
                                           SMALLINT
                                           MEDIUMINT
                                           BIGINT
                                           FLOAT
                                           DOUBLE
                                           REAL
                                           DECIMAL
                                           NUMERIC
                                           TIMESTAMP
                                           CHAR
                                           VARCHAR
                                           YEAR
                                         ),
                                     );

    return uc $type if $simple_types{uc $type};

    return 'DOUBLE' if $type =~ /DOUBLE\s+PRECISION/i;

    return 'CHAR' if $type =~ /\A(?:NATIONAL\s+)?CHAR(?:ACTER)?/i;
    return 'VARCHAR' if $type =~ /\A(?:NATIONAL\s+)?(?:VARCHAR|CHARACTER VARYING)/i;

    my $t = $self->_capitalize_type($type);
    return $t if $t;

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

sub _capitalize_type
{
    my $self = shift;
    my $type = shift;

    if ( uc substr($type, 0, 4) eq 'ENUM' )
    {
        return 'ENUM' . substr($type, 4);
    }
    elsif ( uc substr($type, 0, 3) eq 'SET' )
    {
        return 'SET' . substr($type, 3);
    }
    else
    {
        return uc $type;
    }
}

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

    # integer column
    if ( $column->type =~ /\A(?:(?:(?:TINY|SMALL|MEDIUM|BIG)?INT)|INTEGER)/i )
    {
        Alzabo::Exception::RDBMSRules->throw( error => "Max display value is too long.  Maximum allowed value is 255." )
            if defined $column->length && $column->length > 255;

        Alzabo::Exception::RDBMSRules->throw( error => $column->type . " columns cannot have a precision." )
            if defined $column->precision;
        return;
    }

    if ( $column->type =~ /\A(?:FLOAT|DOUBLE(?:\s+PRECISION)?|REAL)/i )
    {
        if (defined $column->length)
        {
            Alzabo::Exception::RDBMSRules->throw( error => "Max display value is too long.  Maximum allowed value is 255." )
                if $column->length > 255;

            Alzabo::Exception::RDBMSRules->throw( error => "Max display value specified without floating point precision." )
                unless defined $column->precision;

            Alzabo::Exception::RDBMSRules->throw( error =>
                                                  "Floating point precision is too high.  The maximum value is " .
                                                  "30 or the maximum display size - 2, whichever is smaller." )
                if $column->precision > 30 || $column->precision > ($column->length - $column->precision);
        }

        return;
    }

    if ( $column->type =~ /\A(?:DECIMAL|NUMERIC)\z/i )
    {
        Alzabo::Exception::RDBMSRules->throw( error => "Max display value is too long.  Maximum allowed value is 255." )
            if defined $column->length && $column->length > 255;
        Alzabo::Exception::RDBMSRules->throw( error =>
                                              "Floating point precision is too high.  The maximum value is " .
                                              "30 or the maximum display size - 2, whichever is smaller." )
            if defined $column->precision && ($column->precision > 30 || $column->precision > ($column->length - 2) );
        return;
    }

    if ( uc $column->type eq 'TIMESTAMP' )
    {
        Alzabo::Exception::RDBMSRules->throw( error => "Max display value is too long.  Maximum allowed value is 14." )
            if defined $column->length && $column->length > 14;
        Alzabo::Exception::RDBMSRules->throw( error => $column->type . " columns cannot have a precision." )
            if defined $column->precision;
        return;
    }

    if ( $column->type =~ /\A(?:(?:NATIONAL\s+)?VAR)?(?:CHAR|BINARY)/i )
    {
        Alzabo::Exception::RDBMSRules->throw( error => "(VAR)CHAR and (VAR)BINARY columns must have a length provided." )
            unless defined $column->length && $column->length > 0;
        Alzabo::Exception::RDBMSRules->throw( error => "Max display value is too long.  Maximum allowed value is 255." )
            if $column->length > 255;
        Alzabo::Exception::RDBMSRules->throw( error => $column->type . " columns cannot have a precision." )
            if defined $column->precision;
        return;
    }

    if ( uc $column->type eq 'YEAR' )
    {
        Alzabo::Exception::RDBMSRules->throw( error => "Valid values for the length specification are 2 or 4." )
            if defined $column->length && ($column->length != 2 && $column->length != 4);
        return;
    }

    Alzabo::Exception::RDBMSRules->throw( error => $column->type . " columns cannot have a length or precision." )
        if defined $column->length || defined $column->precision;
}

# 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 $a = uc $p{attribute};
    $a =~ s/\A\s//;
    $a =~ s/\s\z//;

    if ( $a eq 'UNSIGNED' || $a eq 'ZEROFILL' )
    {
        Alzabo::Exception::RDBMSRules->throw( error => "$a attribute can only be applied to numeric columns" )
            unless $column->is_numeric;
        return;
    }

    if ( $a eq 'AUTO_INCREMENT' )
    {
        Alzabo::Exception::RDBMSRules->throw( error => "$a attribute can only be applied to integer columns" )
            unless $column->is_integer;
        return;
    }

    if ($a eq 'BINARY')
    {
        Alzabo::Exception::RDBMSRules->throw( error => "$a attribute can only be applied to character columns" )
            unless $column->is_character;
        return;
    }

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

    Alzabo::Exception::RDBMSRules->throw( error => "Unrecognized attribute: $a" );
}

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

    Alzabo::Exception::RDBMSRules->throw( error => 'Blob columns cannot be part of a primary key' )
        if $col->type =~ /\A(?:TINY|MEDIUM|LONG)?(?:BLOB|TEXT)\z/i;
}

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

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

    Alzabo::Exception::RDBMSRules->throw( error => 'Only one sequenced column per table is allowed.' )
        if grep { $_ ne $col && $_->sequenced } $col->table->columns;
}

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

    foreach my $c ( $index->columns )
    {
        my $prefix = $index->prefix($c);
        if (defined $prefix)
        {
            Alzabo::Exception::RDBMSRules->throw( error => "Invalid prefix specification ('$prefix')" )
                unless $prefix =~ /\d+/ && $prefix > 0;

            Alzabo::Exception::RDBMSRules->throw( error => 'Non-character/blob columns cannot have an index prefix' )
                unless $c->is_blob || $c->is_character || $c->type =~ /^(?:VAR)BINARY$/i;
        }

        if ( $c->is_blob )
        {
            Alzabo::Exception::RDBMSRules->throw( error => 'Blob columns must have an index prefix' )
                unless $prefix || $index->fulltext;
        }

        if ( $index->fulltext )
        {
            Alzabo::Exception::RDBMSRules->throw( error => 'A fulltext index can only include text or char columns' )
                unless $c->is_character;
        }
    }

    Alzabo::Exception::RDBMSRules->throw( error => 'An fulltext index cannot be unique' )
        if $index->unique && $index->fulltext;

    Alzabo::Exception::RDBMSRules->throw( error => 'MySQL does not support function indexes' )
        if defined $index->function;
}

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

    return 1 if $type =~ /\A(?:(?:TINY|SMALL|MEDIUM|BIG)?INT|INTEGER)\z/;
}

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

    return 1 if $type =~ /\A(?:DECIMAL|NUMERIC|FLOAT|DOUBLE|REAL)\z/;
}

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