line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
### Data::Quantity::Number::Number; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
### Change History |
4
|
|
|
|
|
|
|
# 2000-12-01 Fixed "use of undefined value" in numeric_value |
5
|
|
|
|
|
|
|
# 1999-08-02 Stripped and corrected separators in numeric_value(). |
6
|
|
|
|
|
|
|
# 1998-12-02 Created. -Simon |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
package Data::Quantity::Number::Number; |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
require 5; |
11
|
6
|
|
|
6
|
|
7530
|
use strict; |
|
6
|
|
|
|
|
12
|
|
|
6
|
|
|
|
|
196
|
|
12
|
6
|
|
|
6
|
|
39
|
use Carp; |
|
6
|
|
|
|
|
9
|
|
|
6
|
|
|
|
|
423
|
|
13
|
|
|
|
|
|
|
|
14
|
6
|
|
|
6
|
|
30
|
use vars qw( $VERSION ); |
|
6
|
|
|
|
|
16
|
|
|
6
|
|
|
|
|
305
|
|
15
|
|
|
|
|
|
|
$VERSION = 0.001; |
16
|
|
|
|
|
|
|
|
17
|
6
|
|
|
6
|
|
4273
|
use Data::Quantity::Abstract::Base '-isasubclass'; |
|
6
|
|
|
|
|
14
|
|
|
6
|
|
|
|
|
39
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# $clone_q = $quantity->new_instance(); |
20
|
|
|
|
|
|
|
# $empty_q = Data::Quantity::Number::Number->new_instance(); |
21
|
|
|
|
|
|
|
sub new_instance { |
22
|
53
|
|
|
53
|
0
|
75
|
my $referent = shift; |
23
|
53
|
|
66
|
|
|
164
|
my $class = ref($referent) || $referent; |
24
|
53
|
100
|
|
|
|
107
|
my $num = ( ref($referent) ? $$referent : undef ); |
25
|
53
|
|
|
|
|
72
|
my $num_q = \$num; |
26
|
53
|
|
|
|
|
277
|
bless $num_q, $class; |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# $quantity->init( $n_val ); |
30
|
|
|
|
|
|
|
sub init { |
31
|
36
|
|
|
36
|
0
|
45
|
my $num_q = shift; |
32
|
|
|
|
|
|
|
|
33
|
36
|
|
|
|
|
40
|
my $n_val = shift; |
34
|
36
|
|
|
|
|
131
|
my $numerals = $num_q->numeric_value( $n_val ); |
35
|
36
|
50
|
|
|
|
77
|
if ( defined $numerals ) { |
36
|
36
|
|
|
|
|
113
|
$num_q->value( $numerals ); |
37
|
|
|
|
|
|
|
} else { |
38
|
0
|
|
|
|
|
0
|
$num_q->not_a_number( $n_val ); |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# $n_val = $quantity->value; |
43
|
|
|
|
|
|
|
# $quantity->value( $n_val ); |
44
|
|
|
|
|
|
|
sub value { |
45
|
120
|
|
|
120
|
0
|
164
|
my $num_q = shift; |
46
|
120
|
50
|
|
|
|
235
|
croak "object method" if ! ref $num_q; |
47
|
|
|
|
|
|
|
|
48
|
120
|
100
|
|
|
|
483
|
return $$num_q if ( ! scalar @_ ); |
49
|
|
|
|
|
|
|
|
50
|
49
|
|
|
|
|
54
|
my $n_val = shift; |
51
|
|
|
|
|
|
|
# if ( ! defined $n_val || length($n_val) < 1 ) { |
52
|
|
|
|
|
|
|
# $$num_q = undef; |
53
|
|
|
|
|
|
|
# return; |
54
|
|
|
|
|
|
|
# } |
55
|
|
|
|
|
|
|
|
56
|
49
|
|
|
|
|
211
|
$$num_q = $n_val; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# $quantity->not_a_number; |
60
|
|
|
|
|
|
|
# $quantity->not_a_number( $value ); |
61
|
|
|
|
|
|
|
sub not_a_number { |
62
|
0
|
|
|
0
|
0
|
0
|
my $num_q = shift; |
63
|
0
|
0
|
|
|
|
0
|
if ( scalar @_ ) { $$num_q = shift; } |
|
0
|
|
|
|
|
0
|
|
64
|
0
|
|
|
|
|
0
|
bless $num_q, 'Data::Quantity::Number::NAN'; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
# $string = $quantity->readable( @_ ); |
68
|
|
|
|
|
|
|
sub readable { |
69
|
29
|
|
|
29
|
0
|
36
|
my $num_q = shift; |
70
|
29
|
50
|
|
|
|
71
|
croak "object method" if ! ref $num_q; |
71
|
29
|
|
|
|
|
56
|
$num_q->readable_value( $num_q->value(), @_ ); |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
# undef = Data::Quantity::Number::Number->scale(); |
75
|
|
|
|
|
|
|
sub scale { |
76
|
0
|
|
|
0
|
0
|
0
|
return undef; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
6
|
|
|
6
|
|
55
|
use vars qw( $ThousandsSeparator $DecimalSeparator $DefaultPlaces ); |
|
6
|
|
|
|
|
10
|
|
|
6
|
|
|
|
|
3198
|
|
80
|
|
|
|
|
|
|
$ThousandsSeparator = ','; |
81
|
|
|
|
|
|
|
$DecimalSeparator = '.'; |
82
|
|
|
|
|
|
|
$DefaultPlaces = undef; |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
# $n_val = Data::Quantity::Number::Number->numeric_value( $candidate_n_val ); |
85
|
|
|
|
|
|
|
sub numeric_value { |
86
|
39
|
|
|
39
|
0
|
46
|
my $class_or_item = shift; |
87
|
39
|
|
|
|
|
52
|
my $n_val = shift; |
88
|
39
|
50
|
|
|
|
709
|
$n_val =~ /\A |
89
|
|
|
|
|
|
|
\-? |
90
|
|
|
|
|
|
|
(?: \d | \Q$ThousandsSeparator\E \d{3} )* |
91
|
|
|
|
|
|
|
(?: \Q$DecimalSeparator\E \d+ )? |
92
|
|
|
|
|
|
|
(?: [eE] \-? \d+ )? |
93
|
|
|
|
|
|
|
\Z/x |
94
|
|
|
|
|
|
|
or return undef; |
95
|
39
|
|
|
|
|
135
|
$n_val =~ s/\Q$ThousandsSeparator\E//g; |
96
|
39
|
50
|
|
|
|
90
|
$n_val =~ s/\Q$DecimalSeparator\E/\./g unless ( $DecimalSeparator eq '.' ); |
97
|
39
|
|
|
|
|
92
|
$n_val; |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
# $string = $quantity->readable_value($n_val); |
101
|
|
|
|
|
|
|
# $string = $quantity->readable_value($n_val, $places); |
102
|
|
|
|
|
|
|
# $string = Data::Quantity::Number::Number->readable_value($n_val); |
103
|
|
|
|
|
|
|
# $string = Data::Quantity::Number::Number->readable_value($n_val, $places); |
104
|
|
|
|
|
|
|
sub readable_value { |
105
|
3
|
|
|
3
|
0
|
4
|
my $class_or_item = shift; |
106
|
3
|
|
|
|
|
5
|
my $n_val = shift; |
107
|
3
|
|
50
|
|
|
16
|
my $places = shift || $DefaultPlaces || undef; |
108
|
|
|
|
|
|
|
|
109
|
3
|
|
|
|
|
30
|
my ($int, $dec) = split(/\./, $n_val, 2); |
110
|
|
|
|
|
|
|
|
111
|
3
|
|
|
|
|
19
|
$int = reverse join($ThousandsSeparator, reverse($int) =~ m/(\d{1,3})/g); |
112
|
3
|
50
|
|
|
|
8
|
$dec = substr($dec, 0, $places) . ( '0' x ( $places - length($dec) ) ) |
113
|
|
|
|
|
|
|
if ( defined $places ); |
114
|
|
|
|
|
|
|
|
115
|
3
|
100
|
66
|
|
|
27
|
return $int . |
116
|
|
|
|
|
|
|
( ( defined($dec) and length($dec) ) ? $DecimalSeparator . $dec : '' ); |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
package Data::Quantity::Number::NAN; |
120
|
|
|
|
|
|
|
|
121
|
6
|
|
|
6
|
|
37
|
use vars qw( @ISA ); |
|
6
|
|
|
|
|
15
|
|
|
6
|
|
|
|
|
348
|
|
122
|
|
|
|
|
|
|
push @ISA, 'Data::Quantity::Number::Number'; |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
1; |