File Coverage

blib/lib/Data/Types.pm
Criterion Covered Total %
statement 50 50 100.0
branch 47 48 97.9
condition 27 28 96.4
subroutine 15 15 100.0
pod 12 12 100.0
total 151 153 98.6


line stmt bran cond sub pod time code
1             package Data::Types;
2              
3 1     1   6253 use strict;
  1         2  
  1         39  
4             require Exporter;
5 1     1   5 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  1         2  
  1         185  
6              
7             $VERSION = '0.17';
8              
9             @ISA = qw(Exporter);
10              
11             @EXPORT_OK = qw(is_whole to_whole is_count to_count is_int to_int is_real
12             to_real is_decimal to_decimal is_float to_float is_string
13             to_string );
14              
15             @EXPORT = qw();
16              
17             %EXPORT_TAGS = (
18             all => \@EXPORT_OK,
19             whole => [qw(is_whole to_whole)],
20             count => [qw(is_count to_count)],
21             int => [qw(is_int to_int)],
22             decimal => [qw(is_decimal to_decimal)],
23             real => [qw(is_real to_real)],
24             float => [qw(is_float to_float)],
25             string => [qw(is_string to_string)],
26             is => [qw(is_whole is_int is_real is_decimal is_float is_string)],
27             to => [qw(to_whole to_int to_real to_decimal to_float to_string)],
28             );
29              
30 1     1   8 use constant DEF_PRECISION => 5;
  1         1  
  1         1263  
31              
32             ################################################################################
33             # FUNCTIONS #
34             ################################################################################
35              
36             sub is_whole ($) {
37 8 50   8 1 145 return unless defined $_[0];
38 8 100       51 return unless $_[0] =~ /^[0-9]+$/;
39 5         17 return 1;
40             }
41              
42             sub to_whole ($) {
43 16 100   16 1 42 return unless defined $_[0];
44 15         92 my ($num) = $_[0] =~ /([+-]?(?:[0-9]+(?:\.[0-9]*)?|\.[0-9]+))/;
45 15 100 100     84 return unless defined $num && $num >= 0;
46 9         57 sprintf "%.0f", $num;
47             }
48              
49             sub is_count ($) {
50 8 100   8 1 21 return unless $_[0];
51 7 100       44 return unless $_[0] =~ /^[0-9]+$/;
52 4         13 return 1;
53             }
54              
55             sub to_count ($) {
56 16 100   16 1 45 return unless $_[0];
57 13         77 my ($num) = $_[0] =~ /([+-]?(?:[0-9]+(?:\.[0-9]*)?|\.[0-9]+))/;
58 13 100 100     97 return unless $num && $num > .5;
59 6         32 sprintf "%.0f", $num;
60             }
61              
62             sub is_int ($) {
63 13 100 100 13 1 71 return unless defined $_[0] && $_[0] ne '';
64 11 100       61 return unless $_[0] =~ /^[+-]?[0-9]+$/;
65 4         14 return 1;
66             }
67              
68             sub to_int ($) {
69 13 100 100 13 1 79 return unless defined $_[0] && $_[0] ne '';
70 11         61 my ($num) = $_[0] =~ /([+-]?(?:[0-9]+(?:\.[0-9]*)?|\.[0-9]+))/;
71 11 100       28 return unless defined $num;
72 10         59 sprintf "%.0f", $num;
73             }
74              
75             sub is_decimal ($) {
76 28 100 66 28 1 150 return unless defined $_[0] && $_[0] ne '';
77 26 100       163 return unless $_[0] =~ /^[+-]?(?:[0-9]+(?:\.[0-9]*)?|\.[0-9]+)$/;
78 15         56 return 1;
79             }
80              
81             sub to_decimal ($;$) {
82 28 100 100 28 1 153 return unless defined $_[0] && $_[0] ne '';
83 24         125 my ($num) = $_[0] =~ /([+-]?(?:[0-9]+(?:\.[0-9]*)?|\.[0-9]+))/;
84 24 100       54 return unless defined $num;
85 22   100     71 $_[1] ||= DEF_PRECISION;
86 22         233 sprintf "%.$_[1]f", $num;
87             }
88              
89             #sub is_real ($) {
90             # return unless defined $_[0] && $_[0] ne '';
91             # return unless $_[0] =~ /^[+-]?\d*\.?\d*$/;
92             # return 1;
93             #}
94              
95             #sub to_real ($) {
96             # return unless defined $_[0] && $_[0] ne '';
97             # sprintf "%f", $_[0] =~ /([+-]?\d*\.?\d*)/;
98             #}
99              
100             # These may need to be separated in the future, in order to identify non-decimal
101             # real numbers.
102             *is_real = *is_decimal;
103             *to_real = *to_decimal;
104              
105             sub is_float ($) {
106 13 100 100 13 1 81 return unless defined $_[0] && $_[0] ne '';
107 11 100       80 return unless $_[0] =~ /^([+-]?)(?=[0-9]|\.[0-9])[0-9]*(\.[0-9]*)?([Ee]([+-]?[0-9]+))?$/;
108 7         22 return 1;
109             }
110              
111             sub to_float ($;$) {
112 13 100 100 13 1 89 return unless defined $_[0] && $_[0] ne '';
113 11         71 my ($num) = $_[0] =~ /(([+-]?)(?=[0-9]|\.[0-9])[0-9]*(\.[0-9]*)?([Ee]([+-]?[0-9]+))?)/;
114 11 100       28 return unless defined $num;
115 10 100       65 my $type = $num =~ /e|E/ ? 'e' : 'f';
116 10   100     37 $_[1] ||= DEF_PRECISION;
117 10         113 sprintf "%.$_[1]$type", $num;
118             # sprintf "%g", $_[0] =~ /(([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?)/;
119             }
120              
121 5 100   5 1 29 sub is_string ($) { defined $_[0] && ! ref $_[0] }
122              
123             sub to_string ($;$) {
124 7 100   7 1 23 return unless defined $_[0];
125 6 100       36 return $_[1] ? substr("$_[0]", 0, $_[1]) : "$_[0]";
126             }
127              
128             1;
129             __END__