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   124159 use strict;
  6         12  
  6         179  
4 6     6   3803 use DateTime::Locale;
  6         315092  
  6         189  
5              
6 6     6   49 use vars qw($VERSION);
  6         16  
  6         301  
7              
8             our $VERSION = '0.09';
9              
10 6     6   3338 use Gedcom::Date::Simple;
  6         69  
  6         202  
11 6     6   3195 use Gedcom::Date::Period;
  6         17  
  6         242  
12 6     6   3292 use Gedcom::Date::Range;
  6         16  
  6         211  
13 6     6   3005 use Gedcom::Date::Approximated;
  6         15  
  6         183  
14 6     6   3168 use Gedcom::Date::Interpreted;
  6         14  
  6         192  
15 6     6   3025 use Gedcom::Date::Phrase;
  6         15  
  6         247  
16              
17 6         43 use overload ( fallback => 1,
18             '>' => '_later_than',
19             '<' => '_earlier_than',
20 6     6   31 );
  6         10  
21              
22             {
23             my $DefaultLocale;
24             sub DefaultLocale {
25 19     19 1 33 my $class = shift;
26              
27 19 100       56 if (my $locale = shift) {
28 6         38 $DefaultLocale = DateTime::Locale->load($locale);
29             }
30 19         4088 return $DefaultLocale;
31             }
32             }
33             __PACKAGE__->DefaultLocale('en_GB');
34              
35             sub parse {
36 50     50 1 12843 my $class = shift;
37              
38 50         92 my ($str) = @_;
39              
40             return
41 50   66     201 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 373 my ($class, $dt) = @_;
51              
52 1         22 return Gedcom::Date::Simple->from_datetime($dt);
53             }
54              
55             sub clone {
56 11     11 1 49 my ($self) = @_;
57              
58 11         17 my %clone;
59 11         34 for (keys %$self) {
60 21 100       52 if (ref($self->{$_})) {
61 12         43 $clone{$_} = $self->{$_}->clone;
62             } else {
63 9         23 $clone{$_} = $self->{$_};
64             }
65             }
66              
67 11         34 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   7 my ($self, $other, $switched) = @_;
81 1 50       5 _later_than($other, $self) if $switched;
82              
83 1 50       5 return 0 if $self->earliest > $other->latest;
84 1 50       93 return 1 if $self->latest < $other->earliest;
85 0         0 return;
86             }
87              
88             sub as_text {
89 39     39 1 11228 my ($self, $locale) = @_;
90              
91 39   66     119 $locale ||= $self->DefaultLocale();
92 39 100       143 $locale = DateTime::Locale->load($locale) unless ref $locale;
93 39         1390 my $lang = $locale->language_id;
94              
95 39         377 my ($str, @dates) = $self->text_format($lang);
96              
97 39         188 $str =~ s/%(\d+)/
98 45         1356 $dates[$1]->_date_as_text($locale);
99             /ge;
100              
101             # Remove those ugly leading zeroes
102 39         6667 $str =~ s/\b0+\B//g;
103              
104 39         282 return $str;
105             }
106              
107             sub add {
108 11     11 1 5186 my $self = shift;
109              
110 11         26 for (qw/date from to bef aft/) {
111 55 100       183 $self->{$_}->add(@_, secret => 1) if $self->{$_};
112             }
113 11         20 return $self;
114             }
115              
116             1;
117              
118             __END__