File Coverage

blib/lib/Number/Compare/Duration.pm
Criterion Covered Total %
statement 26 26 100.0
branch 2 4 50.0
condition 5 9 55.5
subroutine 7 7 100.0
pod 2 3 66.6
total 42 49 85.7


line stmt bran cond sub pod time code
1 2     2   47623 use strict;
  2         4  
  2         88  
2 2     2   12 use warnings;
  2         5  
  2         105  
3              
4             package Number::Compare::Duration;
5              
6 2     2   12 use base qw(Number::Compare);
  2         9  
  2         2195  
7 2     2   5166 use Carp ();
  2         5  
  2         1173  
8             our $VERSION = '0.001';
9              
10             my %mult = (
11             s => 1,
12             m => 60,
13             h => 60 * 60,
14             d => 60 * 60 * 24,
15             );
16              
17             sub new {
18 1     1 1 16 my $self = shift;
19 1   33     8 my $class = ref($self) || $self;
20 1         6 my $expr = $class->parse_to_perl(shift);
21 1         122 return bless eval
22             "sub { $class->parse_input(\$_[0]) $expr }",
23             $class;
24             }
25              
26             sub parse_to_perl {
27 1     1 1 4 my ($class, $test) = @_;
28              
29 1 50       12 $test =~ m{^
30             ([<>]=?)? # comparison
31             (.*?) # value
32             ([smhd]?)? # magnitude
33             $}x
34             or Carp::croak "don't understand '$test' as a test";
35 1   50     9 my $comp = $1 || '==';
36 1         8 my $target = $2;
37 1   50     12 my $mag = $3 || 's';
38 1         4 $target *= $mult{$mag};
39 1         6 return "$comp $target";
40             }
41              
42             sub parse_input {
43 6     6 0 10 my ($self, $expr) = @_;
44 6 50       42 $expr =~ m{^ (.*?)([smhd]?)? $}x
45             or Carp::croak "don't understand '$expr' as expression";
46 6   100     62 return $1 * $mult{$2 || 's'};
47             }
48              
49             1;
50             __END__