File Coverage

blib/lib/Number/Compare.pm
Criterion Covered Total %
statement 27 27 100.0
branch 13 14 92.8
condition 5 7 71.4
subroutine 6 6 100.0
pod 3 3 100.0
total 54 57 94.7


line stmt bran cond sub pod time code
1             package Number::Compare;
2 1     1   25601 use strict;
  1         3  
  1         42  
3 1     1   6 use Carp qw(croak);
  1         3  
  1         87  
4 1     1   6 use vars qw/$VERSION/;
  1         7  
  1         451  
5             $VERSION = '0.03';
6              
7             sub new {
8 12     12 1 27 my $referent = shift;
9 12   33     48 my $class = ref $referent || $referent;
10 12         27 my $expr = $class->parse_to_perl( shift );
11              
12 12         758 bless eval "sub { \$_[0] $expr }", $class;
13             }
14              
15             sub parse_to_perl {
16 13     13 1 12 shift;
17 13         14 my $test = shift;
18              
19 13 50       77 $test =~ m{^
20             ([<>]=?)? # comparison
21             (.*?) # value
22             ([kmg]i?)? # magnitude
23             $}ix
24             or croak "don't understand '$test' as a test";
25              
26 13   100     46 my $comparison = $1 || '==';
27 13         19 my $target = $2;
28 13   100     39 my $magnitude = $3 || '';
29 13 100       29 $target *= 1000 if lc $magnitude eq 'k';
30 13 100       23 $target *= 1024 if lc $magnitude eq 'ki';
31 13 100       22 $target *= 1000000 if lc $magnitude eq 'm';
32 13 100       25 $target *= 1024*1024 if lc $magnitude eq 'mi';
33 13 100       22 $target *= 1000000000 if lc $magnitude eq 'g';
34 13 100       24 $target *= 1024*1024*1024 if lc $magnitude eq 'gi';
35              
36 13         38 return "$comparison $target";
37             }
38              
39 21     21 1 587 sub test { $_[0]->( $_[1] ) }
40              
41             1;
42              
43             __END__