File Coverage

blib/lib/BSON/Time.pm
Criterion Covered Total %
statement 76 106 71.7
branch 24 34 70.5
condition 5 15 33.3
subroutine 19 24 79.1
pod 7 9 77.7
total 131 188 69.6


line stmt bran cond sub pod time code
1 71     71   26960 use 5.010001;
  71         229  
2 71     71   399 use strict;
  71         124  
  71         1306  
3 71     71   288 use warnings;
  71         131  
  71         2449  
4              
5             package BSON::Time;
6             # ABSTRACT: BSON type wrapper for date and time
7              
8 71     71   373 use version;
  71         146  
  71         312  
9             our $VERSION = 'v1.12.0';
10              
11 71     71   4880 use Carp qw/croak/;
  71         184  
  71         3643  
12 71     71   416 use Config;
  71         114  
  71         3091  
13 71     71   712 use Time::HiRes qw/time/;
  71         118440  
  71         268  
14 71     71   12503 use Scalar::Util qw/looks_like_number/;
  71         140  
  71         3912  
15              
16 71     71   394 use if !$Config{use64bitint}, 'Math::BigInt';
  71         130  
  71         1284  
17 71     71   3355 use if !$Config{use64bitint}, 'Math::BigFloat';
  71         137  
  71         500  
18              
19 71     71   2171 use Moo;
  71         158  
  71         402  
20              
21             #pod =attr value
22             #pod
23             #pod A integer representing milliseconds since the Unix epoch. The default
24             #pod is 0.
25             #pod
26             #pod =cut
27              
28             has 'value' => (
29             is => 'ro'
30             );
31              
32 71     71   22998 use namespace::clean -except => 'meta';
  71         176  
  71         502  
