File Coverage

blib/lib/Mango/BSON/Number.pm
Criterion Covered Total %
statement 34 37 91.8
branch 11 12 91.6
condition 22 26 84.6
subroutine 10 12 83.3
pod 5 5 100.0
total 82 92 89.1


line stmt bran cond sub pod time code
1             package Mango::BSON::Number;
2 11     11   34 use Mojo::Base -base;
  11         11  
  11         54  
3 0     0   0 use overload bool => sub { !!shift->value }, '""' => sub { shift->to_string },
  34     34   41  
4 11     11   1467 fallback => 1;
  11         14  
  11         88  
5              
6 11     11   697 use B;
  11         12  
  11         403  
7 11     11   35 use Carp 'croak';
  11         10  
  11         553  
8              
9             # 32bit integer range
10 11     11   42 use constant { INT32_MIN => -(1 << 31) + 1, INT32_MAX => (1 << 31) - 1 };
  11         21  
  11         4011  
11              
12             has [qw(value type)];
13              
14             sub new {
15 17     17 1 23 my ($class, $value, $type) = @_;
16              
17 17   50     33 $value //= 0;
18 17   33     22 $type //= Mango::BSON::DOUBLE();
19              
20 17 50 100     95 if ($type ne Mango::BSON::DOUBLE() &&
      66        
21             $type ne Mango::BSON::INT32() &&
22             $type ne Mango::BSON::INT64())
23             {
24 0         0 croak "Invalid numerical type: '$type'";
25             }
26              
27 17         44 return $class->SUPER::new(value => $value, type => $type);
28             }
29              
30 0     0 1 0 sub TO_JSON { 0 + shift->value }
31              
32 34     34 1 44 sub to_string { '' . shift->value }
33              
34             sub isa_number {
35 47     47 1 34 my $value = shift;
36              
37 47         141 my $flags = B::svref_2object(\$value)->FLAGS;
38              
39 47 100       77 if ($flags & (B::SVp_IOK | B::SVp_NOK)) {
40 26 100 100     158 if ( ( 0 + $value eq $value && $value * 0 == 0)
      100        
      100        
      100        
41             || ( 0 + 'nan' eq $value )
42             || ( 0 + '+inf' eq $value )
43             || ( 0 + '-inf' eq $value ) )
44             {
45 23         43 return $flags;
46             }
47             }
48              
49 24         39 return undef;
50             }
51              
52             sub guess_type {
53 47     47 1 32 my $value = shift;
54              
55 47 100       54 if (my $flags = isa_number($value)) {
56             # Double
57 23 100       53 return Mango::BSON::DOUBLE() if $flags & B::SVp_NOK;
58              
59             # Int32
60 15 100 100     66 return Mango::BSON::INT32() if $value <= INT32_MAX && $value >= INT32_MIN;
61              
62             # Int64
63 2         8 return Mango::BSON::INT64();
64             }
65              
66 24         45 return undef;
67             }
68              
69             1;
70              
71             =encoding utf8
72              
73             =head1 NAME
74              
75             Mango::BSON::Number - Numerical types
76              
77             =head1 SYNOPSIS
78              
79             use Mango::BSON;
80             use Mango::BSON::Number;
81              
82             my $number = Mango::BSON::Number->new(666, Mango::BSON::INT64);
83             say $number;
84              
85             =head1 DESCRIPTION
86              
87             L is a container for numerical values with a strict
88             type.
89              
90             =head1 METHODS
91              
92             L inherits all methods from L and implements
93             the following new ones.
94              
95             =head2 new
96              
97             my $number = Mango::BSON::Number->new(3.14, Mango::BSON::DOUBLE);
98              
99             Construct a new L object. Croak if the value is
100             incompatible with the given type. The 3 supported types are C,
101             C and C.
102              
103             =head2 TO_JSON
104              
105             my $num = $obj->TO_JSON;
106              
107             Return the numerical value.
108              
109             =head2 to_string
110              
111             my $str = $num->to_string;
112              
113             Return the value as a string.
114              
115             =head2 isa_number
116              
117             my $flags = Mango::BSON::Number::isa_number(25);
118              
119             Determine if the given variable is a number by looking at the internal
120             flags of the perl scalar object.
121              
122             Return C if the value is not a number, or a non-null value otherwise.
123             This value contains flags which can be used for finer analysis of the scalar.
124              
125             =head2 guess_type
126              
127             my $mongo_type = Mango::BSON::Number::guess_type(25);
128              
129             Chose which BSON type to use to encode the given numeric value. Possible
130             types are: C, C or
131             C.
132              
133             Return C if the given value is not a number.
134              
135             =head1 OPERATORS
136              
137             L overloads the following operators.
138              
139             =head2 bool
140              
141             my $bool = !!$num;
142              
143             =head2 stringify
144              
145             my $str = "$num";
146              
147             Alias for L.
148              
149             =head1 SEE ALSO
150              
151             L, L, L.
152              
153             =cut