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 12 19 63.1
pod 1 2 50.0
total 90 141 63.8


line stmt bran cond sub pod time code
1 71     71   25322 use 5.010001;
  71         230  
2 71     71   316 use strict;
  71         125  
  71         1273  
3 71     71   288 use warnings;
  71         244  
  71         2138  
4              
5             package BSON::Double;
6             # ABSTRACT: BSON type wrapper for Double
7              
8 71     71   344 use version;
  71         142  
  71         307  
9             our $VERSION = 'v1.12.2';
10              
11 71     71   4932 use Carp;
  71         247  
  71         4401  
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   417 use Moo;
  71         130  
  71         399  
21              
22             has 'value' => (
23             is => 'ro'
24             );
25              
26 71     71   23484 use namespace::clean -except => 'meta';
  71         137  
  71         458  
27              
28             use constant {
29 71         52423 nInf => unpack("d<",pack("H*","000000000000f0ff")),
30             pInf => unpack("d<",pack("H*","000000000000f07f")),
31             NaN => unpack("d<",pack("H*","000000000000f8ff")),
32 71     71   22833 };
  71         228  
33              
34             sub BUILD {
35 94     94 0 7340 my $self = shift;
36             # coerce to NV internally
37 94 100       604 $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 660 my $copy = "$_[0]->{value}"; # avoid changing value to PVNV
69              
70 46 100 100     164 if ($ENV{BSON_EXTJSON} && $ENV{BSON_EXTJSON_RELAXED}) {
71              
72 16 100       96 return { '$numberDouble' => 'Infinity' }
73             if $copy =~ $is_inf;
74 14 100       49 return { '$numberDouble' => '-Infinity' }
75             if $copy =~ $is_ninf;
76 12 100       57 return { '$numberDouble' => 'NaN' }
77             if $copy =~ $is_nan;
78             }
79              
80 38 100 100     123 if ($ENV{BSON_EXTJSON} && !$ENV{BSON_EXTJSON_RELAXED}) {
81              
82 26 100       136 return { '$numberDouble' => 'Infinity' }
83             if $copy =~ $is_inf;
84 24 100       82 return { '$numberDouble' => '-Infinity' }
85             if $copy =~ $is_ninf;
86 22 100       92 return { '$numberDouble' => 'NaN' }
87             if $copy =~ $is_nan;
88 18         46 my $value = $_[0]->{value}/1.0;
89 18         85 return { '$numberDouble' => "$value" };
90             }
91              
92 12 100       222 croak( "The value '$copy' is illegal in JSON" )
93             if $copy =~ $illegal;
94              
95 11         34 return $_[0]->{value}/1.0;
96             }
97              
98             use overload (
99             # Unary
100 0     0   0 q{""} => sub { "$_[0]->{value}" },
101 9     9   3620 q{0+} => sub { $_[0]->{value} },
102 0     0   0 q{~} => sub { ~( $_[0]->{value} ) },
103             # Binary
104 142     0   10879 ( map { $_ => eval "sub { return \$_[0]->{value} $_ \$_[1] }" } qw( + * ) ), ## no critic
  0         0  
  0         0  
105             (
106             map {
107 852 0   0   67738 $_ => eval ## no critic
  0 0   0   0  
  0 50       0  
  8 50       235  
  22 0       198  
  0 0       0  
  0 50       0  
  2 0       17  
  0 0          
  0 0          
  0 0          
  0 0          
  0            
108             "sub { return \$_[2] ? \$_[1] $_ \$_[0]->{value} : \$_[0]->{value} $_ \$_[1] }"
109             } qw( - / % ** << >> x <=> cmp & | ^ )
110             ),
111             (
112 426     0   25013 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         529 fallback => 1,
121 71     71   681 );
  71         149  
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.2
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) 2020 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__