33              
34             sub BUILDARGS {
35 17043     17043 0 1413234 my $class = shift;
36 17043         20948 my $n = scalar(@_);
37              
38 17043         19498 my %args;
39 17043 100       39672 if ( $n == 0 ) {
    100          
    50          
40 6 50       126 if ( $Config{use64bitint} ) {
41 6         42 $args{value} = time() * 1000;
42             }
43             else {
44 0         0 $args{value} = Math::BigFloat->new(time());
45 0         0 $args{value}->bmul(1000);
46 0         0 $args{value} = $args{value}->as_number('zero');
47             }
48             }
49             elsif ( $n == 1 ) {
50 8580 100       24116 croak "argument to BSON::Time::new must be epoch seconds, not '$_[0]'"
51             unless looks_like_number( $_[0] );
52              
53 8579 50 33     48497 if ( !$Config{use64bitint} && ref($args{value}) ne 'Math::BigInt' ) {
54 0         0 $args{value} = Math::BigFloat->new(shift);
55 0         0 $args{value}->bmul(1000);
56 0         0 $args{value} = $args{value}->as_number('zero');
57             }
58             else {
59 8579         16281 $args{value} = 1000 * shift;
60             }
61             }
62             elsif ( $n % 2 == 0 ) {
63 8457         18326 %args = @_;
64 8457 50       13466 if ( defined $args{value} ) {
65             croak "argument to BSON::Time::new must be epoch seconds, not '$args{value}'"
66 8457 50 33     24316 unless looks_like_number( $args{value} ) || overload::Overloaded($args{value});
67              
68 8457 50 33     48478 if ( !$Config{use64bitint} && ref($args{value}) ne 'Math::BigInt' ) {
69 0         0 $args{value} = Math::BigInt->new($args{value});
70             }
71             }
72             else {
73 0 0 0     0 if ( !$Config{use64bitint} && ref($args{value}) ne 'Math::BigInt' ) {
74 0         0 $args{value} = Math::BigFloat->new(shift);
75 0         0 $args{value}->bmul(1000);
76 0         0 $args{value} = $args{value}->as_number('zero');
77             }
78             else {
79 0         0 $args{value} = 1000 * shift;
80             }
81             }
82             }
83             else {
84 0         0 croak("Invalid number of arguments ($n) to BSON::Time::new");
85             }
86              
87             # normalize all to integer ms
88 17042         36650 $args{value} = int( $args{value} );
89              
90 17042         236051 return \%args;
91             }
92              
93             #pod =method epoch
94             #pod
95             #pod Returns the number of seconds since the epoch (i.e. a floating-point value).
96             #pod
97             #pod =cut
98              
99             sub epoch {
100 16850     16850 1 2917058 my $self = shift;
101 16850 50       76082 if ( $Config{use64bitint} ) {
102 16850         62277 return $self->value / 1000;
103             }
104             else {
105 0         0 require Math::BigFloat;
106 0         0 my $upgrade = Math::BigFloat->new($self->value->bstr);
107 0         0 return 0 + $upgrade->bdiv(1000)->bstr;
108             }
109             }
110              
111             #pod =method as_iso8601
112             #pod
113             #pod Returns the C as an ISO-8601 formatted string of the form
114             #pod C. The fractional seconds will be omitted if
115             #pod they are zero.
116             #pod
117             #pod =cut
118              
119             sub as_iso8601 {
120 6     6 1 13 my $self = shift;
121 6         11 my ($s, $m, $h, $D, $M, $Y) = gmtime($self->epoch);
122 6         18 $M++;
123 6         12 $Y+=1900;
124 6         16 my $f = $self->{value} % 1000;
125 6 100       51 return $f
126             ? sprintf( "%4d-%02d-%02dT%02d:%02d:%02d.%03dZ", $Y, $M, $D, $h, $m, $s, $f )
127             : sprintf( "%4d-%02d-%02dT%02d:%02d:%02dZ", $Y, $M, $D, $h, $m, $s );
128             }
129              
130             #pod =method as_datetime
131             #pod
132             #pod Loads L and returns the C as a L object.
133             #pod
134             #pod =cut
135              
136             sub as_datetime {
137 0     0 1 0 require DateTime;
138 0         0 return DateTime->from_epoch( epoch => $_[0]->{value} / 1000 );
139             }
140              
141             #pod =method as_datetime_tiny
142             #pod
143             #pod Loads L and returns the C as a L
144             #pod object.
145             #pod
146             #pod =cut
147              
148             sub as_datetime_tiny {
149 0     0 1 0 my ($s, $m, $h, $D, $M, $Y) = gmtime($_[0]->epoch);
150 0         0 $M++;
151 0         0 $Y+=1900;
152              
153 0         0 require DateTime::Tiny;
154 0         0 return DateTime::Tiny->new(
155             year => $Y, month => $M, day => $D,
156             hour => $h, minute => $m, second => $s
157             );
158             }
159              
160             #pod =method as_mango_time
161             #pod
162             #pod Loads L and returns the C as a L
163             #pod object.
164             #pod
165             #pod =cut
166              
167             sub as_mango_time {
168 0     0 1 0 require Mango::BSON::Time;
169 0         0 return Mango::BSON::Time->new( $_[0]->{value} );
170             }
171              
172             #pod =method as_time_moment
173             #pod
174             #pod Loads L and returns the C as a L object.
175             #pod
176             #pod =cut
177              
178             sub as_time_moment {
179 0     0 1 0 require Time::Moment;
180 0         0 return Time::Moment->from_epoch( $_[0]->{value} / 1000 );
181             }
182              
183             sub _num_cmp {
184 2     2   60 my ( $self, $other ) = @_;
185 2 50       7 if ( ref($other) eq ref($self) ) {
186 0         0 return $self->{value} <=> $other->{value};
187             }
188 2         5 return 0+ $self <=> 0+ $other;
189             }
190              
191             sub _str_cmp {
192 2     2   530 my ( $self, $other ) = @_;
193 2 100       12 if ( ref($other) eq ref($self) ) {
194 1         13 return $self->{value} cmp $other->{value};
195             }
196 1         4 return "$self" cmp "$other";
197             }
198              
199             sub op_eq {
200 0     0 0 0 my ( $self, $other ) = @_;
201 0         0 return( ($self <=> $other) == 0 );
202             }
203              
204             use overload (
205 71         475 q{""} => \&epoch,
206             q{0+} => \&epoch,
207             q{<=>} => \&_num_cmp,
208             q{cmp} => \&_str_cmp,
209             fallback => 1,
210 71     71   94058 );
  71         169  
