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   14857 use strict;
  26         80  
  26         752  
2 26     26   136 use warnings;
  26         50  
  26         2379  
3             package Number::Tolerant::Type;
4             # ABSTRACT: a type of tolerance
5             $Number::Tolerant::Type::VERSION = '1.708';
6 26     26   1007 use parent qw(Number::Tolerant);
  26         413  
  26         171  
7 26     26   43636 use Math::BigFloat;
  26         577048  
  26         147  
8 26     26   1121497 use Math::BigRat;
  26         324873  
  26         157  
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   35492 $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 179     179 1 458 sub number_re { return $number; }
76              
77             sub normalize_number {
78 372     372 1 668 my ($self, $input) = @_;
79              
80 372 100       1191 return if not defined $input;
81              
82 323 100       4716 if ($input =~ qr{\A$number\z}) {
83 272 100       1850 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 51         126 local $@;
89 51 50 33     183 return $input if ref $input and eval { $input->isa('Math::BigInt') };
  0         0  
90              
91 51         325 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   1113 BEGIN { $X = qr/(?:\s*x\s*)/; }
108              
109 109     109 1 257 sub variable_re { return $X; }
110              
111             1;
112              
113             __END__