#!/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