File Coverage

blib/lib/BSON/Double.pm
Criterion Covered Total %
statement 48 68 70.5
branch 23 46 50.0
condition 6 6 100.0
subroutine 13 19 68.4
pod 1 2 50.0
total 91 141 64.5


line stmt bran cond sub pod time code
1 71     71   24495 use 5.010001;
  71         218  
2 71     71   332 use strict;
  71         132  
  71         1218  
3 71     71   284 use warnings;
  71         127  
  71         2033  
4              
5             package BSON::Double;
6             # ABSTRACT: BSON type wrapper for Double
7              
8 71     71   334 use version;
  71         135  
  71         296  
9             our $VERSION = 'v1.12.0';
10              
11 71     71   5146 use Carp;
  71         144  
  71         4050  
12              
13             #pod =attr value
14             #pod
15             #pod A numeric scalar (or the special strings "Inf", "-Inf" or "NaN"). This
16             #pod will be coerced to Perl's numeric type. The default is 0.0.
17             #pod
18             #pod =cut
19              
20 71     71   455 use Moo;
  71         149  
  71         391  
21              
22             has 'value' => (
23             is => 'ro'
24             );
25              
26 71     71   22670 use namespace::clean -except => 'meta';
  71         288  
  71         543  
27              
28             use constant {
29 71         50682 nInf => unpack("d<",pack("H*","000000000000f0ff")),
30             pInf => unpack("d<",pack("H*","000000000000f07f")),
31             NaN => unpack("d<",pack("H*","000000000000f8ff")),
32 71     71   22311 };
  71         155  
33              
34             sub BUILD {
35 94     94 0 7164 my $self = shift;
36             # coerce to NV internally
37 94 100       575 $self->{value} = defined( $self->{value} ) ? $self->{value} / 1.0 : 0.0;
38             }
39              
40             #pod =method TO_JSON
41             #pod
42             #pod Returns a double.
43             #pod
44             #pod If the C environment variable is true and the
45             #pod C environment variable is false, returns a hashref
46             #pod compatible with
47             #pod MongoDB's L
48             #pod format, which represents it as a document as follows:
49             #pod
50             #pod {"$numberDouble" : "42.0"}
51             #pod
52             #pod If C is false and the value is 'Inf', '-Inf' or 'NaN'
53             #pod (which are illegal in regular JSON), then an exception is thrown.
54             #pod
55             #pod =cut
56              
57             my $use_win32_specials = ($^O eq 'MSWin32' && $] lt "5.022");
58              
59             my $win32_specials = qr/-?1.\#IN[DF]/i;
60             my $unix_specials = qr/-?(?:inf|nan)/i;
61             my $illegal = $use_win32_specials ? qr/^$win32_specials/ : qr/^$unix_specials/;
62              
63             my $is_inf = $use_win32_specials ? qr/^1.\#INF/i : qr/^inf/i;
64             my $is_ninf = $use_win32_specials ? qr/^-1.\#INF/i : qr/^-inf/i;
65             my $is_nan = $use_win32_specials ? qr/^-?1.\#(?:IND|QNAN)/i : qr/^-?nan/i;
66              
67             sub TO_JSON {
68 46     46 1 585 my $copy = "$_[0]->{value}"; # avoid changing value to PVNV
69              
70 46 100 100     182 if ($ENV{BSON_EXTJSON} && $ENV{BSON_EXTJSON_RELAXED}) {
71              
72 16 100       72 return { '$numberDouble' => 'Infinity' }
73             if $copy =~ $is_inf;
74 14 100       44 return { '$numberDouble' => '-Infinity' }
75             if $copy =~ $is_ninf;
76 12 100       47 return { '$numberDouble' => 'NaN' }
77             if $copy =~ $is_nan;
78             }
79              
80 38 100 100     116 if ($ENV{BSON_EXTJSON} && !$ENV{BSON_EXTJSON_RELAXED}) {
81              
82 26 100       113 return { '$numberDouble' => 'Infinity' }
83             if $copy =~ $is_inf;
84 24 100       87 return { '$numberDouble' => '-Infinity' }
85             if $copy =~ $is_ninf;
86 22 100       80 return { '$numberDouble' => 'NaN' }
87             if $copy =~ $is_nan;
88 18         32 my $value = $_[0]->{value}/1.0;
89 18         79 return { '$numberDouble' => "$value" };
90             }
91              
92 12 100       234 croak( "The value '$copy' is illegal in JSON" )
93             if $copy =~ $illegal;
94              
95 11         32 return $_[0]->{value}/1.0;
96             }
97              
98             use overload (
99             # Unary
100 0     0   0 q{""} => sub { "$_[0]->{value}" },
101 9     9   4050 q{0+} => sub { $_[0]->{value} },
102 0     0   0 q{~} => sub { ~( $_[0]->{value} ) },
103             # Binary
104 142     0   10497 ( map { $_ => eval "sub { return \$_[0]->{value} $_ \$_[1] }" } qw( + * ) ), ## no critic
  0         0  
  0         0  
105             (
106             map {
107 852 50   2   64062 $_ => eval ## no critic
  2 0   0   17  
  0 0       0  
  0 0       0  
  0 0       0  
  0 50       0  
  8 0       110  
  0 0       0  
  0 0       0  
  0 50       0  
  22 0       176  
  0 0          
  0            
108             "sub { return \$_[2] ? \$_[1] $_ \$_[0]->{value} : \$_[0]->{value} $_ \$_[1] }"
109             } qw( - / % ** << >> x <=> cmp & | ^ )
110             ),
111             (
112 426     0   24928 map { $_ => eval "sub { return $_(\$_[0]->{value}) }" } ## no critic
  0            
  0            
  0            
  0            
  0            
  0            
113             qw( cos sin exp log sqrt int )
114             ),
115             q{atan2} => sub {
116 0 0   0   0 return $_[2] ? atan2( $_[1], $_[0]->{value} ) : atan2( $_[0]->{value}, $_[1] );
117             },
118              
119             # Special
120 71         532 fallback => 1,
121 71     71   536 );
  71         144  
