package Mock::AliasColumn;
use strict;
use warnings;
use base 'Data::Model';
use Data::Model::Schema;
{
package Name;
sub new {
my($class, %args) = @_;
bless { %args }, $class;
}
sub name { shift->{name} };
}
install_model name => schema {
driver $main::DRIVER;
key 'id';
column id
=> int => {
auto_increment => 1,
};
columns qw( name nickname );
alias_column name => 'name_name';
alias_column nickname => 'nickname_name'
=> {
inflate => sub {
my $value = shift;
Name->new( name => $value );
},
deflate => sub {
my $obj = shift;
$obj->name;
},
};
};
install_model utf8 => schema {
driver $main::DRIVER;
key 'id';
column id
=> int => {
auto_increment => 1,
};
columns qw( name nickname );
alias_column name => 'utf8_name' => { is_utf8 => 1 };
alias_column nickname => 'utf8_nickname'
=> {
is_utf8 => 1,
inflate => sub {
my $value = shift;
Name->new( name => $value );
},
deflate => sub {
my $obj = shift;
$obj->name;
},
};
};
install_model uri => schema {
driver $main::DRIVER;
key 'id';
index uri_idx => 'uri';
column id
=> int => {
auto_increment => 1,
};
column uri
=> char => {
size => 200,
};
alias_column uri => uri_obj
=> {
inflate => 'URI',
};
};
# aliased key test
install_model keytest => schema {
driver $main::DRIVER;
key 'c_key';
column c_key => char => {
require => 1,
size => 16,
deflate => sub {
($_[0] =~ /^prefix_/) ? $_[0] : 'prefix_' . $_[0];
},
};
alias_column c_key => 'key_noprefix'
=> {
inflate => sub {
my $val = $_[0];
$val =~ s/^.......//;
$val;
},
deflate => sub { 'prefix_' . $_[0] },
};
column data
=> char => {
size => 100,
};
};
1;