Changeset 24081

Show
Ignore:
Timestamp:
11/18/08 14:13:42 (5 years ago)
Author:
yappo
Message:

add column suger

Location:
lang/perl/Data-Model/trunk
Files:
1 added
3 modified

Legend:

Unmodified
Added
Removed

  • lang/perl/Data-Model/trunk/lib/Data/Model/Schema.pm

    r23975 r24081  
    1212 
    1313    no strict 'refs'; 
    14     for my $name (qw/ driver install_model schema column columns key index unique schema_options /) { 
     14    for my $name (qw/ driver install_model schema column columns key index unique schema_options add_column_suger /) { 
    1515        *{"$caller\::$name"} = \&$name; 
    1616    } 
    … …  
    103103} 
    104104 
    105 sub _column (@) { 
    106     my($schema, $column, $type, $options) = @_; 
    107     $schema->column->{$column} = +{ 
    108         type    => $type    || 'char', 
    109         options => $options || +{}, 
    110     }; 
    111 } 
    112105sub column ($;$;$) { 
    113106    my($name, $schema) = _get_model_schema; 
    … …  
    142135} 
    143136 
     137 
     138our $COLUMN_SUGER = +{}; 
     139sub add_column_suger (@) { 
     140    my($column, $type, $options) = @_; 
     141    Carp::croak "usage: add_column_suger 'table_name.column_name' => type => { args };" 
     142        unless $column =~ /^[^\.+]+\.[^\.+]+$/; 
     143     
     144    $COLUMN_SUGER->{$column} = +{ 
     145        type    => $type    || 'char', 
     146        options => $options || +{}, 
     147    }; 
     148} 
     149 
    1441501; 
    145151 

  • lang/perl/Data-Model/trunk/lib/Data/Model/Schema/Properties.pm

    r23975 r24081  
    44use base qw(Data::Model::Accessor); 
    55 
     6use Data::Model::Schema; 
    67use Data::Model::Schema::SQL; 
    78 
    … …  
    3940 
    4041sub add_column { 
    41     my($self, $column, $type, $options) = @_; 
     42    my $self = shift; 
     43    my($column, $type, $options) = @_; 
     44    return $self->add_column_suger(@_) if $column =~ /^[^\.+]+\.[^\.+]+$/; 
    4245    Carp::croak "Column can't be called '$column': reserved name"  
    4346            if grep { lc $_ eq lc $column } @RESERVED; 
     47 
    4448    push @{ $self->{columns} }, $column; 
    4549    $self->{column}->{$column} = +{ 
    … …  
    4751        options => $options || +{}, 
    4852    }; 
     53} 
     54 
     55sub add_column_suger { 
     56    my $self   = shift; 
     57    my $name   = shift; 
     58    my $suger = $Data::Model::Schema::COLUMN_SUGER; 
     59    Carp::croak "Undefined column of '$name'"  
     60        unless exists $suger->{$name} && $suger->{$name}; 
     61 
     62    my $conf = $suger->{$name}; 
     63    my %clone = ( 
     64        type    => $conf->{type}, 
     65        options => +{ %{ $conf->{options} } }, 
     66    ); 
     67    my $column; 
     68    if (@_ == 0 || ref($_[0])) { 
     69        my $model; 
     70        ($model, $column) = split /\./, $name; 
     71        unless ($self->{model} eq $model) { 
     72            $column = join '_', $model, $column; 
     73        } 
     74    } else { 
     75        $column = shift; 
     76    } 
     77    if (@_ && ref($_[0]) eq 'HASH') { 
     78        $clone{options} = +{ %{ $clone{options} }, %{ ( shift ) } }  
     79    } 
     80    $self->add_column($column, $clone{type}, $clone{options}); 
    4981} 
    5082 

  • lang/perl/Data-Model/trunk/t/020_mock/create-sql.t

    r23975 r24081  
    22use Mock::Tests::Basic; 
    33use Data::Model::Driver::DBI; 
    4 use Test::More tests => 8; 
     4use Test::More tests => 14; 
    55 
    66BEGIN { 
    … …  
    1111        password => 'password', 
    1212    ); 
    13     eval "use Mock::Basic"; $@ and die $@; 
    14     eval "use Mock::Index"; $@ and die $@; 
     13    use_ok('Mock::Basic'); 
     14    use_ok('Mock::Index'); 
     15    use_ok('Mock::ColumnSuger'); 
    1516} 
    1617 
    … …  
    6970)"); 
    7071is($multi_index[1], "CREATE INDEX idx ON multi_index (idx1,idx2,idx3)"); 
     72 
     73 
     74$mock = Mock::ColumnSuger->new; 
     75 
     76my @author = $mock->get_schema('author')->sql->as_sql; 
     77is($author[0], "CREATE TABLE author ( 
     78    id              INTEGER         NOT NULL PRIMARY KEY, 
     79    name            VARCHAR(128)    NOT NULL 
     80)"); 
     81 
     82my @book = $mock->get_schema('book')->sql->as_sql; 
     83is($book[0], "CREATE TABLE book ( 
     84    id              INTEGER         NOT NULL PRIMARY KEY, 
     85    author_id       INT             UNSIGNED NOT NULL, 
     86    sub_author_id   INT             UNSIGNED NOT NULL, 
     87    title           VARCHAR(255)    NOT NULL, 
     88    description     TEXT            NOT NULL DEFAULT 'not yet writing', 
     89    recommend       TEXT            
     90)"); 
     91is($book[1], "CREATE INDEX author_id ON book (author_id)");