File Coverage

blib/lib/Number/Tolerant/Type.pm
Criterion Covered Total %
statement 26 27 96.3
branch 7 8 87.5
condition 1 3 33.3
subroutine 10 10 100.0
pod 3 3 100.0
total 47 51 92.1


line stmt bran cond sub pod time code
1 26     26   8448 use strict;
  26         39  
  26         540  
2 26     26   93 use warnings;
  26         34  
  26         729  
3             package Number::Tolerant::Type 1.709;
4             # ABSTRACT: a type of tolerance
5              
6 26     26   96 use parent qw(Number::Tolerant);
  26         33  
  26         127  
7 26     26   22137 use Math::BigFloat;
  26         1051736  
  26         127  
8 26     26   465503 use Math::BigRat;
  26         288457  
  26         124  
9              
10             #pod =head1 SYNOPSIS
11             #pod
12             #pod =cut
13              
14             #pod =head1 METHODS
15             #pod
16             #pod =head2 valid_args
17             #pod
18             #pod my @args = $type_class->valid_args(@_);
19             #pod
20             #pod If the arguments to C are valid arguments for this type of
21             #pod tolerance, this method returns their canonical form, suitable for passing to
22             #pod C>. Otherwise this method returns false.
23             #pod
24             #pod =head2 construct
25             #pod
26             #pod my $object_guts = $type_class->construct(@args);
27             #pod
28             #pod This method is passed the output of the C> method, and should
29             #pod return a hashref that will become the guts of a new tolerance.
30             #pod
31             #pod =head2 parse
32             #pod
33             #pod my $tolerance = $type_class->parse($string);
34             #pod
35             #pod This method returns a new, fully constructed tolerance from the given string
36             #pod if the given string can be parsed into a tolerance of this type.
37             #pod
38             #pod =head2 number_re
39             #pod
40             #pod my $number_re = $type_class->number_re;
41             #pod
42             #pod This method returns the regular expression (as a C construct) used to match
43             #pod number in parsed strings.
44             #pod
45             #pod =head2 normalize_number
46             #pod
47             #pod my $number = $type_class->normalize_number($input);
48             #pod
49             #pod This method will decide whether the given input is a valid number for use with
50             #pod Number::Tolerant and return it in a canonicalized form. Math::BigInt objects
51             #pod are returned intact. Strings holding numbers are also returned intact.
52             #pod Strings that appears to be fractions are converted to Math::BigRat objects.
53             #pod
54             #pod Anything else is considered invalid, and the method will return false.
55             #pod
56             #pod =cut
57              
58             my $number;
59             BEGIN {
60 26     26   26548 $number = qr{
61             (?:
62             (?:[+-]?)
63             (?=[0-9]|\.[0-9])
64             [0-9]*
65             (?:\.[0-9]*)?
66             (?:[Ee](?:[+-]?[0-9]+))?
67             )
68             |
69             (?:
70             [0-9]+ / [1-9][0-9]*
71             )
72             }x;
73             }
74              
75 149     149 1 236 sub number_re { return $number; }
76              
77             sub normalize_number {
78 433     433 1 688 my ($self, $input) = @_;
79              
80 433 100       793 return if not defined $input;
81              
82 367 100       3551 if ($input =~ qr{\A$number\z}) {
83 321 100       1419 return $input =~ m{/} ? Math::BigRat->new($input) : $input;
84             # my $class = $input =~ m{/} ? 'Math::BigRat' : 'Math::BigRat';
85             # return $class->new($input);
86             }
87              
88 46         81 local $@;
89 46 50 33     91 return $input if ref $input and eval { $input->isa('Math::BigInt') };
  0         0  
90              
91 46         158 return;
92             }
93              
94             #pod =head2 variable_re
95             #pod
96             #pod my $variable_re = $type_class->variable_re;
97             #pod
98             #pod This method returns the regular expression (as a C construct) used to match
99             #pod the variable in parsed strings.
100             #pod
101             #pod When parsing "4 <= x <= 10" this regular expression is used to match the letter
102             #pod "x."
103             #pod
104             #pod =cut
105              
106             my $X;
107 26     26   1024 BEGIN { $X = qr/(?:\s*x\s*)/; }
108              
109 97     97 1 149 sub variable_re { return $X; }
110              
111             1;
112              
113             __END__