File Coverage

blib/lib/Gedcom/Date.pm
Criterion Covered Total %
statement 63 69 91.3
branch 11 20 55.0
condition 4 6 66.6
subroutine 17 18 94.4
pod 6 6 100.0
total 101 119 84.8


line stmt bran cond sub pod time code
1             package Gedcom::Date;
2              
3 6     6   96753 use strict;
  6         10  
  6         1745  
4 6     6   2604 use DateTime::Locale;
  6         236083  
  6         182  
5              
6 6     6   49 use vars qw($VERSION);
  6         732  
  6         322  
7              
8             our $VERSION = '0.10';
9              
10 6     6   2512 use Gedcom::Date::Simple;
  6         46  
  6         175  
11 6     6   2463 use Gedcom::Date::Period;
  6         11  
  6         171  
12 6     6   2127 use Gedcom::Date::Range;
  6         10  
  6         151  
13 6     6   2066 use Gedcom::Date::Approximated;
  6         11  
  6         170  
14 6     6   2039 use Gedcom::Date::Interpreted;
  6         11  
  6         172  
15 6     6   2199 use Gedcom::Date::Phrase;
  6         9  
  6         195  
16              
17 6         42 use overload ( fallback => 1,
18             '>' => '_later_than',
19             '<' => '_earlier_than',
20 6     6   26 );
  6         8  
21              
22             {
23             my $DefaultLocale;
24             sub DefaultLocale {
25 19     19 1 26 my $class = shift;
26              
27 19 100       46 if (my $locale = shift) {
28 6         41 $DefaultLocale = DateTime::Locale->load($locale);
29             }
30 19         3286 return $DefaultLocale;
31             }
32             }
33             __PACKAGE__->DefaultLocale('en_GB');
34              
35             sub parse {
36 50     50 1 14228 my $class = shift;
37              
38 50         60 my ($str) = @_;
39              
40             return
41 50   66     145 Gedcom::Date::Period->parse($str) ||
42             Gedcom::Date::Range->parse($str) ||
43             Gedcom::Date::Approximated->parse($str) ||
44             Gedcom::Date::Interpreted->parse($str) ||
45             Gedcom::Date::Simple->parse($str) ||
46             Gedcom::Date::Phrase->parse($str);
47             }
48              
49             sub from_datetime {
50 1     1 1 369 my ($class, $dt) = @_;
51              
52 1         7 return Gedcom::Date::Simple->from_datetime($dt);
53             }
54              
55             sub clone {
56 11     11 1 35 my ($self) = @_;
57              
58 11         12 my %clone;
59 11         26 for (keys %$self) {
60 21 100       29 if (ref($self->{$_})) {
61 12         25 $clone{$_} = $self->{$_}->clone;
62             } else {
63 9         11 $clone{$_} = $self->{$_};
64             }
65             }
66              
67 11         21 return bless \%clone, ref $self;
68             }
69              
70             sub _later_than {
71 0     0   0 my ($self, $other, $switched) = @_;
72 0 0       0 _earlier_than($other, $self) if $switched;
73              
74 0 0       0 return 1 if $self->earliest > $other->latest;
75 0 0       0 return 0 if $self->latest < $other->earliest;
76 0         0 return;
77             }
78              
79             sub _earlier_than {
80 1     1   5 my ($self, $other, $switched) = @_;
81 1 50       3 _later_than($other, $self) if $switched;
82              
83 1 50       4 return 0 if $self->earliest > $other->latest;
84 1 50       98 return 1 if $self->latest < $other->earliest;
85 0         0 return;
86             }
87              
88             sub as_text {
89 39     39 1 17805 my ($self, $locale) = @_;
90              
91 39   66     112 $locale ||= $self->DefaultLocale();
92 39 100       131 $locale = DateTime::Locale->load($locale) unless ref $locale;
93 39         1002 my $lang = $locale->language_id;
94              
95 39         302 my ($str, @dates) = $self->text_format($lang);
96              
97 39         190 $str =~ s/%(\d+)/
98 45         848 $dates[$1]->_date_as_text($locale);
99             /ge;
100              
101             # Remove those ugly leading zeroes
102 39         4441 $str =~ s/\b0+\B//g;
103              
104 39         194 return $str;
105             }
106              
107             sub add {
108 11     11 1 3371 my $self = shift;
109              
110 11         18 for (qw/date from to bef aft/) {
111 55 100       117 $self->{$_}->add(@_, secret => 1) if $self->{$_};
112             }
113 11         27 return $self;
114             }
115              
116             1;
117              
118             __END__