File Coverage

blib/lib/SVG/Timeline/Genealogy/Person.pm
Criterion Covered Total %
statement 31 31 100.0
branch 2 4 50.0
condition 1 2 50.0
subroutine 9 9 100.0
pod 2 2 100.0
total 45 48 93.7


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             SVG::Timeline::Genealogical::Person - a single person in a genealogical timeline
4              
5             =head1 SYNOPSIS
6              
7             See L<SVG::Timeline::Genealogical>.
8              
9             =cut
10              
11             package SVG::Timeline::Genealogy::Person;
12              
13 2     2   15 use Moose;
  2         5  
  2         20  
14             extends 'SVG::Timeline::Event';
15              
16 2     2   14569 use Moose::Util::TypeConstraints;
  2         5  
  2         44  
17              
18 2     2   5919 use Genealogy::Ahnentafel ();
  2         378891  
  2         361  
19              
20             coerce __PACKAGE__,
21             from 'HashRef',
22             via { __PACKAGE__->new($_) };
23              
24             has ahnen => (
25             is => 'ro',
26             isa => 'Int',
27             );
28              
29             has +end => (
30             is => 'ro',
31             isa => 'Int',
32             required => 0,
33             );
34              
35             has generation => (
36             is => 'ro',
37             isa => 'Int',
38             lazy_build => 1,
39             );
40              
41             sub _build_generation {
42 1     1   3 my $self = shift;
43 1         34 return Genealogy::Ahnentafel->new({
44             ahnentafel => $self->ahnen,
45             })->generation;
46             }
47              
48             # Array of colours - one for each generation.
49             has colours => (
50             is => 'ro',
51             isa => 'ArrayRef',
52             lazy_build => 1,
53             );
54              
55             sub _build_colours {
56 2     2   22 no warnings 'qw'; # I know what I'm doing here!
  2         5  
  2         689  
57             return [
58 1     1   4 map { "rgb($_)" }
  7         68  
59             qw(
60             0
61             255,127,127
62             127,255,127
63             127,127,255
64             255,255,127
65             255,127,255
66             127,255,255
67             )
68             ];
69             }
70              
71             has +colour => (
72             is => 'ro',
73             isa => 'Str',
74             lazy_build => 1,
75             );
76              
77             sub _build_colour {
78 1     1   4 my $self = shift;
79 1   50     47 return $self->colours->[$self->generation] // 'rgb(127.127.127)';
80             }
81              
82             =head1 METHODS AND ATTRIBUTES
83              
84             =head2 BUILD
85              
86             Called by Moose after the construction of a new object. This just updates
87             the C<text> attribute to add the years of the person's birth and death.
88              
89             =cut
90              
91             sub BUILD {
92 1     1 1 3058 my $self = shift;
93              
94 1         3 my $text = $self->{text};
95              
96 1 50       37 if ($self->start) {
97 1         38 $text .= ' (' . $self->start . ' - ';
98 1 50       59 $text .= $self->end if $self->end;
99 1         4 $text .= ')';
100             }
101              
102 1         4 $self->{text} = $text;
103             }
104              
105             =head2 set_index
106              
107             Called by SVG::Timeline::Genealogical each time a new person is added to the
108             timeline, this method works out where this person should appear in the
109             timeline.
110              
111             =cut
112              
113             sub set_index {
114 1     1 1 3 my $self = shift;
115 1         4 my ($count_of_people) = @_;
116              
117 1         34 my $den = 2 ** $self->generation;
118 1         36 my $num = 2 * ($self->ahnen - $den / 2) + 1;
119              
120 1         5 my $index = $count_of_people * ($num/$den);
121              
122 1         9 $self->{index} = $index;
123             }
124              
125             =head1 AUTHOR
126              
127             Dave Cross <dave@perlhacks.com>
128              
129             =head1 COPYRIGHT AND LICENCE
130              
131             Copyright (c) 2017, Magnum Solutions Ltd. All Rights Reserved.
132              
133             This library is free software; you can redistribute it and/or modify it
134             under the same terms as Perl itself.
135              
136             =cut
137              
138             1;