211              
212             #pod =method TO_JSON
213             #pod
214             #pod Returns a string formatted by L.
215             #pod
216             #pod If the C option is true, it will instead be compatible with
217             #pod MongoDB's L
218             #pod format, which represents it as a document as follows:
219             #pod
220             #pod
221             #pod If the C environment variable is true and the
222             #pod C environment variable is false, returns a hashref
223             #pod compatible with
224             #pod MongoDB's L
225             #pod format, which represents it as a document as follows:
226             #pod
227             #pod {"$date" : { "$numberLong": "22337203685477580" } }
228             #pod
229             #pod If the C and C environment variables are
230             #pod both true, then it will return a hashref with an ISO-8601 string for dates
231             #pod after the Unix epoch and before the year 10,000 and a C<$numberLong> style
232             #pod value otherwise.
233             #pod
234             #pod {"$date" : "2012-12-24T12:15:30.500Z"}
235             #pod {"$date" : { "$numberLong": "-10000000" } }
236             #pod
237             #pod =cut
238              
239             sub TO_JSON {
240             return $_[0]->as_iso8601
241 24 100   24 1 326 if ! $ENV{BSON_EXTJSON};
242              
243             return { '$date' => { '$numberLong' => "$_[0]->{value}"} }
244 22 100       97 if ! $ENV{BSON_EXTJSON_RELAXED};
245              
246             # Relaxed form is human readable for positive epoch to year 10k
247 6         21 my $year = (gmtime($_[0]->epoch))[5];
248 6         16 $year += 1900;
249 6 100 66     22 if ($year >= 1970 and $year <= 9999) {
250 4         10 return { '$date' => $_[0]->as_iso8601 };
251             }
252             else {
253 2         10 return { '$date' => { '$numberLong' => "$_[0]->{value}" } };
254             }
255             }
256              
257             1;
258              
259             =pod
260              
261             =encoding UTF-8
262              
263             =head1 NAME
264              
265             BSON::Time - BSON type wrapper for date and time
266              
267             =head1 VERSION
268              
269             version v1.12.0
270              
271             =head1 SYNOPSIS
272              
273             use BSON::Types ':all';
274              
275             bson_time(); # now
276             bson_time( $secs ); # floating point seconds since epoch
277              
278             =head1 DESCRIPTION
279              
280             This module provides a BSON type wrapper for a 64-bit date-time value in
281             the form of milliseconds since the Unix epoch (UTC only).
282              
283             On a Perl without 64-bit integer support, the value must be a
284             L object.
285              
286             =head1 ATTRIBUTES
287              
288             =head2 value
289              
290             A integer representing milliseconds since the Unix epoch. The default
291             is 0.
292              
293             =head1 METHODS
294              
295             =head2 epoch
296              
297             Returns the number of seconds since the epoch (i.e. a floating-point value).
298              
299             =head2 as_iso8601
300              
301             Returns the C as an ISO-8601 formatted string of the form
302             C. The fractional seconds will be omitted if
303             they are zero.
304              
305             =head2 as_datetime
306              
307             Loads L and returns the C as a L object.
308              
309             =head2 as_datetime_tiny
310              
311             Loads L and returns the C as a L
312             object.
313              
314             =head2 as_mango_time
315              
316             Loads L and returns the C as a L
317             object.
318              
319             =head2 as_time_moment
320              
321             Loads L and returns the C as a L object.
322              
323             =head2 TO_JSON
324              
325             Returns a string formatted by L.
326              
327             If the C option is true, it will instead be compatible with
328             MongoDB's L
329             format, which represents it as a document as follows:
330              
331             If the C environment variable is true and the
332             C environment variable is false, returns a hashref
333             compatible with
334             MongoDB's L
335             format, which represents it as a document as follows:
336              
337             {"$date" : { "$numberLong": "22337203685477580" } }
338              
339             If the C and C environment variables are
340             both true, then it will return a hashref with an ISO-8601 string for dates
341             after the Unix epoch and before the year 10,000 and a C<$numberLong> style
342             value otherwise.
343              
344             {"$date" : "2012-12-24T12:15:30.500Z"}
345             {"$date" : { "$numberLong": "-10000000" } }
346              
347             =for Pod::Coverage op_eq BUILDARGS
348              
349             =head1 OVERLOADING
350              
351             Both numification (C<0+>) and stringification (C<"">) are overloaded to
352             return the result of L. Numeric comparison and string comparison
353             are overloaded based on those and fallback overloading is enabled.
354              
355             =head1 AUTHORS
356              
357             =over 4
358              
359             =item *
360              
361             David Golden
362              
363             =item *
364              
365             Stefan G.
366              
367             =back
368              
369             =head1 COPYRIGHT AND LICENSE
370              
371             This software is Copyright (c) 2019 by Stefan G. and MongoDB, Inc.
372              
373             This is free software, licensed under:
374              
375             The Apache License, Version 2.0, January 2004
376              
377             =cut
378              
379             __END__