File Coverage

blib/lib/JE/Number.pm
Criterion Covered Total %
statement 68 71 95.7
branch 33 36 91.6
condition 7 8 87.5
subroutine 29 29 100.0
pod 0 17 0.0
total 137 161 85.0


line stmt bran cond sub pod time code
1             package JE::Number;
2              
3             our $VERSION = '0.065';
4              
5 101     101   32252 use strict;
  101         134  
  101         4020  
6 101     101   431 use warnings; no warnings 'utf8';
  101     101   121  
  101         2308  
  101         356  
  101         119  
  101         4609  
7              
8              
9             # I need constants for inf and nan, because perl 5.8.6 interprets the
10             # strings "inf" and "nan" as 0 in numeric context.
11              
12             # This is what I get running Deparse on 5.8.6:
13             # $ perl -mO=Deparse -e 'print 0+"nan"'
14             # print 0;
15             # $ perl -mO=Deparse -e 'print 0+"inf"'
16             # print 0;
17             # And here is the output from 5.8.8 (PPC [big-endian]):
18             # $ perl -mO=Deparse -e 'print 0+"nan"'
19             # print unpack("F", pack("h*", "f78f000000000000"));
20             # $ perl -mO=Deparse -e 'print 0+"inf"'
21             # print 9**9**9;
22             # I don't know about 5.8.7.
23              
24             # However, that 'unpack' does not work on little-endian Xeons running
25             # Linux. What I'm testing it on is running 5.8.5, so the above one-liners
26             # don't work. But I can use this:
27             # $ perl -mO=Deparse -mPOSIX=fmod -e 'use constant nan=>fmod 0,0;print nan'
28             # use POSIX (split(/,/, 'fmod', 0));
29             # use constant ('nan', fmod(0, 0));
30             # print sin(9**9**9);
31              
32             # sin 9**9**9 also works on the PPC.
33              
34              
35              
36 101     101   412 use constant nan => sin 9**9**9;
  101         145  
  101         7166  
37 101     101   456 use constant inf => 9**9**9;
  101         130  
  101         13167  
38              
39             use overload fallback => 1,
40             '""' => sub {
41 37945     37945   87454 my $value = $_[0][0];
42 37945 100       235426 $value == inf ? 'Infinity' :
    50          
    100          
43             $value == -+inf ? '-Infinity' :
44             $value == $value ? $value :
45             'NaN'
46             },
47             '0+' => 'value',
48             bool => sub {
49 3333     3333   88362 my $value = $_[0][0];
50 3333 100       29397 $value && $value == $value;
51             },
52 2906     2906   6364 '+' => sub { $_[0]->value + $_[1] }, # ~~~ I shouldn’t need this,
53             # but perl’s magic
54             # auto-generation
55             # isn’t so magic.
56             # cmp => sub { "$_[0]" cmp $_[1] };
57 101     101   481 ;
  101         1783  
  101         1803  
58              
59 101     101   9533 use Scalar::Util qw 'blessed tainted';
  101         140  
  101         61594  
