File Coverage

blib/lib/XML/Loy/Date/RFC3339.pm
Criterion Covered Total %
statement 65 70 92.8
branch 39 52 75.0
condition 17 32 53.1
subroutine 9 9 100.0
pod 5 5 100.0
total 135 168 80.3


line stmt bran cond sub pod time code
1             package XML::Loy::Date::RFC3339;
2 13     13   908 use strict;
  13         31  
  13         385  
3 13     13   91 use warnings;
  13         25  
  13         595  
4              
5 13     13   81 use overload '""' => sub { shift->to_string }, fallback => 1;
  13     10   23  
  13         99  
  10         1343  
6              
7             our $VERSION = '0.03';
8              
9             require Time::Local;
10              
11             # rfc3339 timestamp
12             my $RFC3339_RE = qr/^(\d{4}) # year
13             (?:-(\d?\d) # year and month
14             (?:-(\d?\d) # complete date
15             (?:[^\d](\d?\d) # + hour and minutes
16             :(\d?\d)
17             (?::(\d?\d) # + hour, minutes and seconds
18             (?:\.\d*)? # + hour, minutes, seconds and a
19             )? # decimal fraction of a second
20             ([zZ]|[\-\+]\d?\d(?::?\d?\d)?) # Offset
21             )?
22             )?
23             )?$/x;
24              
25             # Timestamp offset
26             my $OFFSET_RE = qr/^([-\+])(\d?\d)(?::(\d?\d))?$/;
27              
28             # Constructor
29             sub new {
30 40 50   40 1 1240 my $self = bless {}, (ref $_[0] ? ref shift : shift);
31              
32             # Set granularity
33 40         120 $self->granularity(0);
34              
35             # Parse string
36 40         107 $self->parse(@_);
37 40         218 return $self;
38             };
39              
40              
41             # Parse date value
42             sub parse {
43 46     46 1 97 my ($self, $date) = @_;
44              
45             # No date defined
46 46 100       102 return $self unless defined $date;
47              
48             # Epoch date
49 45 100 100     619 if ($date =~ /^[\d_]+$/ && $date > 5000) {
    50          
50 14         55 $self->epoch($date);
51 14         31 $self->granularity(0);
52             }
53              
54             # String date
55             elsif (my ($year, $month, $mday,
56             $hour, $min, $sec,
57             $offset) = ($date =~ $RFC3339_RE)) {
58 31         59 my $epoch;
59              
60             # Check for granularity
61 31         97 my $gran = 0;
62              
63             # No seconds defined
64 31 100       113 unless (defined $sec) {
65 6         7 $gran = 1, $sec = 0;
66              
67             # No hours defined
68 6 100       13 unless (defined $hour) {
69 5         9 $gran++, $hour = $min = 0;
70              
71             # No monthday defined
72 5 100       9 unless (defined $mday) {
73 3         5 $gran++, $mday = 1;
74              
75             # No month defined
76 3 100       7 unless (defined $month) {
77 2         4 $gran++, $month = 1;
78             };
79             };
80             };
81 6   100     19 $offset ||= 'Z';
82             };
83              
84             # Begin counting with 0
85 31         78 $month--;
86              
87             # Set granularity
88 31         108 $self->granularity($gran);
89              
90 31         51 eval {
91 31         167 $epoch = Time::Local::timegm(
92             $sec, $min, $hour, $mday, $month, $year
93             );
94             };
95              
96 31 50       1180 return if $@;
97              
98             # Calculate offsets
99 31 100 66     144 if (uc $offset ne 'Z' && (
100             my ($os_dir, $os_hour, $os_min) = ($offset =~ $OFFSET_RE))
101             ) {
102              
103             # Negative offset
104 3 50       7 if ($os_dir eq '-') {
105 3 50       11 $epoch += ($os_hour * 60 * 60) if $os_hour;
106 3 100       7 $epoch += ($os_min * 60) if $os_min;
107             }
108              
109             # Positive offset
110             else {
111 0 0       0 $epoch -= ($os_hour * 60 * 60) if $os_hour;
112 0 0       0 $epoch -= ($os_min * 60) if $os_min;
113             };
114             };
115              
116             # Positive epoch
117 31 50       77 if ($epoch > 0) {
118 31 50       85 $self->epoch($epoch) and return $epoch;
119             };
120             }
121              
122             # No valid datetime
123             else {
124 0         0 return;
125             };
126              
127 14         23 return $self;
128             };
129              
130              
131             # return string
132             sub to_string {
133 45     45 1 157 my $self = shift;
134 45   100     157 my $level = $_[0] // $self->granularity;
135              
136             # Take the current time if no time given
137 45   33     109 my $epoch = $self->epoch // time;
138              
139             # Get gmtime
140 45         281 my ($sec, $min, $hour, $mday, $month, $year) = gmtime $epoch;
141              
142             # Format
143 45         104 my $s = '%04d';
144 45         141 my @a = ($year + 1900);
145 45 100 33     161 $s .= '-%02d' and push(@a, $month + 1) if $level < 4;
146 45 100 33     130 $s .= '-%02d' and push(@a, $mday) if $level < 3;
147 45 100 33     134 $s .= 'T%02d:%02d' and push(@a, $hour, $min) if $level < 2;
148 45 100 33     128 $s .= ':%02d' and push(@a, $sec) if $level < 1;
149 45 100       86 $s .= 'Z' if $level < 2;
150              
151 45         438 return sprintf($s, @a);
152             };
153              
154              
155             # Epoch datetime
156             sub epoch {
157 104     104 1 771 my $self = shift;
158              
159             # Get epoch
160 104 100       354 return $self->{epoch} unless @_;
161              
162             # Set epoch if valid
163 45 50 33     271 if ($_[0] && $_[0] =~ /^[_\d]+$/) {
164              
165             # Fine to set
166 45         106 $self->{epoch} = shift;
167 45         146 return 1;
168             };
169              
170             # Fail to set
171 0         0 return;
172             };
173              
174              
175             # Granularity
176             sub granularity {
177 124     124 1 176 my $self = shift;
178              
179             # Get granularity
180 124 100       321 return $self->{granularity} unless @_;
181              
182             # Set granularity if valid
183 85 50 33     234 if (defined $_[0] && grep { $_[0] == $_ } 0 .. 4) {
  425         814  
184              
185             # Fine to set
186 85         327 $self->{granularity} = shift;
187 85         143 return 1;
188             };
189              
190             # Fail to set
191 0           return;
192             };
193              
194              
195             1;
196              
197              
198             __END__