122              
123             1;
124              
125             =pod
126              
127             =encoding UTF-8
128              
129             =head1 NAME
130              
131             BSON::Double - BSON type wrapper for Double
132              
133             =head1 VERSION
134              
135             version v1.12.0
136              
137             =head1 SYNOPSIS
138              
139             use BSON::Types ':all';
140              
141             my $bytes = bson_double( $number );
142              
143             =head1 DESCRIPTION
144              
145             This module provides a BSON type wrapper for a numeric value that
146             would be represented in BSON as a double.
147              
148             =head1 ATTRIBUTES
149              
150             =head2 value
151              
152             A numeric scalar (or the special strings "Inf", "-Inf" or "NaN"). This
153             will be coerced to Perl's numeric type. The default is 0.0.
154              
155             =head1 METHODS
156              
157             =head2 TO_JSON
158              
159             Returns a double.
160              
161             If the C environment variable is true and the
162             C environment variable is false, returns a hashref
163             compatible with
164             MongoDB's L
165             format, which represents it as a document as follows:
166              
167             {"$numberDouble" : "42.0"}
168              
169             If C is false and the value is 'Inf', '-Inf' or 'NaN'
170             (which are illegal in regular JSON), then an exception is thrown.
171              
172             =for Pod::Coverage BUILD nInf pInf NaN
173              
174             =head1 INFINITY AND NAN
175              
176             Some Perls may not support converting "Inf" or "NaN" strings to their
177             double equivalent. They are available as functions from the L
178             module, but as a lighter alternative to POSIX, the following functions are
179             available:
180              
181             =over 4
182              
183             =item *
184              
185             BSON::Double::pInf() – positive infinity
186              
187             =item *
188              
189             BSON::Double::nInf() – negative infinity
190              
191             =item *
192              
193             BSON::Double::NaN() – not-a-number
194              
195             =back
196              
197             =head1 OVERLOADING
198              
199             The numification operator, C<0+> is overloaded to return the C,
200             the full "minimal set" of overloaded operations is provided (per L
201             documentation) and fallback overloading is enabled.
202              
203             =head1 AUTHORS
204              
205             =over 4
206              
207             =item *
208              
209             David Golden
210              
211             =item *
212              
213             Stefan G.
214              
215             =back
216              
217             =head1 COPYRIGHT AND LICENSE
218              
219             This software is Copyright (c) 2019 by Stefan G. and MongoDB, Inc.
220              
221             This is free software, licensed under:
222              
223             The Apache License, Version 2.0, January 2004
224              
225             =cut
226              
227             __END__