60              
61             require JE::String;
62             require JE::Boolean;
63             require JE::Object::Number;
64              
65              
66              
67             # Each JE::Number object is an array ref like this: [value, global object]
68              
69             sub new {
70 56617     56617 0 85962 my ($class,$global,$val) = @_;
71            
72 56617 100 66     155435 if(defined blessed $val and can $val 'to_number') {
73 49         71 my $new_val = $val->to_number;
74 49 100       204 ref $new_val eq $class and return $new_val;
75 1 50       1 eval { $new_val->isa(__PACKAGE__) } and
  1         58  
76             $val = $new_val->[0],
77             goto RETURN;
78             }
79              
80 56568         76921 $val = _numify($val);
81              
82 56569         250843 RETURN:
83             bless [$val, $global], $class;
84             }
85              
86             sub _numify {
87 56579   100 56579   115531 my $val = shift||0;
88             # For perls that don't interpret 0+"inf" as inf:
89 56579 100       142935 if ($val =~ /^\s*([+-]?)(inf|nan)/i) {
90 2842 100       10024 $val = lc $2 eq 'nan' ? nan :
    100          
91             $1 eq '-' ? -(inf) : inf;
92             }
93 53737         82511 else { $val+=0 }
94 56579         79737 $val;
95             }
96              
97             sub prop {
98 49 100   49 0 911 if(@_ > 2) { return $_[2] } # If there is a value, just return it
  1         3  
99              
100 48         65 my ($self, $name) = @_;
101            
102 48         127 $$self[1]->prototype_for('Number')->prop($name);
103             }
104              
105             sub keys {
106 2     2 0 299 my $self = shift;
107 2         7 $$self[1]->prototype_for('Number')->keys;
108             }
109              
110 1     1 0 3 sub delete {1}
111              
112             sub method {
113 2     2 0 4 my $self = shift;
114 2         9 $$self[1]->prototype_for('Number')->prop(shift)->apply(
115             $self,$$self[1]->upgrade(@_)
116             );
117             }
118              
119             sub value {
120 42800     42800 0 85556 shift->[0]
121             }
122             *TO_JSON=*value;
123              
124 1     1 0 1207 sub exists { !1 }
125              
126 13834     13834 0 47318 sub typeof { 'number' }
127 67     67 0 220 sub class { 'Number' }
128             sub id {
129 21038     21038 0 32898 my $value = shift->value;
130             # This should (I hope) take care of systems that stringify nan and
131             # inf oddly:
132 21038 100       110413 'num:' . ($value != $value ? 'nan' :
    100          
    100          
133             $value == inf ? 'inf' :
134             $value == -+inf ? '-inf' :
135             $value)
136             }
137 361     361 0 1142 sub primitive { 1 }
138              
139 52433     52433 0 112146 sub to_primitive { $_[0] }
140             sub to_boolean {
141 318     318 0 779 my $value = (my $self = shift)->[0];
142 318   100     1585 JE::Boolean->new($$self[1],
143             $value && $value == $value);
144             }
145              
146             sub to_string { # ~~~ I need to find out whether Perl's number
147             # stringification is consistent with E 9.8.1 for
148             # finite numbers.
149 13180     13180 0 19251 my $value = (my $self = shift)->[0];
150 13180 100       58013 JE::String->_new($$self[1],
    100          
    100          
151             $value == inf ? 'Infinity' :
152             $value == -(inf) ? '-Infinity' :
153             $value == $value ? $value :
154             'NaN'
155             );
156             }
157              
158             *to_number = \& to_primitive;
159              
160             sub to_object {
161 14     14 0 23 my $self = shift;
162 14         75 JE::Object::Number->new($$self[1], $self);
163             }
164              
165 2     2 0 299 sub global { $_[0][1] }
166              
167             sub taint {
168 31     31 0 50 my $self = shift;
169 31 50       174 tainted $self->[0] and return $self;
170 0           my $alter_ego = [@$self];
171 101     101   543 no warnings 'numeric';
  101         134  
  101         7202  
172 0           $alter_ego->[0] += shift();
173 0           return bless $alter_ego, ref $self;
174             }
175              
176              
177             =head1 NAME
178              
179             JE::Number - JavaScript number value
180              
181             =head1 SYNOPSIS
182              
183             use JE;
184             use JE::Number;
185              
186             $j = JE->new;
187              
188             $js_num = new JE::Number $j, 17;
189              
190             $perl_num = $js_num->value;
191              
192             $js_num->to_object; # returns a new JE::Object::Number
193              
194             =head1 DESCRIPTION
195              
196             This class implements JavaScript number values for JE. The difference
197             between this and JE::Object::Number is that that module implements
198             number
199             I while this module implements the I values.
200              
201             Right now, this module simply uses Perl numbers underneath for storing
202             the JavaScript numbers. It seems that whether Perl numbers are in accord with the IEEE 754 standard that
203             ECMAScript uses is system-dependent. If anyone requires IEEE 754
204             compliancy,
205             a patch would be welcome. :-)
206              
207             The C method accepts a global (JE) object and a number as its
208             two arguments. If the latter is an object with a C method whose
209             return value isa JE::Number, that object's internal value
210             will be used. Otherwise the arg itself is used. (The precise details of
211             the behaviour of C when the second arg is a object are subject to
212             change.) It is numified Perl-style,
213             so 'nancy' becomes NaN
214             and 'information' becomes Infinity.
215              
216             The C method produces a Perl scalar. The C<0+> numeric operator is
217             overloaded and produces the same.
218              
219             Stringification and boolification are overloaded and produce the same
220             results as in JavaScript
221              
222             The C and C methods produce the strings 'number' and
223             'Number', respectively.
224              
225             =head1 SEE ALSO
226              
227             =over 4
228              
229             =item L
230              
231             =item L
232              
233             =item L
234              
235             =back
236              
237             =cut
238              
239              
240              
241