Created
December 7, 2010 16:58
-
-
Save gardejo/732055 to your computer and use it in GitHub Desktop.
Several implementation for the table inheritance patterns
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package MyApp::ClassTableInheritance::Schema::Base::Result::Bowler; | |
use namespace::autoclean; | |
use Moose; | |
extends qw( | |
MyApp::ClassTableInheritance::Schema::Base::Result::Cricketer | |
); | |
# **************************************************************** | |
# painful accessor(s) | |
# **************************************************************** | |
sub name { # It is less than smart... | |
my $self = shift; | |
return $self->cricketer->name(@_); # $cricketer->player->name | |
} | |
sub batting_average { # It is less than smart... | |
my $self = shift; | |
return $self->cricketer->batting_average(@_); | |
} | |
# **************************************************************** | |
# business logic(s) | |
# **************************************************************** | |
sub bat { # It is less than smart... | |
my $self = shift; | |
return $self->cricketer->bat(@_); | |
} | |
sub bowl { | |
my $self = shift; | |
printf( | |
"%s (ave.: %0.3f) bowls a ball!\n", | |
$self->name, | |
$self->bowling_average, | |
); | |
return; | |
} | |
# **************************************************************** | |
# compile-time process(es) | |
# **************************************************************** | |
__PACKAGE__->meta->make_immutable; | |
1; | |
__END__ | |
=pod | |
=encoding utf-8 | |
=head1 NAME | |
MyApp::ClassTableInheritance::Schema::Base::Result::Bowler - blah blah blah | |
=head1 SYNOPSIS | |
# yada yada yada | |
=head1 DESCRIPTION | |
blah blah blah | |
=head1 AUTHOR | |
=over 4 | |
=item MORIYA Masaki, alias Gardejo | |
C<< <moriya at cpan dot org> >>, | |
L<http://gardejo.org/> | |
=back | |
=head1 COPYRIGHT AND LICENSE | |
Copyright (c) 2010 MORIYA Masaki, alias Gardejo. | |
This library is free software; | |
you can redistribute it and/or modify it under the same terms as Perl itself. | |
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>. | |
The full text of the license can be found in the F<LICENSE> file included with | |
this distribution. | |
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package MyApp::ClassTableInheritance::Schema::Result::Bowler; | |
use namespace::autoclean; | |
use Moose; | |
use MooseX::Types::Moose qw(Num); | |
extends qw( | |
MyApp::ClassTableInheritance::Schema::Base::Result::Bowler | |
); | |
# **************************************************************** | |
# table setting(s) | |
# **************************************************************** | |
__PACKAGE__->table('bowlers'); | |
__PACKAGE__->add_columns( | |
bowling_average => { | |
data_type => 'float', | |
}, | |
); | |
# Or, use DBIx::Class::MooseColumns | |
with ( | |
'MyApp::Role::Schema::Result::Validatable' => { | |
columns => { | |
bowling_average => { isa => Num }, | |
}, | |
}, | |
); | |
after _prepare_table => sub { | |
my ($class) = @_; | |
$class->belongs_to( | |
'cricketer' => | |
'MyApp::ClassTableInheritance::Schema::Result::Cricketer', | |
'id' | |
); | |
return; | |
}; | |
# **************************************************************** | |
# compile-time process(es) | |
# **************************************************************** | |
__PACKAGE__->_prepare_table; | |
__PACKAGE__->meta->make_immutable; | |
1; | |
__END__ | |
=pod | |
=encoding utf-8 | |
=head1 NAME | |
MyApp::ClassTableInheritance::Schema::Result::Bowler - blah blah blah | |
=head1 SYNOPSIS | |
# yada yada yada | |
=head1 DESCRIPTION | |
blah blah blah | |
=head1 AUTHOR | |
=over 4 | |
=item MORIYA Masaki, alias Gardejo | |
C<< <moriya at cpan dot org> >>, | |
L<http://gardejo.org/> | |
=back | |
=head1 COPYRIGHT AND LICENSE | |
Copyright (c) 2010 MORIYA Masaki, alias Gardejo. | |
This library is free software; | |
you can redistribute it and/or modify it under the same terms as Perl itself. | |
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>. | |
The full text of the license can be found in the F<LICENSE> file included with | |
this distribution. | |
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package MyApp::ConcreteTableInheritance::Schema::Result::Bowler; | |
use namespace::autoclean; | |
use Moose; | |
use MooseX::Types::Moose qw(Num); | |
extends qw( | |
MyApp::ConcreteTableInheritance::Schema::Result::Cricketer | |
); | |
# **************************************************************** | |
# table setting(s) | |
# **************************************************************** | |
__PACKAGE__->table('bowlers'); | |
__PACKAGE__->add_columns( | |
bowling_average => { | |
data_type => 'float', | |
}, | |
); | |
# Or, use DBIx::Class::MooseColumns | |
with ( | |
'MyApp::Role::Schema::Result::Validatable' => { | |
columns => { | |
bowling_average => { isa => Num }, | |
}, | |
}, | |
); | |
after _prepare_table => sub { | |
my ($class) = @_; | |
# some preparations | |
return; | |
}; | |
# **************************************************************** | |
# business logic(s) | |
# **************************************************************** | |
sub bowl { | |
my $self = shift; | |
printf( | |
"%s (ave.: %0.3f) bowls a ball!\n", | |
$self->name, | |
$self->bowling_average, | |
); | |
return; | |
} | |
# **************************************************************** | |
# compile-time process(es) | |
# **************************************************************** | |
__PACKAGE__->_prepare_table; | |
__PACKAGE__->meta->make_immutable; | |
1; | |
__END__ | |
=pod | |
=encoding utf-8 | |
=head1 NAME | |
MyApp::ConcreteTableInheritance::Schema::Result::Bowler - blah blah blah | |
=head1 SYNOPSIS | |
# yada yada yada | |
=head1 DESCRIPTION | |
blah blah blah | |
=head1 AUTHOR | |
=over 4 | |
=item MORIYA Masaki, alias Gardejo | |
C<< <moriya at cpan dot org> >>, | |
L<http://gardejo.org/> | |
=back | |
=head1 COPYRIGHT AND LICENSE | |
Copyright (c) 2010 MORIYA Masaki, alias Gardejo. | |
This library is free software; | |
you can redistribute it and/or modify it under the same terms as Perl itself. | |
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>. | |
The full text of the license can be found in the F<LICENSE> file included with | |
this distribution. | |
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package MyApp::SingleTableInheritance::Schema::Result::Bowler; | |
use namespace::autoclean; | |
use Moose; | |
extends qw( | |
MyApp::SingleTableInheritance::Schema::Result::Cricketer | |
); | |
# **************************************************************** | |
# table setting(s) | |
# **************************************************************** | |
__PACKAGE__->table('players'); | |
# **************************************************************** | |
# business logic(s) | |
# **************************************************************** | |
sub bowl { | |
my $self = shift; | |
printf( | |
"%s (ave.: %0.3f) bowls a ball!\n", | |
$self->name, | |
$self->bowling_average, | |
); | |
return; | |
} | |
# **************************************************************** | |
# compile-time process(es) | |
# **************************************************************** | |
__PACKAGE__->_prepare_table; | |
__PACKAGE__->meta->make_immutable; | |
1; | |
__END__ | |
=pod | |
=encoding utf-8 | |
=head1 NAME | |
MyApp::SingleTableInheritance::Schema::Result::Bowler - blah blah blah | |
=head1 SYNOPSIS | |
# yada yada yada | |
=head1 DESCRIPTION | |
blah blah blah | |
=head1 AUTHOR | |
=over 4 | |
=item MORIYA Masaki, alias Gardejo | |
C<< <moriya at cpan dot org> >>, | |
L<http://gardejo.org/> | |
=back | |
=head1 COPYRIGHT AND LICENSE | |
Copyright (c) 2010 MORIYA Masaki, alias Gardejo. | |
This library is free software; | |
you can redistribute it and/or modify it under the same terms as Perl itself. | |
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>. | |
The full text of the license can be found in the F<LICENSE> file included with | |
this distribution. | |
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/perl | |
use 5.010_000; | |
use strict; | |
use warnings; | |
use utf8; | |
use FindBin; | |
use lib "$FindBin::Bin/../lib"; | |
use MyApp::ClassTableInheritance::Schema; | |
my $schema = MyApp::ClassTableInheritance::Schema->connect( | |
'dbi:SQLite:dbname=:memory:', | |
); | |
$schema->deploy; | |
my $txn_guard = $schema->txn_scope_guard; | |
say 'Footballer:'; | |
my $player_rs = $schema->resultset('Player'); | |
my $new_player_as_football = $player_rs->create({ | |
name => 'Foo Bar the Kicker', | |
}); | |
# Fix Me: WTF? | |
# my $new_footballer = $new_player_as_football->add_to_footballer({ | |
# id => $new_player | |
# club => 'Baz F.C.', | |
# }); | |
my $new_footballer = $new_player_as_football->create_related('footballer', { | |
club => 'Baz F.C.', | |
}); | |
$new_footballer->salute; | |
$new_footballer->kick; | |
say q(); | |
say 'Cricketer:'; | |
my $new_player_as_cricketer = $player_rs->create({ | |
name => 'Foo Bar the Batter', | |
}); | |
my $new_cricketer = $new_player_as_cricketer->create_related('cricketer', { | |
batting_average => 0.345, | |
}); | |
$new_cricketer->salute; | |
$new_cricketer->bat; | |
say q(); | |
say 'Bowler:'; | |
my $new_player_as_bowler = $player_rs->create({ | |
name => 'Foo Bar the Bowler', | |
}); | |
my $new_cricketer_as_bowler = $new_player_as_bowler->create_related('cricketer', { | |
batting_average => 0.234, | |
}); | |
my $new_bowler = $new_cricketer_as_bowler->create_related('bowler', { | |
bowling_average => 0.123, | |
}); | |
$new_bowler->salute; | |
$new_bowler->bat; | |
$new_bowler->bowl; | |
say q(); | |
$txn_guard->commit; | |
say 'Players:'; | |
my $all_players_rs = $player_rs->search({}); | |
while (my $player = $all_players_rs->next) { | |
printf( | |
"%s,%s\n", | |
$player->id, | |
$player->name, | |
); | |
} | |
say q(); | |
say 'Footballers:'; | |
my $footballer_rs = $schema->resultset('Footballer'); | |
my $all_footballers_rs = $footballer_rs->search({}); | |
while (my $footballer = $all_footballers_rs->next) { | |
printf( | |
"%s,%s\n", | |
$footballer->id, | |
$footballer->club, | |
); | |
} | |
say q(); | |
say 'Cricketers:'; | |
my $cricketer_rs = $schema->resultset('Cricketer'); | |
my $all_cricketers_rs = $cricketer_rs->search({}); | |
while (my $cricketer = $all_cricketers_rs->next) { | |
printf( | |
"%s,%0.3f\n", | |
$cricketer->id, | |
$cricketer->batting_average, | |
); | |
} | |
say q(); | |
say 'Bowlers:'; | |
my $bowler_rs = $schema->resultset('Bowler'); | |
my $all_bowlers_rs = $bowler_rs->search({}); | |
while (my $bowler = $all_bowlers_rs->next) { | |
printf( | |
"%s,%0.3f\n", | |
$bowler->id, | |
$bowler->bowling_average, | |
); | |
} | |
say q(); | |
exit; | |
__END__ | |
=pod | |
=encoding utf-8 | |
=head1 NAME | |
class_table_inheritance - An implementation of the Class Table Inheritance pattern | |
=head1 SYNOPSIS | |
% perl class_table_inheritance.pl | |
Footballer: | |
Hello, my name is Foo Bar the Kicker. | |
Foo Bar the Kicker (Baz F.C.) kicks a ball! | |
Cricketer: | |
Hello, my name is Foo Bar the Batter. | |
Foo Bar the Batter (ave.: 0.345) bats a ball! | |
Bowler: | |
Hello, my name is Foo Bar the Bowler. | |
Foo Bar the Bowler (ave.: 0.234) bats a ball! | |
Foo Bar the Bowler (ave.: 0.123) bowls a ball! | |
Players: | |
B11584C3-723F-1014-92FA-98A5DC3A33E2,Foo Bar the Kicker | |
B5556DE7-723F-1014-A7B4-9A1D6EDACD88,Foo Bar the Batter | |
B5D3051A-723F-1014-92C9-9A937BB8010E,Foo Bar the Bowler | |
Footballers: | |
B11584C3-723F-1014-92FA-98A5DC3A33E2,Baz F.C. | |
Cricketers: | |
B5556DE7-723F-1014-A7B4-9A1D6EDACD88,0.345 | |
B5D3051A-723F-1014-92C9-9A937BB8010E,0.234 | |
Bowlers: | |
B5D3051A-723F-1014-92C9-9A937BB8010E,0.123 | |
=head1 DESCRIPTION | |
blah blah blah | |
=head2 Schema | |
CREATE TABLE players ( | |
id char(36) NOT NULL, | |
name varchar(32) NOT NULL, | |
PRIMARY KEY (id) | |
); | |
CREATE TABLE footballers ( | |
id char(36) NOT NULL, | |
club varchar(32) NOT NULL, | |
PRIMARY KEY (id) | |
); | |
CREATE TABLE cricketers ( | |
id char(36) NOT NULL, | |
batting_average float NOT NULL, | |
PRIMARY KEY (id) | |
); | |
CREATE TABLE bowlers ( | |
id char(36) NOT NULL, | |
bowling_average float NOT NULL, | |
PRIMARY KEY (id) | |
); | |
CREATE UNIQUE INDEX players_name ON players (name); | |
=head1 TO DO | |
=over 4 | |
=item * | |
L<MyApp::ClassTableInheritance::Schema::Result::Player| | |
MyApp::ClassTableInheritance::Schema::Result::Player> does not have | |
C<add_to_footballer> method. | |
=item * | |
L<DBIx::Class::MooseColumns|DBIx::Class::MooseColumns> 0.10 cannot apply type | |
constraints at instanciation. | |
=back | |
=head1 SEE ALSO | |
=over 4 | |
=item * | |
L<http://www.martinfowler.com/eaaCatalog/classTableInheritance.html> | |
=item * | |
L<http://capsctrl.que.jp/kdmsnr/wiki/PofEAA/?ClassTableInheritance> | |
=back | |
=head1 AUTHOR | |
=over 4 | |
=item MORIYA Masaki, alias Gardejo | |
C<< <moriya at cpan dot org> >>, | |
L<http://gardejo.org/> | |
=back | |
=head1 COPYRIGHT AND LICENSE | |
Copyright (c) 2010 MORIYA Masaki, alias Gardejo. | |
This library is free software; | |
you can redistribute it and/or modify it under the same terms as Perl itself. | |
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>. | |
The full text of the license can be found in the F<LICENSE> file included with | |
this distribution. | |
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/perl | |
use 5.010_000; | |
use strict; | |
use warnings; | |
use utf8; | |
use FindBin; | |
use lib "$FindBin::Bin/../lib"; | |
use MyApp::ConcreteTableInheritance::Schema; | |
my $schema = MyApp::ConcreteTableInheritance::Schema->connect( | |
'dbi:SQLite:dbname=:memory:', | |
); | |
$schema->deploy; | |
my $txn_guard = $schema->txn_scope_guard; | |
say 'Footballer:'; | |
my $footballer_rs = $schema->resultset('Footballer'); | |
my $new_footballer = $footballer_rs->create({ | |
name => 'Foo Bar the Kicker', | |
club => 'Baz F.C.', | |
}); | |
$new_footballer->salute; | |
$new_footballer->kick; | |
say q(); | |
say 'Cricketer:'; | |
my $cricketer_rs = $schema->resultset('Cricketer'); | |
my $new_cricketer = $cricketer_rs->create({ | |
name => 'Foo Bar the Cricketer', | |
batting_average => 0.345, | |
}); | |
$new_cricketer->salute; | |
$new_cricketer->bat; | |
say q(); | |
say 'Bowler:'; | |
my $bowler_rs = $schema->resultset('Bowler'); | |
my $new_bowler = $bowler_rs->create({ | |
name => 'Foo Bar the Bowler', | |
batting_average => 0.234, | |
bowling_average => 0.123, | |
}); | |
$new_bowler->salute; | |
$new_bowler->bat; | |
$new_bowler->bowl; | |
say q(); | |
$txn_guard->commit; | |
say 'Footballers:'; | |
my $all_footballers_rs = $footballer_rs->search({}); | |
while (my $footballer = $all_footballers_rs->next) { | |
printf( | |
"%s,%s,%s\n", | |
$footballer->id, | |
$footballer->name, | |
$footballer->club, | |
); | |
} | |
say q(); | |
say 'Cricketers:'; | |
my $all_cricketers_rs = $cricketer_rs->search({}); | |
while (my $cricketer = $all_cricketers_rs->next) { | |
printf( | |
"%s,%s,%0.3f\n", | |
$cricketer->id, | |
$cricketer->name, | |
$cricketer->batting_average, | |
); | |
} | |
say q(); | |
say 'Bowlers:'; | |
my $all_bowlers_rs = $bowler_rs->search({}); | |
while (my $bowler = $all_bowlers_rs->next) { | |
printf( | |
"%s,%s,%0.3f,%0.3f\n", | |
$bowler->id, | |
$bowler->name, | |
$bowler->batting_average, | |
$bowler->bowling_average, | |
); | |
} | |
say q(); | |
exit; | |
__END__ | |
=pod | |
=encoding utf-8 | |
=head1 NAME | |
concrete_table_inheritance - An implementation of the Concrete Table Inheritance pattern | |
=head1 SYNOPSIS | |
% perl concrete_table_inheritance.pl | |
Footballer: | |
Hello, my name is Foo Bar the Kicker. | |
Foo Bar the Kicker (Baz F.C.) kicks a ball! | |
Cricketer: | |
Hello, my name is Foo Bar the Cricketer. | |
Foo Bar the Cricketer (ave.: 0.345) bats a ball! | |
Bowler: | |
Hello, my name is Foo Bar the Bowler. | |
Foo Bar the Bowler (ave.: 0.234) bats a ball! | |
Foo Bar the Bowler (ave.: 0.123) bowls a ball! | |
Footballers: | |
D1187178-97B2-1014-A58F-D4AC52A7D995,Foo Bar the Kicker,Baz F.C. | |
Cricketers: | |
D4E37767-97B2-1014-B8E9-EC12DD115C94,Foo Bar the Cricketer,0.345 | |
Bowlers: | |
D520973D-97B2-1014-B909-CBDD2129B220,Foo Bar the Bowler,0.234,0.123 | |
=head1 DESCRIPTION | |
blah blah blah | |
=head2 Schema | |
CREATE TABLE footballers ( | |
id CHAR(36) NOT NULL, | |
name VARCHAR(32) NOT NULL, | |
club VARCHAR(32) NOT NULL, | |
PRIMARY KEY (id) | |
); | |
CREATE TABLE cricketers ( | |
id char(36) NOT NULL, | |
name varchar(32) NOT NULL, | |
batting_average float NOT NULL, | |
PRIMARY KEY (id) | |
); | |
CREATE TABLE bowlers ( | |
id CHAR(36) NOT NULL, | |
name VARCHAR(32) NOT NULL, | |
batting_average float NOT NULL, | |
bowling_average float NOT NULL, | |
PRIMARY KEY (id) | |
); | |
CREATE UNIQUE INDEX __PLACEHOLDER___name ON bowlers (name); -- sucks | |
CREATE UNIQUE INDEX __PLACEHOLDER___name02 ON cricketers (name); -- sucks | |
CREATE UNIQUE INDEX __PLACEHOLDER___name03 ON footballers (name); -- sucks | |
CREATE UNIQUE INDEX bowlers_name ON bowlers (name); | |
CREATE UNIQUE INDEX cricketers_name ON bowlers (name); | |
CREATE UNIQUE INDEX cricketers_name02 ON cricketers (name); -- sucks | |
CREATE UNIQUE INDEX footballers_name ON footballers (name); | |
=head1 TO DO | |
=over 4 | |
=item * | |
L<DBIx::Class::MooseColumns|DBIx::Class::MooseColumns> 0.10 cannot apply type | |
constraints at instanciation. | |
=back | |
=head1 SEE ALSO | |
=over 4 | |
=item * | |
L<http://www.martinfowler.com/eaaCatalog/concreteTableInheritance.html> | |
=item * | |
L<http://capsctrl.que.jp/kdmsnr/wiki/PofEAA/?ConcreteTableInheritance> | |
=back | |
=head1 AUTHOR | |
=over 4 | |
=item MORIYA Masaki, alias Gardejo | |
C<< <moriya at cpan dot org> >>, | |
L<http://gardejo.org/> | |
=back | |
=head1 COPYRIGHT AND LICENSE | |
Copyright (c) 2010 MORIYA Masaki, alias Gardejo. | |
This library is free software; | |
you can redistribute it and/or modify it under the same terms as Perl itself. | |
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>. | |
The full text of the license can be found in the F<LICENSE> file included with | |
this distribution. | |
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package MyApp::ClassTableInheritance::Schema::Base::Result::Cricketer; | |
use namespace::autoclean; | |
use Moose; | |
extends qw( | |
MyApp::ClassTableInheritance::Schema::Base::Result::Player | |
); | |
# **************************************************************** | |
# painful accessor(s) | |
# **************************************************************** | |
sub name { # It is less than smart... | |
my $self = shift; | |
return $self->player->name(@_); | |
} | |
# **************************************************************** | |
# business logic(s) | |
# **************************************************************** | |
sub bat { | |
my $self = shift; | |
printf( | |
"%s (ave.: %0.3f) bats a ball!\n", | |
$self->name, | |
$self->batting_average, | |
); | |
return; | |
} | |
# **************************************************************** | |
# compile-time process(es) | |
# **************************************************************** | |
__PACKAGE__->meta->make_immutable; | |
1; | |
__END__ | |
=pod | |
=encoding utf-8 | |
=head1 NAME | |
MyApp::ClassTableInheritance::Schema::Base::Result::Cricketer - blah blah blah | |
=head1 SYNOPSIS | |
# yada yada yada | |
=head1 DESCRIPTION | |
blah blah blah | |
=head1 AUTHOR | |
=over 4 | |
=item MORIYA Masaki, alias Gardejo | |
C<< <moriya at cpan dot org> >>, | |
L<http://gardejo.org/> | |
=back | |
=head1 COPYRIGHT AND LICENSE | |
Copyright (c) 2010 MORIYA Masaki, alias Gardejo. | |
This library is free software; | |
you can redistribute it and/or modify it under the same terms as Perl itself. | |
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>. | |
The full text of the license can be found in the F<LICENSE> file included with | |
this distribution. | |
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package MyApp::ClassTableInheritance::Schema::Result::Cricketer; | |
use namespace::autoclean; | |
use Moose; | |
use MooseX::Types::Moose qw(Num); | |
extends qw( | |
MyApp::ClassTableInheritance::Schema::Base::Result::Cricketer | |
); | |
# **************************************************************** | |
# table setting(s) | |
# **************************************************************** | |
__PACKAGE__->table('cricketers'); | |
__PACKAGE__->add_columns( | |
batting_average => { | |
data_type => 'float', | |
}, | |
); | |
# Or, use DBIx::Class::MooseColumns | |
with ( | |
'MyApp::Role::Schema::Result::Validatable' => { | |
columns => { | |
batting_average => { isa => Num }, | |
}, | |
}, | |
); | |
after _prepare_table => sub { | |
my ($class) = @_; | |
$class->belongs_to( | |
'player' => | |
'MyApp::ClassTableInheritance::Schema::Result::Player', | |
'id' | |
); | |
$class->might_have( | |
'bowler' => | |
'MyApp::ClassTableInheritance::Schema::Result::Bowler', | |
'id' | |
); | |
return; | |
}; | |
# **************************************************************** | |
# compile-time process(es) | |
# **************************************************************** | |
__PACKAGE__->_prepare_table; | |
__PACKAGE__->meta->make_immutable; | |
1; | |
__END__ | |
=pod | |
=encoding utf-8 | |
=head1 NAME | |
MyApp::ClassTableInheritance::Schema::Result::Cricketer - blah blah blah | |
=head1 SYNOPSIS | |
# yada yada yada | |
=head1 DESCRIPTION | |
blah blah blah | |
=head1 AUTHOR | |
=over 4 | |
=item MORIYA Masaki, alias Gardejo | |
C<< <moriya at cpan dot org> >>, | |
L<http://gardejo.org/> | |
=back | |
=head1 COPYRIGHT AND LICENSE | |
Copyright (c) 2010 MORIYA Masaki, alias Gardejo. | |
This library is free software; | |
you can redistribute it and/or modify it under the same terms as Perl itself. | |
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>. | |
The full text of the license can be found in the F<LICENSE> file included with | |
this distribution. | |
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package MyApp::ConcreteTableInheritance::Schema::Result::Cricketer; | |
use namespace::autoclean; | |
use Moose; | |
use MooseX::Types::Moose qw(Num); | |
extends qw( | |
MyApp::ConcreteTableInheritance::Schema::Base::Result::Player | |
); | |
# **************************************************************** | |
# table setting(s) | |
# **************************************************************** | |
__PACKAGE__->table('cricketers'); | |
__PACKAGE__->add_columns( | |
batting_average => { | |
data_type => 'float', | |
}, | |
); | |
# Or, use DBIx::Class::MooseColumns | |
with ( | |
'MyApp::Role::Schema::Result::Validatable' => { | |
columns => { | |
batting_average => { isa => Num }, | |
}, | |
}, | |
); | |
after _prepare_table => sub { | |
my ($class) = @_; | |
# some preparations | |
return; | |
}; | |
# **************************************************************** | |
# business logic(s) | |
# **************************************************************** | |
sub bat { | |
my $self = shift; | |
printf( | |
"%s (ave.: %0.3f) bats a ball!\n", | |
$self->name, | |
$self->batting_average, | |
); | |
return; | |
} | |
# **************************************************************** | |
# compile-time process(es) | |
# **************************************************************** | |
__PACKAGE__->_prepare_table; | |
__PACKAGE__->meta->make_immutable; | |
1; | |
__END__ | |
=pod | |
=encoding utf-8 | |
=head1 NAME | |
MyApp::ConcreteTableInheritance::Schema::Result::Cricketer - blah blah blah | |
=head1 SYNOPSIS | |
# yada yada yada | |
=head1 DESCRIPTION | |
blah blah blah | |
=head1 AUTHOR | |
=over 4 | |
=item MORIYA Masaki, alias Gardejo | |
C<< <moriya at cpan dot org> >>, | |
L<http://gardejo.org/> | |
=back | |
=head1 COPYRIGHT AND LICENSE | |
Copyright (c) 2010 MORIYA Masaki, alias Gardejo. | |
This library is free software; | |
you can redistribute it and/or modify it under the same terms as Perl itself. | |
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>. | |
The full text of the license can be found in the F<LICENSE> file included with | |
this distribution. | |
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package MyApp::SingleTableInheritance::Schema::Result::Cricketer; | |
use namespace::autoclean; | |
use Moose; | |
extends qw( | |
MyApp::SingleTableInheritance::Schema::Result::Player | |
); | |
# **************************************************************** | |
# table setting(s) | |
# **************************************************************** | |
__PACKAGE__->table('players'); | |
# **************************************************************** | |
# business logic(s) | |
# **************************************************************** | |
sub bat { | |
my $self = shift; | |
printf( | |
"%s (ave.: %0.3f) bats a ball!\n", | |
$self->name, | |
$self->batting_average, | |
); | |
return; | |
} | |
# **************************************************************** | |
# compile-time process(es) | |
# **************************************************************** | |
__PACKAGE__->_prepare_table; | |
__PACKAGE__->meta->make_immutable; | |
1; | |
__END__ | |
=pod | |
=encoding utf-8 | |
=head1 NAME | |
MyApp::SingleTableInheritance::Schema::Result::Cricketer - blah blah blah | |
=head1 SYNOPSIS | |
# yada yada yada | |
=head1 DESCRIPTION | |
blah blah blah | |
=head1 AUTHOR | |
=over 4 | |
=item MORIYA Masaki, alias Gardejo | |
C<< <moriya at cpan dot org> >>, | |
L<http://gardejo.org/> | |
=back | |
=head1 COPYRIGHT AND LICENSE | |
Copyright (c) 2010 MORIYA Masaki, alias Gardejo. | |
This library is free software; | |
you can redistribute it and/or modify it under the same terms as Perl itself. | |
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>. | |
The full text of the license can be found in the F<LICENSE> file included with | |
this distribution. | |
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package MyApp::ClassTableInheritance::Schema::Base::Result::Footballer; | |
use namespace::autoclean; | |
use Moose; | |
extends qw( | |
MyApp::ClassTableInheritance::Schema::Base::Result::Player | |
); | |
# **************************************************************** | |
# painful accessor(s) | |
# **************************************************************** | |
sub name { # It is less than smart... | |
my $self = shift; | |
return $self->player->name(@_); | |
} | |
# **************************************************************** | |
# business logic(s) | |
# **************************************************************** | |
sub kick { | |
my $self = shift; | |
printf( | |
"%s (%s) kicks a ball!\n", | |
$self->name, | |
$self->club, | |
); | |
return; | |
} | |
# **************************************************************** | |
# business logic(s) | |
# **************************************************************** | |
__PACKAGE__->_prepare_table; | |
__PACKAGE__->meta->make_immutable; | |
1; | |
__END__ | |
=pod | |
=encoding utf-8 | |
=head1 NAME | |
MyApp::ClassTableInheritance::Schema::Base::Result::Footballer - blah blah blah | |
=head1 SYNOPSIS | |
# yada yada yada | |
=head1 DESCRIPTION | |
blah blah blah | |
=head1 AUTHOR | |
=over 4 | |
=item MORIYA Masaki, alias Gardejo | |
C<< <moriya at cpan dot org> >>, | |
L<http://gardejo.org/> | |
=back | |
=head1 COPYRIGHT AND LICENSE | |
Copyright (c) 2010 MORIYA Masaki, alias Gardejo. | |
This library is free software; | |
you can redistribute it and/or modify it under the same terms as Perl itself. | |
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>. | |
The full text of the license can be found in the F<LICENSE> file included with | |
this distribution. | |
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package MyApp::ClassTableInheritance::Schema::Result::Footballer; | |
use namespace::autoclean; | |
use Moose; | |
use MooseX::Types::Moose qw(Str); | |
extends qw( | |
MyApp::ClassTableInheritance::Schema::Base::Result::Footballer | |
); | |
# **************************************************************** | |
# table setting(s) | |
# **************************************************************** | |
__PACKAGE__->table('footballers'); | |
__PACKAGE__->add_columns( | |
club => { | |
data_type => 'varchar', | |
size => 32, | |
}, | |
); | |
# Or, use DBIx::Class::MooseColumns | |
with ( | |
'MyApp::Role::Schema::Result::Validatable' => { | |
columns => { | |
club => { isa => Str }, | |
}, | |
}, | |
); | |
after _prepare_table => sub { | |
my ($class) = @_; | |
$class->belongs_to( | |
'player' => | |
'MyApp::ClassTableInheritance::Schema::Result::Player', | |
'id' | |
); | |
return; | |
}; | |
# **************************************************************** | |
# compile-time process(es) | |
# **************************************************************** | |
__PACKAGE__->_prepare_table; | |
__PACKAGE__->meta->make_immutable; | |
1; | |
__END__ | |
=pod | |
=encoding utf-8 | |
=head1 NAME | |
MyApp::ClassTableInheritance::Schema::Result::Footballer - blah blah blah | |
=head1 SYNOPSIS | |
# yada yada yada | |
=head1 DESCRIPTION | |
blah blah blah | |
=head1 AUTHOR | |
=over 4 | |
=item MORIYA Masaki, alias Gardejo | |
C<< <moriya at cpan dot org> >>, | |
L<http://gardejo.org/> | |
=back | |
=head1 COPYRIGHT AND LICENSE | |
Copyright (c) 2010 MORIYA Masaki, alias Gardejo. | |
This library is free software; | |
you can redistribute it and/or modify it under the same terms as Perl itself. | |
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>. | |
The full text of the license can be found in the F<LICENSE> file included with | |
this distribution. | |
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package MyApp::ConcreteTableInheritance::Schema::Result::Footballer; | |
use namespace::autoclean; | |
use Moose; | |
use MooseX::Types::Moose qw(Str); | |
extends qw( | |
MyApp::ConcreteTableInheritance::Schema::Base::Result::Player | |
); | |
# **************************************************************** | |
# table setting(s) | |
# **************************************************************** | |
__PACKAGE__->table('footballers'); | |
__PACKAGE__->add_columns( | |
club => { | |
data_type => 'varchar', | |
size => 32, | |
}, | |
); | |
# Or, use DBIx::Class::MooseColumns | |
with ( | |
'MyApp::Role::Schema::Result::Validatable' => { | |
columns => { | |
club => { isa => Str }, | |
}, | |
}, | |
); | |
after _prepare_table => sub { | |
my ($class) = @_; | |
# some preparations | |
return; | |
}; | |
# **************************************************************** | |
# business logic(s) | |
# **************************************************************** | |
sub kick { | |
my $self = shift; | |
printf( | |
"%s (%s) kicks a ball!\n", | |
$self->name, | |
$self->club, | |
); | |
return; | |
} | |
# **************************************************************** | |
# compile-time process(es) | |
# **************************************************************** | |
__PACKAGE__->_prepare_table; | |
__PACKAGE__->meta->make_immutable; | |
1; | |
__END__ | |
=pod | |
=encoding utf-8 | |
=head1 NAME | |
MyApp::ConcreteTableInheritance::Schema::Result::Footballer - blah blah blah | |
=head1 SYNOPSIS | |
# yada yada yada | |
=head1 DESCRIPTION | |
blah blah blah | |
=head1 AUTHOR | |
=over 4 | |
=item MORIYA Masaki, alias Gardejo | |
C<< <moriya at cpan dot org> >>, | |
L<http://gardejo.org/> | |
=back | |
=head1 COPYRIGHT AND LICENSE | |
Copyright (c) 2010 MORIYA Masaki, alias Gardejo. | |
This library is free software; | |
you can redistribute it and/or modify it under the same terms as Perl itself. | |
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>. | |
The full text of the license can be found in the F<LICENSE> file included with | |
this distribution. | |
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package MyApp::SingleTableInheritance::Schema::Result::Footballer; | |
use namespace::autoclean; | |
use Moose; | |
extends qw( | |
MyApp::SingleTableInheritance::Schema::Result::Player | |
); | |
# **************************************************************** | |
# table setting(s) | |
# **************************************************************** | |
__PACKAGE__->table('players'); | |
# **************************************************************** | |
# business logic(s) | |
# **************************************************************** | |
sub kick { | |
my $self = shift; | |
printf( | |
"%s (%s) kicks a ball!\n", | |
$self->name, | |
$self->club, | |
); | |
return; | |
} | |
# **************************************************************** | |
# compile-time process(es) | |
# **************************************************************** | |
__PACKAGE__->_prepare_table; | |
__PACKAGE__->meta->make_immutable; | |
1; | |
__END__ | |
=pod | |
=encoding utf-8 | |
=head1 NAME | |
MyApp::SingleTableInheritance::Schema::Result::Footballer - blah blah blah | |
=head1 SYNOPSIS | |
# yada yada yada | |
=head1 DESCRIPTION | |
blah blah blah | |
=head1 AUTHOR | |
=over 4 | |
=item MORIYA Masaki, alias Gardejo | |
C<< <moriya at cpan dot org> >>, | |
L<http://gardejo.org/> | |
=back | |
=head1 COPYRIGHT AND LICENSE | |
Copyright (c) 2010 MORIYA Masaki, alias Gardejo. | |
This library is free software; | |
you can redistribute it and/or modify it under the same terms as Perl itself. | |
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>. | |
The full text of the license can be found in the F<LICENSE> file included with | |
this distribution. | |
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package MyApp::ClassTableInheritance::Schema::Base::Result::Player; | |
use namespace::autoclean; | |
use Moose; | |
use MooseX::NonMoose; | |
use MooseX::Types::UUID qw(UUID); | |
extends qw( | |
DBIx::Class::Core | |
); | |
__PACKAGE__->load_components(qw( | |
UUIDColumns | |
)); | |
# **************************************************************** | |
# table setting(s) | |
# **************************************************************** | |
# It is overwritten with concrete classes. | |
__PACKAGE__->table('__PLACEHOLDER__'); | |
__PACKAGE__->add_columns( | |
id => { | |
data_type => 'char', | |
size => 36, | |
is_foreign_key => 1, | |
}, | |
); | |
# Or, use DBIx::Class::MooseColumns | |
with ( | |
'MyApp::Role::Schema::Result::Validatable' => { | |
columns => { | |
id => { isa => UUID }, | |
}, | |
}, | |
); | |
sub _prepare_table { | |
my ($class) = @_; | |
$class->set_primary_key(qw(id)); | |
$class->uuid_columns(qw(id)); | |
return; | |
} | |
# **************************************************************** | |
# business logic(s) | |
# **************************************************************** | |
sub salute { | |
my ($self) = @_; | |
printf( | |
"Hello, my name is %s.\n", | |
$self->name, | |
); | |
} | |
# **************************************************************** | |
# compile-time process(es) | |
# **************************************************************** | |
__PACKAGE__->_prepare_table; | |
__PACKAGE__->meta->make_immutable; | |
1; | |
__END__ | |
=pod | |
=encoding utf-8 | |
=head1 NAME | |
MyApp::ClassTableInheritance::Schema::Base::Result::Player - blah blah blah | |
=head1 SYNOPSIS | |
# yada yada yada | |
=head1 DESCRIPTION | |
blah blah blah | |
=head1 AUTHOR | |
=over 4 | |
=item MORIYA Masaki, alias Gardejo | |
C<< <moriya at cpan dot org> >>, | |
L<http://gardejo.org/> | |
=back | |
=head1 COPYRIGHT AND LICENSE | |
Copyright (c) 2010 MORIYA Masaki, alias Gardejo. | |
This library is free software; | |
you can redistribute it and/or modify it under the same terms as Perl itself. | |
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>. | |
The full text of the license can be found in the F<LICENSE> file included with | |
this distribution. | |
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package MyApp::ClassTableInheritance::Schema::Result::Player; | |
use namespace::autoclean; | |
use Moose; | |
use MooseX::Types::Moose qw(Str); | |
extends qw( | |
MyApp::ClassTableInheritance::Schema::Base::Result::Player | |
); | |
# **************************************************************** | |
# table setting(s) | |
# **************************************************************** | |
__PACKAGE__->table('players'); | |
__PACKAGE__->add_columns( | |
name => { | |
data_type => 'varchar', | |
size => 32, | |
}, | |
); | |
# Or, use DBIx::Class::MooseColumns | |
with ( | |
'MyApp::Role::Schema::Result::Validatable' => { | |
columns => { | |
name => { isa => Str }, | |
}, | |
}, | |
); | |
after _prepare_table => sub { | |
my ($class) = @_; | |
$class->add_unique_constraint( [qw(name)] ); | |
$class->might_have( | |
'footballer' => | |
'MyApp::ClassTableInheritance::Schema::Result::Footballer', | |
'id' | |
); | |
$class->might_have( | |
'cricketer' => | |
'MyApp::ClassTableInheritance::Schema::Result::Cricketer', | |
'id' | |
); | |
return; | |
}; | |
# **************************************************************** | |
# compile-time process(es) | |
# **************************************************************** | |
__PACKAGE__->_prepare_table; | |
__PACKAGE__->meta->make_immutable; | |
1; | |
__END__ | |
=pod | |
=encoding utf-8 | |
=head1 NAME | |
MyApp::ClassTableInheritance::Schema::Result::Player - blah blah blah | |
=head1 SYNOPSIS | |
# yada yada yada | |
=head1 DESCRIPTION | |
blah blah blah | |
=head1 AUTHOR | |
=over 4 | |
=item MORIYA Masaki, alias Gardejo | |
C<< <moriya at cpan dot org> >>, | |
L<http://gardejo.org/> | |
=back | |
=head1 COPYRIGHT AND LICENSE | |
Copyright (c) 2010 MORIYA Masaki, alias Gardejo. | |
This library is free software; | |
you can redistribute it and/or modify it under the same terms as Perl itself. | |
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>. | |
The full text of the license can be found in the F<LICENSE> file included with | |
this distribution. | |
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package MyApp::ConcreteTableInheritance::Schema::Base::Result::Player; | |
use namespace::autoclean; | |
use Moose; | |
use MooseX::NonMoose; | |
use MooseX::Types::Moose qw(Str); | |
use MooseX::Types::UUID qw(UUID); | |
extends qw( | |
DBIx::Class::Core | |
); | |
__PACKAGE__->load_components(qw( | |
UUIDColumns | |
)); | |
# **************************************************************** | |
# table setting(s) | |
# **************************************************************** | |
# It is overwritten with concrete classes. | |
__PACKAGE__->table('__PLACEHOLDER__'); | |
__PACKAGE__->add_columns( | |
id => { | |
data_type => 'char', | |
size => 36, | |
}, | |
name => { | |
data_type => 'varchar', | |
size => 32, | |
}, | |
); | |
# Or, use DBIx::Class::MooseColumns | |
with ( | |
'MyApp::Role::Schema::Result::Validatable' => { | |
columns => { | |
id => { isa => UUID }, | |
name => { isa => Str }, | |
}, | |
}, | |
); | |
sub _prepare_table { | |
my ($class) = @_; | |
$class->set_primary_key( qw(id) ); | |
$class->uuid_columns( qw(id) ); | |
$class->add_unique_constraint( [qw(name)] ); | |
return; | |
} | |
# **************************************************************** | |
# business logic(s) | |
# **************************************************************** | |
sub salute { | |
my ($self) = @_; | |
printf( | |
"Hello, my name is %s.\n", | |
$self->name, | |
); | |
} | |
# **************************************************************** | |
# compile-time process(es) | |
# **************************************************************** | |
__PACKAGE__->_prepare_table; | |
__PACKAGE__->meta->make_immutable; | |
1; | |
__END__ | |
=pod | |
=encoding utf-8 | |
=head1 NAME | |
MyApp::ConcreteTableInheritance::Schema::Base::Result::Player - blah blah blah | |
=head1 SYNOPSIS | |
# yada yada yada | |
=head1 DESCRIPTION | |
blah blah blah | |
=head1 AUTHOR | |
=over 4 | |
=item MORIYA Masaki, alias Gardejo | |
C<< <moriya at cpan dot org> >>, | |
L<http://gardejo.org/> | |
=back | |
=head1 COPYRIGHT AND LICENSE | |
Copyright (c) 2010 MORIYA Masaki, alias Gardejo. | |
This library is free software; | |
you can redistribute it and/or modify it under the same terms as Perl itself. | |
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>. | |
The full text of the license can be found in the F<LICENSE> file included with | |
this distribution. | |
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package MyApp::SingleTableInheritance::Schema::Result::Player; | |
use namespace::autoclean; | |
use Moose; | |
use MooseX::NonMoose; | |
use MooseX::Types::Moose qw(Str Num Undef); | |
use MooseX::Types::UUID qw(UUID); | |
extends qw( | |
DBIx::Class::Core | |
); | |
__PACKAGE__->load_components(qw( | |
UUIDColumns | |
)); | |
# **************************************************************** | |
# table setting(s) | |
# **************************************************************** | |
__PACKAGE__->table('players'); | |
__PACKAGE__->add_columns( | |
id => { | |
data_type => 'char', | |
size => 36, | |
}, | |
name => { | |
data_type => 'varchar', | |
size => 32, | |
}, | |
club => { | |
data_type => 'varchar', | |
size => 32, | |
is_nullable => 1, | |
}, | |
batting_average => { | |
data_type => 'float', | |
is_nullable => 1, | |
}, | |
bowling_average => { | |
data_type => 'float', | |
is_nullable => 1, | |
}, | |
type => { | |
data_type => 'text', | |
}, | |
); | |
# Or, use DBIx::Class::MooseColumns | |
with ( | |
'MyApp::Role::Schema::Result::Validatable' => { | |
columns => { | |
id => { isa => UUID }, | |
name => { isa => Str }, | |
club => { isa => Str|Undef }, | |
batting_average => { isa => Num|Undef }, | |
bowling_average => { isa => Num|Undef }, | |
type => { isa => Str }, | |
}, | |
}, | |
); | |
sub _prepare_table { | |
my ($class) = @_; | |
$class->set_primary_key( qw(id) ); | |
$class->uuid_columns( qw(id) ); | |
$class->add_unique_constraint( [qw(name)] ); | |
return; | |
} | |
sub insert { | |
my ($self, $arguments) = @_; | |
$self->type(blessed $self); | |
return $self->next::method($arguments); | |
} | |
sub update { | |
my ($self, $arguments) = @_; | |
delete $arguments->{type} | |
if defined $arguments | |
&& ref $arguments eq 'HASH' | |
&& exists $arguments->{type}; | |
return $self->next::method($arguments); | |
} | |
# **************************************************************** | |
# business logic(s) | |
# **************************************************************** | |
sub salute { | |
my ($self) = @_; | |
printf( | |
"Hello, my name is %s.\n", | |
$self->name, | |
); | |
} | |
# **************************************************************** | |
# compile-time process(es) | |
# **************************************************************** | |
__PACKAGE__->_prepare_table; | |
__PACKAGE__->meta->make_immutable; | |
1; | |
__END__ | |
=pod | |
=encoding utf-8 | |
=head1 NAME | |
MyApp::SingleTableInheritance::Schema::Result::Player - blah blah blah | |
=head1 SYNOPSIS | |
# yada yada yada | |
=head1 DESCRIPTION | |
blah blah blah | |
=head1 AUTHOR | |
=over 4 | |
=item MORIYA Masaki, alias Gardejo | |
C<< <moriya at cpan dot org> >>, | |
L<http://gardejo.org/> | |
=back | |
=head1 COPYRIGHT AND LICENSE | |
Copyright (c) 2010 MORIYA Masaki, alias Gardejo. | |
This library is free software; | |
you can redistribute it and/or modify it under the same terms as Perl itself. | |
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>. | |
The full text of the license can be found in the F<LICENSE> file included with | |
this distribution. | |
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package MyApp::ClassTableInheritance::Schema; | |
use namespace::autoclean; | |
use Moose; | |
use MooseX::NonMoose; | |
extends qw( | |
DBIx::Class::Schema | |
); | |
__PACKAGE__->load_namespaces; | |
__PACKAGE__->meta->make_immutable; | |
1; | |
__END__ | |
=pod | |
=encoding utf-8 | |
=head1 NAME | |
MyApp::ClassTableInheritance::Schema - blah blah blah | |
=head1 SYNOPSIS | |
# yada yada yada | |
=head1 DESCRIPTION | |
blah blah blah | |
=head1 AUTHOR | |
=over 4 | |
=item MORIYA Masaki, alias Gardejo | |
C<< <moriya at cpan dot org> >>, | |
L<http://gardejo.org/> | |
=back | |
=head1 COPYRIGHT AND LICENSE | |
Copyright (c) 2010 MORIYA Masaki, alias Gardejo. | |
This library is free software; | |
you can redistribute it and/or modify it under the same terms as Perl itself. | |
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>. | |
The full text of the license can be found in the F<LICENSE> file included with | |
this distribution. | |
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package MyApp::ConcreteTableInheritance::Schema; | |
use namespace::autoclean; | |
use Moose; | |
use MooseX::NonMoose; | |
extends qw( | |
DBIx::Class::Schema | |
); | |
__PACKAGE__->load_namespaces; | |
__PACKAGE__->meta->make_immutable; | |
1; | |
__END__ | |
=pod | |
=encoding utf-8 | |
=head1 NAME | |
MyApp::ConcreteTableInheritance::Schema - blah blah blah | |
=head1 SYNOPSIS | |
# yada yada yada | |
=head1 DESCRIPTION | |
blah blah blah | |
=head1 AUTHOR | |
=over 4 | |
=item MORIYA Masaki, alias Gardejo | |
C<< <moriya at cpan dot org> >>, | |
L<http://gardejo.org/> | |
=back | |
=head1 COPYRIGHT AND LICENSE | |
Copyright (c) 2010 MORIYA Masaki, alias Gardejo. | |
This library is free software; | |
you can redistribute it and/or modify it under the same terms as Perl itself. | |
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>. | |
The full text of the license can be found in the F<LICENSE> file included with | |
this distribution. | |
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package MyApp::SingleTableInheritance::Schema; | |
use namespace::autoclean; | |
use Moose; | |
use MooseX::NonMoose; | |
extends qw( | |
DBIx::Class::Schema | |
); | |
__PACKAGE__->load_namespaces; | |
__PACKAGE__->meta->make_immutable; | |
1; | |
__END__ | |
=pod | |
=encoding utf-8 | |
=head1 NAME | |
MyApp::SingleTableInheritance::Schema - blah blah blah | |
=head1 SYNOPSIS | |
# yada yada yada | |
=head1 DESCRIPTION | |
blah blah blah | |
=head1 AUTHOR | |
=over 4 | |
=item MORIYA Masaki, alias Gardejo | |
C<< <moriya at cpan dot org> >>, | |
L<http://gardejo.org/> | |
=back | |
=head1 COPYRIGHT AND LICENSE | |
Copyright (c) 2010 MORIYA Masaki, alias Gardejo. | |
This library is free software; | |
you can redistribute it and/or modify it under the same terms as Perl itself. | |
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>. | |
The full text of the license can be found in the F<LICENSE> file included with | |
this distribution. | |
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/perl | |
use 5.010_000; | |
use strict; | |
use warnings; | |
use utf8; | |
use FindBin; | |
use lib "$FindBin::Bin/../lib"; | |
use MyApp::SingleTableInheritance::Schema; | |
my $schema = MyApp::SingleTableInheritance::Schema->connect( | |
'dbi:SQLite:dbname=:memory:', | |
); | |
$schema->deploy; | |
my $txn_guard = $schema->txn_scope_guard; | |
say 'Footballer:'; | |
my $footballer_rs = $schema->resultset('Footballer'); | |
my $new_footballer = $footballer_rs->create({ | |
name => 'Foo Bar the Kicker', | |
club => 'Baz F.C.', | |
}); | |
$new_footballer->salute; | |
$new_footballer->kick; | |
say q(); | |
say 'Cricketer:'; | |
my $cricketer_rs = $schema->resultset('Cricketer'); | |
my $new_cricketer = $cricketer_rs->create({ | |
name => 'Foo Bar the Batter', | |
batting_average => 0.345, | |
}); | |
$new_cricketer->salute; | |
$new_cricketer->bat; | |
say q(); | |
say 'Bowler:'; | |
my $bowler_rs = $schema->resultset('Bowler'); | |
my $new_bowler = $bowler_rs->create({ | |
name => 'Foo Bar the Bowler', | |
batting_average => 0.234, | |
bowling_average => 0.123, | |
}); | |
$new_bowler->salute; | |
$new_bowler->bat; | |
$new_bowler->bowl; | |
say q(); | |
$txn_guard->commit; | |
say 'Players:'; | |
my $player_rs = $schema->resultset('Player'); | |
my $all_players_rs = $player_rs->search([ | |
{ type => 'MyApp::SingleTableInheritance::Schema::Result::Footballer' }, | |
{ type => 'MyApp::SingleTableInheritance::Schema::Result::Cricketer' }, | |
{ type => 'MyApp::SingleTableInheritance::Schema::Result::Bowler' }, | |
]); | |
while (my $player = $all_players_rs->next) { | |
printf( | |
"%s,%s,%s,%0.3f,%0.3f,%s\n", | |
$player->id, | |
$player->name, | |
( $player->club // q() ), | |
( $player->batting_average // 0 ), | |
( $player->bowling_average // 0 ), | |
$player->type, | |
); | |
} | |
say q(); | |
say 'Footballers:'; | |
my $all_footballers_rs = $footballer_rs->search({ | |
type => 'MyApp::SingleTableInheritance::Schema::Result::Footballer', | |
}); | |
while (my $footballer = $all_footballers_rs->next) { | |
printf( | |
"%s,%s,%s,%0.3f,%0.3f,%s\n", | |
$footballer->id, | |
$footballer->name, | |
$footballer->club, | |
( $footballer->batting_average // 0 ), # Always zero | |
( $footballer->bowling_average // 0 ), # Always zero | |
$footballer->type, | |
); | |
} | |
say q(); | |
say 'Cricketers:'; | |
my $all_cricketers_rs = $cricketer_rs->search([ | |
{ type => 'MyApp::SingleTableInheritance::Schema::Result::Cricketer' }, | |
{ type => 'MyApp::SingleTableInheritance::Schema::Result::Bowler' }, | |
]); | |
while (my $cricketer = $all_cricketers_rs->next) { | |
printf( | |
"%s,%s,%s,%0.3f,%0.3f,%s\n", | |
$cricketer->id, | |
$cricketer->name, | |
( $cricketer->club // q() ), # Always empty | |
$cricketer->batting_average, | |
( $cricketer->bowling_average // 0 ), | |
$cricketer->type, | |
); | |
} | |
say q(); | |
say 'Bowlers:'; | |
my $all_bowlers_rs = $bowler_rs->search({ | |
type => 'MyApp::SingleTableInheritance::Schema::Result::Bowler', | |
}); | |
while (my $bowler = $all_bowlers_rs->next) { | |
printf( | |
"%s,%s,%s,%0.3f,%0.3f,%s\n", | |
$bowler->id, | |
$bowler->name, | |
( $bowler->club // q() ), # Always empty | |
$bowler->batting_average, | |
$bowler->bowling_average, | |
$bowler->type, | |
); | |
} | |
say q(); | |
exit; | |
__END__ | |
=pod | |
=encoding utf-8 | |
=head1 NAME | |
single_table_inheritance - An implementation of the Single Table Inheritance pattern | |
=head1 SYNOPSIS | |
% perl single_table_inheritance.pl | |
Footballer: | |
Hello, my name is Foo Bar the Kicker. | |
Foo Bar the Kicker (Baz F.C.) kicks a ball! | |
Cricketer: | |
Hello, my name is Foo Bar the Batter. | |
Foo Bar the Batter (ave.: 0.345) bats a ball! | |
Bowler: | |
Hello, my name is Foo Bar the Bowler. | |
Foo Bar the Bowler (ave.: 0.234) bats a ball! | |
Foo Bar the Bowler (ave.: 0.123) bowls a ball! | |
Players: | |
0EA0CBEC-97DF-1014-9A17-AA71D4AEE843,Foo Bar the Kicker,Baz F.C.,0.000,0.000,MyApp::SingleTableInheritance::Schema::Result::Footballer | |
1289FDDC-97DF-1014-BA01-A5D691001037,Foo Bar the Batter,,0.345,0.000,MyApp::SingleTableInheritance::Schema::Result::Cricketer | |
12CD3D98-97DF-1014-BA42-DEF7DAD9ABDC,Foo Bar the Bowler,,0.234,0.123,MyApp::SingleTableInheritance::Schema::Result::Bowler | |
Footballers: | |
0EA0CBEC-97DF-1014-9A17-AA71D4AEE843,Foo Bar the Kicker,Baz F.C.,0.000,0.000,MyApp::SingleTableInheritance::Schema::Result::Footballer | |
Cricketers: | |
1289FDDC-97DF-1014-BA01-A5D691001037,Foo Bar the Batter,,0.345,0.000,MyApp::SingleTableInheritance::Schema::Result::Cricketer | |
12CD3D98-97DF-1014-BA42-DEF7DAD9ABDC,Foo Bar the Bowler,,0.234,0.123,MyApp::SingleTableInheritance::Schema::Result::Bowler | |
Bowlers: | |
12CD3D98-97DF-1014-BA42-DEF7DAD9ABDC,Foo Bar the Bowler,,0.234,0.123,MyApp::SingleTableInheritance::Schema::Result::Bowler | |
=head1 DESCRIPTION | |
blah blah blah | |
=head2 Schema | |
CREATE TABLE players ( | |
id char(36) NOT NULL, | |
name varchar(32) NOT NULL, | |
club varchar(32), | |
batting_average float, | |
bowling_average float, | |
type text NOT NULL, | |
PRIMARY KEY (id) | |
); | |
CREATE UNIQUE INDEX players_name ON players (name); | |
=head1 TO DO | |
=over 4 | |
=item * | |
L<DBIx::Class::MooseColumns|DBIx::Class::MooseColumns> 0.10 cannot apply type | |
constraints at instanciation. | |
=back | |
=head1 SEE ALSO | |
=over 4 | |
=item * | |
L<http://www.martinfowler.com/eaaCatalog/singleTableInheritance.html> | |
=item * | |
L<http://capsctrl.que.jp/kdmsnr/wiki/PofEAA/?SingleTableInheritance> | |
=back | |
=head1 AUTHOR | |
=over 4 | |
=item MORIYA Masaki, alias Gardejo | |
C<< <moriya at cpan dot org> >>, | |
L<http://gardejo.org/> | |
=back | |
=head1 COPYRIGHT AND LICENSE | |
Copyright (c) 2010 MORIYA Masaki, alias Gardejo. | |
This library is free software; | |
you can redistribute it and/or modify it under the same terms as Perl itself. | |
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>. | |
The full text of the license can be found in the F<LICENSE> file included with | |
this distribution. | |
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package MyApp::Role::Schema::Result::Validatable; | |
# **************************************************************** | |
# pragma(ta) | |
# **************************************************************** | |
use strict; | |
use warnings; | |
use utf8; | |
# **************************************************************** | |
# namespace cleaner | |
# **************************************************************** | |
use namespace::autoclean; | |
# **************************************************************** | |
# MOP dependency(-ies) | |
# **************************************************************** | |
use MooseX::Params::Validate qw(validated_list); | |
use MooseX::Role::Parameterized; | |
use MooseX::Types::Moose qw(HashRef); | |
# **************************************************************** | |
# parameter(s) | |
# **************************************************************** | |
parameter columns => ( | |
isa => HashRef, | |
required => 1, | |
); | |
# **************************************************************** | |
# validation behavior(s) | |
# **************************************************************** | |
role { | |
my $parameter = shift; | |
while ( my ($column_name, $constraint) = each %{ $parameter->columns } ) { | |
my $accessor = $column_name; | |
my $validator = "_validate_$column_name"; | |
around BUILDARGS => sub { | |
my $next = shift; | |
my $class = shift; | |
my $init_args = $class->$next(@_); | |
$class->$validator( $init_args->{$column_name} ) | |
if exists $init_args->{$column_name}; | |
return $init_args; | |
}; | |
before $accessor => sub { | |
my $self = shift; | |
$self->$validator($_[0]) | |
if scalar @_; | |
return; | |
}; | |
method $validator => sub { | |
# To do: Replace MooseX::Params::Validate with Smart::Args | |
my ($invocant, $value) = @_; | |
return validated_list( | |
[ $column_name => $value ], | |
$column_name => $constraint, | |
); | |
}; | |
} | |
}; | |
# **************************************************************** | |
# return ture | |
# **************************************************************** | |
1; | |
__END__ | |
# **************************************************************** | |
# POD | |
# **************************************************************** | |
=pod | |
=encoding utf-8 | |
=head1 NAME | |
Amikeco::Role::Schema::Result::Validatable - A validator role for column(s) of DBIx::Class | |
=head1 SYNOPSIS | |
package Amikeco::Schema::Result::Foobar; | |
use Moose; | |
use MooseX::StrictConstructor; | |
use MooseX::Types::DateTimeX qw(DateTime); | |
use MooseX::Types::UUID qw(UUID); | |
extends qw(Amikeco::Schema::Base::Result); | |
__PACKAGE__->load_components( qw( | |
TimeStamp | |
UUIDColumns | |
) ); | |
__PACKAGE__->table('foobars'); | |
__PACKAGE__->add_columns( | |
id => { data_type => 'char', size => 36, }, | |
created_on => { data_type => 'char', size => 36, | |
set_on_create => 1 }, | |
); | |
__PACKAGE__->set_primary_key( qw(id) ); | |
__PACKAGE__->uuid_columns( qw(id) ); | |
with ( | |
'Amikeco::Role::Schema::Result::Validatable' => { | |
columns => { | |
id => { isa => UUID }, | |
created_on => { isa => DateTime, coerce => 1 }, | |
}, | |
}, | |
); | |
# ... | |
=head1 DESCRIPTION | |
This is a validator role for column(s) of L<DBIx::Class|DBIx::Class>. | |
=head1 SEE ALSO | |
=over 4 | |
=item DBIx::Class::MooseColumn 0.10 cannot validate attributes until instantiation (My gist) | |
L<http://gist.github.org/xxxxxx> | |
=item DBIx::Class::MooseColumn (CPAN) | |
L<DBIx::Class::MooseColumn|DBIx::Class::MooseColumn> | |
=back | |
=head1 AUTHOR | |
=over 4 | |
=item MORIYA Masaki, alias Gardejo | |
C<< <moriya at cpan dot org> >>, | |
L<http://gardejo.org/> | |
=back | |
=head1 COPYRIGHT AND LICENSE | |
Copyright (c) 2009-2010 MORIYA Masaki, alias Gardejo. | |
This library is free software; | |
you can redistribute it and/or modify it under the same terms as Perl itself. | |
See L<perlgpl|perlgpl> and L<perlartistic|perlartistic>. | |
The full text of the license can be found in the F<LICENSE> file included with | |
this distribution. | |
=cut |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment