File Coverage

blib/lib/Data/Quantity/Number/Number.pm
Criterion Covered Total %
statement 49 55 89.0
branch 12 20 60.0
condition 5 8 62.5
subroutine 12 14 85.7
pod 0 8 0.0
total 78 105 74.2


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;