File Coverage

blib/lib/List/Range.pm
Criterion Covered Total %
statement 45 45 100.0
branch 16 18 88.8
condition n/a
subroutine 12 12 100.0
pod 4 5 80.0
total 77 80 96.2


line stmt bran cond sub pod time code
1             package List::Range;
2 5     5   50514 use 5.008001;
  5         13  
3 5     5   20 use strict;
  5         6  
  5         96  
4 5     5   27 use warnings;
  5         6  
  5         212  
5              
6             our $VERSION = "0.02";
7              
8 5     5   1975 use Class::Accessor::Lite ro => [qw/name lower upper/];
  5         3810  
  5         26  
9 1     1   340 use overload '@{}' => sub { [shift->all] },
10 5     5   3875 fallback => 1;
  5         2786  
  5         34  
11              
12 5     5   264 use Carp qw/croak/;
  5         5  
  5         1461  
13              
14             sub new {
15 28     28 1 2314 my ($class, %args) = @_;
16 28         71 my $self = bless {
17             lower => '-Inf',
18             upper => '+Inf',
19             name => '',
20             %args,
21             } => $class;
22             $self->{lower} <= $self->{upper}
23 28 100       342 or croak "Cannot make a range by $self->{lower}..$self->{upper}";
24 27         66 return $self;
25             }
26              
27             sub includes {
28 32     32 1 29 my $self = shift;
29 32 100       56 if (ref $_[0] eq 'CODE') {
30 6         5 my $code = shift;
31              
32 6         5 my $tmp; # for preformance
33             return grep {
34 6         7 $tmp = $code->($_);
  17         17  
35             $self->{lower} <= $tmp && $tmp <= $self->{upper}
36 17 50       79 } @_;
37             }
38 26 100       25 return grep { $self->{lower} <= $_ && $_ <= $self->{upper} } @_;
  37         176  
39             }
40              
41             sub excludes {
42 12     12 1 12 my $self = shift;
43 12 100       25 if (ref $_[0] eq 'CODE') {
44 6         3 my $code = shift;
45 6         4 my $tmp; # for preformance
46             return grep {
47 6         7 $tmp = $code->($_);
  17         20  
48 17 50       92 $tmp < $self->{lower} || $self->{upper} < $tmp
49             } @_;
50             }
51 6 100       7 return grep { $_ < $self->{lower} || $self->{upper} < $_ } @_;
  17         58  
52             }
53              
54             # for duck typing
55 1     1 0 3 sub ranges { [shift] }
56              
57             sub all {
58 4     4 1 328 my $self = shift;
59 4 100       7 croak 'lower is infinit' if $self->lower == '-Inf';
60 3 100       22 croak 'upper is infinit' if $self->upper == '+Inf';
61 2         11 return ($self->lower..$self->upper);
62             }
63              
64             1;
65             __END__