diff --git a/lib/Succession/Schema.pm b/lib/Succession/Schema.pm new file mode 100644 index 0000000..09a45b3 --- /dev/null +++ b/lib/Succession/Schema.pm @@ -0,0 +1,38 @@ +use utf8; +package Succession::Schema; + +# Created by DBIx::Class::Schema::Loader +# DO NOT MODIFY THE FIRST PART OF THIS FILE + +use Moose; +use MooseX::MarkAsMethods autoclean => 1; +extends 'DBIx::Class::Schema'; + +__PACKAGE__->load_namespaces; + + +# Created by DBIx::Class::Schema::Loader v0.07045 @ 2016-12-04 17:40:32 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:cqEWNsPVtEZ+VfMbuLt1MQ + + +# You can replace this text with custom code or comments, and it will be preserved on regeneration + +sub get_schema { + my @errors; + foreach (qw[SUCC_DB_HOST SUCC_DB_NAME SUCC_DB_USER SUCC_DB_PASS]) { + push @errors, $_ unless defined $ENV{$_}; + } + + if (@errors) { + die 'Please set the following environment variables: ', + join(', ', @errors), "\n"; + } + + return __PACKAGE__->connect( + "dbi:mysql:host=$ENV{SUCC_DB_HOST};database=$ENV{SUCC_DB_NAME}", + $ENV{SUCC_DB_USER}, $ENV{SUCC_DB_PASS}, + ); +} + +__PACKAGE__->meta->make_immutable(inline_constructor => 0); +1; diff --git a/lib/Succession/Schema/Result/Person.pm b/lib/Succession/Schema/Result/Person.pm new file mode 100644 index 0000000..6ec780a --- /dev/null +++ b/lib/Succession/Schema/Result/Person.pm @@ -0,0 +1,211 @@ +use utf8; +package Succession::Schema::Result::Person; + +# Created by DBIx::Class::Schema::Loader +# DO NOT MODIFY THE FIRST PART OF THIS FILE + +=head1 NAME + +Succession::Schema::Result::Person + +=cut + +use strict; +use warnings; + +use Moose; +use MooseX::NonMoose; +use MooseX::MarkAsMethods autoclean => 1; +extends 'DBIx::Class::Core'; + +=head1 COMPONENTS LOADED + +=over 4 + +=item * L + +=back + +=cut + +__PACKAGE__->load_components("InflateColumn::DateTime"); + +=head1 TABLE: C + +=cut + +__PACKAGE__->table("person"); + +=head1 ACCESSORS + +=head2 id + + data_type: 'integer' + is_auto_increment: 1 + is_nullable: 0 + +=head2 name + + data_type: 'varchar' + is_nullable: 0 + size: 50 + +=head2 born + + data_type: 'date' + datetime_undef_if_invalid: 1 + is_nullable: 0 + +=head2 died + + data_type: 'date' + datetime_undef_if_invalid: 1 + is_nullable: 1 + +=head2 parent + + data_type: 'integer' + is_foreign_key: 1 + is_nullable: 1 + +=head2 family_order + + data_type: 'integer' + is_nullable: 1 + +=cut + +__PACKAGE__->add_columns( + "id", + { data_type => "integer", is_auto_increment => 1, is_nullable => 0 }, + "name", + { data_type => "varchar", is_nullable => 0, size => 50 }, + "born", + { data_type => "date", datetime_undef_if_invalid => 1, is_nullable => 0 }, + "died", + { data_type => "date", datetime_undef_if_invalid => 1, is_nullable => 1 }, + "parent", + { data_type => "integer", is_foreign_key => 1, is_nullable => 1 }, + "family_order", + { data_type => "integer", is_nullable => 1 }, +); + +=head1 PRIMARY KEY + +=over 4 + +=item * L + +=back + +=cut + +__PACKAGE__->set_primary_key("id"); + +=head1 RELATIONS + +=head2 parent + +Type: belongs_to + +Related object: L + +=cut + +__PACKAGE__->belongs_to( + "parent", + "Succession::Schema::Result::Person", + { id => "parent" }, + { + is_deferrable => 1, + join_type => "LEFT", + on_delete => "RESTRICT", + on_update => "RESTRICT", + }, +); + +=head2 people + +Type: has_many + +Related object: L + +=cut + +__PACKAGE__->has_many( + "people", + "Succession::Schema::Result::Person", + { "foreign.parent" => "self.id" }, + { cascade_copy => 0, cascade_delete => 0 }, +); + +=head2 sovereigns + +Type: has_many + +Related object: L + +=cut + +__PACKAGE__->has_many( + "sovereigns", + "Succession::Schema::Result::Sovereign", + { "foreign.person_id" => "self.id" }, + { cascade_copy => 0, cascade_delete => 0 }, +); + + +# Created by DBIx::Class::Schema::Loader v0.07045 @ 2016-12-04 17:40:32 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:6h03yIJpwjWvQGw1B+Es6Q + + +# You can replace this text with custom code or comments, and it will be preserved on regeneration + +sub succession_on_date { + my $self = shift; + my ($date) = @_; + + my @desc = map { + $_, $_->descendants_on_date($date) + } $self->descendants_on_date($date); + + push @desc, $self->younger_siblings_and_descendants_on_date($date); + + return @desc; +} + +sub younger_siblings_and_descendants_on_date { + my $self = shift; + my ($date) = @_; + + my $parent = $self->parent; + return unless $self->parent; + + my @younger_siblings = $parent->descendants_on_date($date) + -> search({ + family_order => { '>' => $self->family_order }, + }); + + my @people = map { + $_, $_->descendants_on_date($date) + } @younger_siblings; + + return @people; +} + +sub descendants_on_date { + my $self = shift; + my ($date) = @_; + + $date = $self->result_source->schema->storage-> + datetime_parser->format_datetime($date); + + return $self->people({ + born => { '<=' => $date }, + }, { + order_by => 'family_order', + }); +} + +__PACKAGE__->meta->make_immutable; +1; diff --git a/lib/Succession/Schema/Result/Sovereign.pm b/lib/Succession/Schema/Result/Sovereign.pm new file mode 100644 index 0000000..f4f1d33 --- /dev/null +++ b/lib/Succession/Schema/Result/Sovereign.pm @@ -0,0 +1,123 @@ +use utf8; +package Succession::Schema::Result::Sovereign; + +# Created by DBIx::Class::Schema::Loader +# DO NOT MODIFY THE FIRST PART OF THIS FILE + +=head1 NAME + +Succession::Schema::Result::Sovereign + +=cut + +use strict; +use warnings; + +use Moose; +use MooseX::NonMoose; +use MooseX::MarkAsMethods autoclean => 1; +extends 'DBIx::Class::Core'; + +=head1 COMPONENTS LOADED + +=over 4 + +=item * L + +=back + +=cut + +__PACKAGE__->load_components("InflateColumn::DateTime"); + +=head1 TABLE: C + +=cut + +__PACKAGE__->table("sovereign"); + +=head1 ACCESSORS + +=head2 id + + data_type: 'integer' + is_auto_increment: 1 + is_nullable: 0 + +=head2 start + + data_type: 'date' + datetime_undef_if_invalid: 1 + is_nullable: 0 + +=head2 end + + data_type: 'date' + datetime_undef_if_invalid: 1 + is_nullable: 1 + +=head2 person_id + + data_type: 'integer' + is_foreign_key: 1 + is_nullable: 0 + +=cut + +__PACKAGE__->add_columns( + "id", + { data_type => "integer", is_auto_increment => 1, is_nullable => 0 }, + "start", + { data_type => "date", datetime_undef_if_invalid => 1, is_nullable => 0 }, + "end", + { data_type => "date", datetime_undef_if_invalid => 1, is_nullable => 1 }, + "person_id", + { data_type => "integer", is_foreign_key => 1, is_nullable => 0 }, +); + +=head1 PRIMARY KEY + +=over 4 + +=item * L + +=back + +=cut + +__PACKAGE__->set_primary_key("id"); + +=head1 RELATIONS + +=head2 person + +Type: belongs_to + +Related object: L + +=cut + +__PACKAGE__->belongs_to( + "person", + "Succession::Schema::Result::Person", + { id => "person_id" }, + { is_deferrable => 1, on_delete => "RESTRICT", on_update => "RESTRICT" }, +); + + +# Created by DBIx::Class::Schema::Loader v0.07045 @ 2016-12-04 17:40:32 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:WN+m2I1O/MX5wUbD9leJdg + + +# You can replace this text with custom code or comments, and it will be preserved on regeneration + +sub name { + return $_[0]->person->name; +} + +sub succession_on_date { + return $_[0]->person->succession_on_date($_[1]); +} + +__PACKAGE__->meta->make_immutable; +1; diff --git a/lib/Succession/Schema/ResultSet/Sovereign.pm b/lib/Succession/Schema/ResultSet/Sovereign.pm new file mode 100644 index 0000000..fe04d07 --- /dev/null +++ b/lib/Succession/Schema/ResultSet/Sovereign.pm @@ -0,0 +1,25 @@ +package Succession::Schema::ResultSet::Sovereign; + +use Moose; +use MooseX::NonMoose; + +extends 'DBIx::Class::ResultSet'; + +sub BUILDARGS { $_[2] } + +sub sovereign_on_date { + my $self = shift; + my ($date) = @_; + + $date = $self->result_source->schema->storage-> + datetime_parser->format_datetime($date); + + return $self->search({ + start => { '<=' => $date }, + end => [ { '>=' => $date }, undef ], + }); +} + +__PACKAGE__->meta->make_immutable; + +1;