File Coverage

blib/lib/Gedcom/Date/Period.pm
Criterion Covered Total %
statement 29 35 82.8
branch 17 24 70.8
condition 1 2 50.0
subroutine 6 9 66.6
pod 5 6 83.3
total 58 76 76.3


line stmt bran cond sub pod time code
1             package Gedcom::Date::Period;
2              
3 6     6   23 use strict;
  6         6  
  6         172  
4              
5 6     6   22 use vars qw($VERSION @ISA);
  6         7  
  6         411  
6              
7             our $VERSION = '0.10';
8             @ISA = qw/Gedcom::Date/;
9              
10 6     6   23 use Gedcom::Date;
  6         6  
  6         2287  
11              
12             sub parse {
13 50     50 1 46 my $class = shift;
14 50         45 my ($str) = @_;
15              
16 50         44 my ($from, $to);
17 50 100       187 if ($str =~ /^FROM (.*?) TO (.*)$/) {
    100          
    100          
18 3 50       12 $from = Gedcom::Date::Simple->parse($1) or return;
19 3 50       9 $to = Gedcom::Date::Simple->parse($2) or return;
20             } elsif ($str =~ /^FROM (.*)$/) {
21 3 50       11 $from = Gedcom::Date::Simple->parse($1) or return;
22             } elsif ($str =~ /^TO (.*)$/) {
23 3 50       12 $to = Gedcom::Date::Simple->parse($1) or return;
24             } else {
25 41         189 return;
26             }
27              
28 9         26 my $self = bless {
29             from => $from,
30             to => $to
31             }, $class;
32              
33 9         129 return $self;
34             }
35              
36             sub gedcom {
37 6     6 1 525 my $self = shift;
38              
39 6 50       18 if (!defined $self->{gedcom}) {
40             $self->{gedcom} = join ' ',
41 6         9 map {defined $self->{$_} ?
42 12 100       38 (uc, $self->{$_}->gedcom()) :
43             ()
44             }
45             qw/from to/;
46             }
47 6         21 $self->{gedcom};
48             }
49              
50             sub earliest {
51 0     0 1 0 return DateTime::Infinite::Past->new;
52             }
53              
54             sub latest {
55 0     0 1 0 return DateTime::Infinite::Future->new;
56             }
57              
58             sub sort_date {
59 0     0 1 0 my ($self) = @_;
60              
61 0 0       0 if (defined $self->{from}) {
62 0         0 return $self->{from}->sort_date;
63             } else {
64 0         0 return $self->{to}->sort_date;
65             }
66             }
67              
68             my %text = (
69             en => ['from %0', 'to %1', 'from %0 to %1'],
70             nl => ['vanaf %0', 'tot %1', 'van %0 tot %1'],
71             );
72              
73             sub text_format {
74 9     9 0 11 my ($self, $lang) = @_;
75 9   50     15 $lang ||= 'en';
76              
77             my $type = defined($self->{to}) ?
78 9 100       27 (defined($self->{from}) ? 2 : 1 ) : 0;
    100          
79 9         30 return ($text{$lang}[$type], $self->{from}, $self->{to});
80             }
81              
82             1;
83              
84             __END__