File Coverage

blib/lib/Time/FFI.pm
Criterion Covered Total %
statement 24 24 100.0
branch n/a
condition n/a
subroutine 8 8 100.0
pod n/a
total 32 32 100.0


line stmt bran cond sub pod time code
1             package Time::FFI;
2              
3 3     3   252286 use strict;
  3         8  
  3         84  
4 3     3   13 use warnings;
  3         4  
  3         69  
5 3     3   12 use Carp 'croak';
  3         4  
  3         119  
6 3     3   13 use Exporter 'import';
  3         4  
  3         73  
7 3     3   643 use FFI::Platypus;
  3         5943  
  3         61  
8 3     3   1140 use FFI::Platypus::Buffer;
  3         1341  
  3         135  
9 3     3   1142 use FFI::Platypus::Memory;
  3         17333  
  3         184  
10 3     3   419 use Time::FFI::tm;
  3         5  
  3         3052  
11              
12             our $VERSION = '2.000';
13              
14             our @EXPORT_OK = qw(asctime ctime gmtime localtime mktime strftime strptime timegm timelocal);
15             our %EXPORT_TAGS = (all => \@EXPORT_OK);
16              
17             my $ffi = FFI::Platypus->new(lib => [undef], ignore_not_found => 1);
18             $ffi->type('record(Time::FFI::tm)' => 'tm');
19             my $char_size = $ffi->sizeof('char');
20              
21             if (defined $ffi->find_symbol('asctime_r')) {
22             $ffi->attach([asctime_r => 'asctime'] => ['tm', 'opaque'] => 'string' => sub {
23             my ($xsub, $tm) = @_;
24             my $rc = $xsub->($tm, my $buf = calloc(26, $char_size));
25             free $buf;
26             croak "asctime: $!" unless defined $rc;
27             return $rc;
28             });
29             } else {
30             $ffi->attach(asctime => ['tm'] => 'string' => sub {
31             my ($xsub, $tm) = @_;
32             my $rc = $xsub->($tm);
33             croak "asctime: $!" unless defined $rc;
34             return $rc;
35             });
36             }
37              
38             if (defined $ffi->find_symbol('ctime_r')) {
39             $ffi->attach([ctime_r => 'ctime'] => ['time_t*', 'opaque'] => 'string' => sub {
40             my ($xsub, $time) = @_;
41             $time = time unless defined $time;
42             my $rc = $xsub->(\$time, my $buf = calloc(26, $char_size));
43             free $buf;
44             croak "ctime: $!" unless defined $rc;
45             return $rc;
46             });
47             } else {
48             $ffi->attach(ctime => ['time_t*'] => 'string' => sub {
49             my ($xsub, $time) = @_;
50             $time = time unless defined $time;
51             my $rc = $xsub->(\$time);
52             croak "ctime: $!" unless defined $rc;
53             return $rc;
54             });
55             }
56              
57             if (defined $ffi->find_symbol('gmtime_r')) {
58             $ffi->attach([gmtime_r => 'gmtime'] => ['time_t*', 'tm'] => 'opaque' => sub {
59             my ($xsub, $time) = @_;
60             $time = time unless defined $time;
61             my $rc = $xsub->(\$time, my $tm = Time::FFI::tm->new);
62             croak "gmtime: $!" unless defined $rc;
63             return $tm;
64             });
65             } else {
66             $ffi->attach(gmtime => ['time_t*'] => 'tm' => sub {
67             my ($xsub, $time) = @_;
68             $time = time unless defined $time;
69             my $rc = $xsub->(\$time);
70             croak "gmtime: $!" unless defined $rc;
71             return $rc;
72             });
73             }
74              
75             if (defined $ffi->find_symbol('localtime_r')) {
76             $ffi->attach([localtime_r => 'localtime'] => ['time_t*', 'tm'] => 'opaque' => sub {
77             my ($xsub, $time) = @_;
78             $time = time unless defined $time;
79             my $rc = $xsub->(\$time, my $tm = Time::FFI::tm->new);
80             croak "localtime: $!" unless defined $rc;
81             return $tm;
82             });
83             } else {
84             $ffi->attach(localtime => ['time_t*'] => 'tm' => sub {
85             my ($xsub, $time) = @_;
86             $time = time unless defined $time;
87             my $rc = $xsub->(\$time);
88             croak "localtime: $!" unless defined $rc;
89             return $rc;
90             });
91             }
92              
93             $ffi->attach(mktime => ['tm'] => 'time_t' => sub {
94             my ($xsub, $tm) = @_;
95             my $rc = $xsub->($tm);
96             croak "mktime: $!" if $rc == -1;
97             return $rc;
98             });
99              
100             $ffi->attach(strftime => ['opaque', 'size_t', 'string', 'tm'] => 'size_t' => sub {
101             my ($xsub, $format, $tm) = @_;
102             my $max_size = length($format) * 20;
103             my $buf_size = 200;
104             my $rc = 0;
105             my $buf;
106             until ($rc != 0) {
107             $rc = $xsub->($buf = realloc($buf, $buf_size * $char_size), $buf_size, $format, $tm);
108             last if $buf_size > $max_size;
109             } continue {
110             $buf_size *= 2;
111             }
112             my $str = buffer_to_scalar $buf, $rc * $char_size;
113             free $buf;
114             return $str;
115             });
116              
117             $ffi->attach(strptime => ['string', 'string', 'tm'] => 'string' => sub {
118             my ($xsub, $str, $format, $tm, $remaining) = @_;
119             $tm = Time::FFI::tm->new unless defined $tm;
120             my $rc = $xsub->($str, $format, $tm);
121             croak "strptime: Failed to match input to format string" unless defined $rc;
122             $tm->isdst(-1);
123             $$remaining = $rc if defined $remaining;
124             return $tm;
125             });
126              
127             $ffi->attach(timegm => ['tm'] => 'time_t' => sub {
128             my ($xsub, $tm) = @_;
129             my $rc = $xsub->($tm);
130             croak "timegm: $!" if $rc == -1;
131             return $rc;
132             });
133              
134             $ffi->attach(timelocal => ['tm'] => 'time_t' => sub {
135             my ($xsub, $tm) = @_;
136             my $rc = $xsub->($tm);
137             croak "timelocal: $!" if $rc == -1;
138             return $rc;
139             });
140              
141             1;
142              
143             =head1 NAME
144              
145             Time::FFI - libffi interface to POSIX date and time functions
146              
147             =head1 SYNOPSIS
148              
149             use Time::FFI qw(localtime mktime strptime strftime);
150              
151             my $tm = strptime '1995-01-02 13:15:39', '%Y-%m-%d %H:%M:%S';
152             my $epoch = mktime $tm;
153             print "$epoch: ", strftime('%I:%M:%S %p on %B %e, %Y', $tm);
154              
155             my $tm = localtime time;
156             my $datetime = $tm->to_object('DateTime', 1);
157              
158             my $tm = gmtime time;
159             my $moment = $tm->to_object('Time::Moment', 0);
160              
161             use Time::FFI::tm;
162             my $tm = Time::FFI::tm->from_object(DateTime->now);
163             my $epoch = $tm->epoch(1);
164             my $piece = $tm->to_object('Time::Piece', 1);
165              
166             =head1 DESCRIPTION
167              
168             B provides a L interface to POSIX date and
169             time functions found in F.
170              
171             The L and L functions behave very differently from the
172             core functions of the same name, as well as those exported by L,
173             so you may wish to call them as e.g. C rather than importing
174             them.
175              
176             All functions will throw an exception in the event of an error. For functions
177             other than L and L, this exception will contain the
178             syscall error message, and L will also have been set by the
179             syscall, so you could check it after trapping the exception for finer exception
180             handling.
181              
182             =head1 FUNCTIONS
183              
184             All functions are exported individually, or with the C<:all> export tag.
185              
186             =head2 asctime
187              
188             my $str = asctime $tm;
189              
190             Returns a string in the format C representing the
191             passed L record. The thread-safe L function is
192             used if available.
193              
194             =head2 ctime
195              
196             my $str = ctime $epoch;
197             my $str = ctime;
198              
199             Returns a string in the format C representing the
200             passed epoch timestamp (defaulting to the current time) in the local time zone.
201             This is equivalent to L but uses the thread-safe L
202             function if available.
203              
204             =head2 gmtime
205              
206             my $tm = gmtime $epoch;
207             my $tm = gmtime;
208              
209             Returns a L record representing the passed epoch timestamp
210             (defaulting to the current time) in UTC. The thread-safe L
211             function is used if available.
212              
213             =head2 localtime
214              
215             my $tm = localtime $epoch;
216             my $tm = localtime;
217              
218             Returns a L record representing the passed epoch timestamp
219             (defaulting to the current time) in the local time zone. The thread-safe
220             L function is used if available.
221              
222             =head2 mktime
223              
224             my $epoch = mktime $tm;
225              
226             Returns the epoch timestamp representing the passed L record
227             interpreted in the local time zone. The time is interpreted from the C,
228             C, C, C, C, C, and C members of the record,
229             ignoring the rest. DST status will be automatically determined if C is a
230             negative value. The record will also be updated to normalize any out-of-range
231             values and populate the C, C, and C values, as well as
232             C and C if supported.
233              
234             =head2 strftime
235              
236             my $str = strftime $format, $tm;
237              
238             Returns a string formatted according to the passed format string, representing
239             the passed L record. Consult your system's L manual
240             for available format descriptors.
241              
242             =head2 strptime
243              
244             my $tm = strptime $str, $format;
245             $tm = strptime $str, $format, $tm;
246             my $tm = strptime $str, $format, undef, \my $remaining;
247             $tm = strptime $str, $format, $tm, \my $remaining;
248              
249             Returns a L record representing the passed string, parsed
250             according to the passed format. Consult your system's L manual for
251             available format descriptors. The C value will be set to -1; all other
252             unspecified values will default to 0. Note that the default C value of 0
253             is outside of the standard range [1,31] and may cause an error or be
254             interpreted as the last day of the previous month.
255              
256             A L record may be passed as the third argument, in which case it
257             will be modified in place to (on most systems) update only the date/time
258             elements which were parsed from the string. Additionally, an optional scalar
259             reference may be passed as the fourth argument, in which case it will be set to
260             the remaining unprocessed characters of the input string if any.
261              
262             This function is usually not available on Windows.
263              
264             =head2 timegm
265              
266             my $epoch = timegm $tm;
267              
268             I
269              
270             Like L, but interprets the passed L record as UTC. This
271             function is not always available.
272              
273             =head2 timelocal
274              
275             my $epoch = timelocal $tm;
276              
277             I
278              
279             The same as L, but not always available.
280              
281             =head1 BUGS
282              
283             Report any issues on the public bugtracker.
284              
285             =head1 AUTHOR
286              
287             Dan Book
288              
289             =head1 COPYRIGHT AND LICENSE
290              
291             This software is Copyright (c) 2019 by Dan Book.
292              
293             This is free software, licensed under:
294              
295             The Artistic License 2.0 (GPL Compatible)
296              
297             =head1 SEE ALSO
298              
299             L, L, L, L, L