File Coverage

blib/lib/Time/FFI/tm.pm
Criterion Covered Total %
statement 65 75 86.6
branch 17 28 60.7
condition 2 6 33.3
subroutine 14 14 100.0
pod 6 6 100.0
total 104 129 80.6


line stmt bran cond sub pod time code
1             package Time::FFI::tm;
2              
3 3     3   468631 use strict;
  3         15  
  3         87  
4 3     3   14 use warnings;
  3         6  
  3         69  
5 3     3   15 use Carp ();
  3         330  
  3         56  
6 3     3   1527 use FFI::Platypus::Record ();
  3         19132  
  3         63  
7 3     3   1590 use Module::Runtime ();
  3         5276  
  3         73  
8 3     3   1057 use Time::Local ();
  3         4501  
  3         216  
9              
10             our $VERSION = '2.001';
11              
12             my @tm_members = qw(sec min hour mday mon year wday yday isdst);
13              
14             FFI::Platypus::Record::record_layout_1(
15             (map { (int => $_) } @tm_members),
16             long => 'gmtoff',
17             string => 'zone',
18             );
19              
20             {
21 3     3   21 no strict 'refs';
  3         6  
  3         3184  
22             *{"tm_$_"} = \&$_ for @tm_members, 'gmtoff', 'zone';
23             }
24              
25             sub from_list {
26 4     4 1 157 my ($class, @args) = @_;
27 4         14 my %attr = map { ($tm_members[$_] => $args[$_]) } 0..$#tm_members;
  36         79  
28 4         21 return $class->new(\%attr);
29             }
30              
31             sub from_object {
32 4     4 1 15393 my ($class, $obj) = @_;
33 4 100 33     50 if ($obj->isa('Time::Piece')) {
    50          
    50          
    50          
34 2         7 return $class->new(
35             year => $obj->year - 1900,
36             mon => $obj->mon - 1,
37             mday => $obj->mday,
38             hour => $obj->hour,
39             min => $obj->min,
40             sec => $obj->sec,
41             isdst => -1,
42             );
43             } elsif ($obj->isa('Time::Moment')) {
44 0         0 return $class->new(
45             year => $obj->year - 1900,
46             mon => $obj->month - 1,
47             mday => $obj->day_of_month,
48             hour => $obj->hour,
49             min => $obj->minute,
50             sec => $obj->second,
51             isdst => -1,
52             );
53             } elsif ($obj->isa('DateTime')) {
54 0         0 return $class->new(
55             year => $obj->year - 1900,
56             mon => $obj->month - 1,
57             mday => $obj->day,
58             hour => $obj->hour,
59             min => $obj->minute,
60             sec => $obj->second,
61             isdst => -1,
62             );
63             } elsif ($obj->isa('Time::FFI::tm') or $obj->isa('Time::tm')) {
64 2         6 my %attr = map { ($_ => $obj->$_) } qw(sec min hour mday mon year wday yday isdst);
  18         359  
65 2         31 return $class->new(\%attr);
66             } else {
67 0         0 my $class = ref $obj;
68 0         0 Carp::croak "Cannot convert from unrecognized object class $class";
69             }
70             }
71              
72             sub to_list {
73 2     2 1 5 my ($self) = @_;
74 2         5 return map { $self->$_ } @tm_members;
  18         53  
75             }
76              
77             sub to_object {
78 5     5 1 195 my ($self, $class, $islocal) = @_;
79 5         19 Module::Runtime::require_module $class;
80 5 100 33     272 if ($class->isa('Time::Piece')) {
    50          
    50          
    50          
81 3         16 my ($epoch, $new) = $self->_mktime($islocal);
82 3 100       75 return $islocal ? scalar $class->localtime($epoch) : scalar $class->gmtime($epoch);
83             } elsif ($class->isa('Time::Moment')) {
84 0         0 my ($epoch, $new) = $self->_mktime($islocal);
85 0         0 my $moment = $class->new(
86             year => $new->year + 1900,
87             month => $new->mon + 1,
88             day => $new->mday,
89             hour => $new->hour,
90             minute => $new->min,
91             second => $new->sec,
92             );
93 0 0       0 return $islocal ? $moment->with_offset_same_local(($moment->epoch - $epoch) / 60) : $moment;
94             } elsif ($class->isa('DateTime')) {
95 0         0 my ($epoch, $new) = $self->_mktime($islocal);
96 0 0       0 return $class->new(
97             year => $new->year + 1900,
98             month => $new->mon + 1,
99             day => $new->mday,
100             hour => $new->hour,
101             minute => $new->min,
102             second => $new->sec,
103             time_zone => $islocal ? 'local' : 'UTC',
104             );
105             } elsif ($class->isa('Time::FFI::tm') or $class->isa('Time::tm')) {
106 2         7 my %attr = map { ($_ => $self->$_) } qw(sec min hour mday mon year wday yday isdst);
  18         46  
107 2         55 return $class->new(%attr);
108             } else {
109 0         0 Carp::croak "Cannot convert to unrecognized object class $class";
110             }
111             }
112              
113             sub epoch {
114 8     8 1 27157 my ($self, $islocal) = @_;
115 8         29 my ($epoch, $new) = $self->_mktime($islocal);
116 8         173 return $epoch;
117             }
118              
119             sub normalized {
120 2     2 1 5351 my ($self, $islocal) = @_;
121 2         7 my ($epoch, $new) = $self->_mktime($islocal);
122 2 100       45 if (!$islocal) {
123 1         7 require Time::FFI;
124 1         5 $new = Time::FFI::gmtime($epoch);
125 1         2 bless $new, ref $self;
126             }
127 2         10 return $new;
128             }
129             *with_extra = \&normalized;
130              
131             sub _mktime {
132 13     13   27 my ($self, $islocal) = @_;
133 13 100       32 if ($islocal) {
134 7         1037 require Time::FFI;
135 7         28 my %attr = map { ($_ => $self->$_) } qw(sec min hour mday mon year);
  42         115  
136 7         20 $attr{isdst} = -1;
137 7         56 my $new = (ref $self)->new(\%attr);
138 7         347 return (Time::FFI::mktime($new), $new);
139             } else {
140 6         18 my $year = $self->year;
141 6 50       22 $year += 1900 if $year >= 0; # avoid timegm year heuristic
142 6         13 my @vals = ((map { $self->$_ } qw(sec min hour mday mon)), $year);
  30         102  
143 6         23 return (scalar Time::Local::timegm(@vals), $self);
144             }
145             }
146              
147             1;
148              
149             =head1 NAME
150              
151             Time::FFI::tm - POSIX tm record structure
152              
153             =head1 SYNOPSIS
154              
155             use Time::FFI::tm;
156              
157             my $tm = Time::FFI::tm->new(
158             year => 95, # years since 1900
159             mon => 0, # 0 == January
160             mday => 1,
161             hour => 13,
162             min => 25,
163             sec => 59,
164             isdst => -1, # allow DST status to be determined by the system
165             );
166             $tm->mday($tm->mday + 1); # add a day
167              
168             my $in_local = $tm->normalized(1);
169             say $in_local->isdst; # now knows if DST is active
170              
171             my $tm = Time::FFI::tm->from_list(CORE::localtime(time));
172              
173             my $epoch = POSIX::mktime($tm->to_list);
174             my $epoch = $tm->epoch(1);
175              
176             my $tm = Time::FFI::tm->from_object(Time::Moment->now);
177             my $datetime = $tm->to_object('DateTime', 1);
178              
179             =head1 DESCRIPTION
180              
181             This L class represents the C struct defined by
182             F and used by functions such as L and L. This
183             is used by L to provide access to such structures.
184              
185             The structure does not store an explicit time zone, so you must specify whether
186             to interpret it as local or UTC time whenever rendering it to an actual
187             datetime.
188              
189             =head1 ATTRIBUTES
190              
191             The integer components of the C struct are stored as settable attributes
192             that default to 0.
193              
194             Note that 0 is out of the standard range for the C value (often
195             indicating the last day of the previous month), and C should be set to a
196             negative value if unknown, so these values should always be specified
197             explicitly.
198              
199             Each attribute also has a corresponding alias starting with C to match the
200             standard C struct member names.
201              
202             =head2 sec
203              
204             Seconds [0,60].
205              
206             =head2 min
207              
208             Minutes [0,59].
209              
210             =head2 hour
211              
212             Hour [0,23].
213              
214             =head2 mday
215              
216             Day of month [1,31].
217              
218             =head2 mon
219              
220             Month of year [0,11].
221              
222             =head2 year
223              
224             Years since 1900.
225              
226             =head2 wday
227              
228             Day of week [0,6] (Sunday =0).
229              
230             =head2 yday
231              
232             Day of year [0,365].
233              
234             =head2 isdst
235              
236             Daylight Savings flag. (0: off, positive: on, negative: unknown)
237              
238             =head2 gmtoff
239              
240             Seconds east of UTC. (May not be available on all systems)
241              
242             =head2 zone
243              
244             Timezone abbreviation. (Read only string, may not be available on all systems)
245              
246             =head1 METHODS
247              
248             =head2 new
249              
250             my $tm = Time::FFI::tm->new;
251             my $tm = Time::FFI::tm->new(year => $year, ...);
252             my $tm = Time::FFI::tm->new({year => $year, ...});
253              
254             Construct a new B object representing a C struct.
255              
256             =head2 from_list
257              
258             my $tm = Time::FFI::tm->from_list($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
259              
260             Construct a new B object from the passed list of values, in the
261             same order returned by L. Missing or undefined values will
262             be interpreted as the default of 0, but see L.
263              
264             =head2 from_object
265              
266             my $tm = Time::FFI::tm->from_object($obj);
267              
268             I
269              
270             Construct a new B object from the passed datetime object's local
271             datetime components. Currently L, L, L,
272             L, and L objects (and subclasses) are recognized. The
273             original time zone and any fractional seconds will not be represented in the
274             resulting structure.
275              
276             =head2 to_list
277              
278             my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = $tm->to_list;
279              
280             Return the list of values in the structure, in the same order returned by
281             L.
282              
283             =head2 to_object
284              
285             my $piece = $tm->to_object('Time::Piece', $islocal);
286             my $moment = $tm->to_object('Time::Moment', $islocal);
287             my $datetime = $tm->to_object('DateTime', $islocal);
288              
289             Return an object of the specified class. If a true value is passed as the
290             second argument, the object will represent the time as interpreted in the local
291             time zone; otherwise it will be interpreted as UTC. Currently L,
292             L, and L (or subclasses) are recognized.
293              
294             When interpreted as a local time, values outside the standard ranges are
295             accepted; this is not currently supported for UTC times.
296              
297             You may also specify L or L (or subclasses), in which
298             case the C<$islocal> parameter is ignored and the values are copied as-is.
299              
300             =head2 epoch
301              
302             my $epoch = $tm->epoch($islocal);
303              
304             I
305              
306             Translate the time structure into a Unix epoch timestamp (seconds since
307             1970-01-01 UTC). If a true value is passed, the timestamp will represent the
308             time as interpreted in the local time zone; otherwise it will be interpreted as
309             UTC.
310              
311             When interpreted as a local time, values outside the standard ranges are
312             accepted; this is not currently supported for UTC times.
313              
314             =head2 normalized
315              
316             my $new = $tm->normalized($islocal);
317              
318             I
319              
320             Return a new B object representing the same time, but with
321             C, C, C, and (if supported) C and C set
322             appropriately. If a true value is passed, these values will be set according to
323             the time as interpreted in the local time zone; otherwise they will be set
324             according to the time as interpreted in UTC. Note that this does not replace
325             the need to pass C<$islocal> for future conversions.
326              
327             When interpreted as a local time, values outside the standard ranges will also
328             be normalized; this is not currently supported for UTC times.
329              
330             =head1 BUGS
331              
332             Report any issues on the public bugtracker.
333              
334             =head1 AUTHOR
335              
336             Dan Book
337              
338             =head1 COPYRIGHT AND LICENSE
339              
340             This software is Copyright (c) 2019 by Dan Book.
341              
342             This is free software, licensed under:
343              
344             The Artistic License 2.0 (GPL Compatible)
345              
346             =head1 SEE ALSO
347              
348             L, L
349              
350             =for Pod::Coverage with_extra tm_sec tm_min tm_hour tm_mday tm_mon tm_year tm_wday tm_yday tm_isdst tm_gmtoff tm_zone