File Coverage

blib/lib/Object/Array/Plugin/ListMoreUtils.pm
Criterion Covered Total %
statement 41 41 100.0
branch 10 10 100.0
condition 10 12 83.3
subroutine 15 15 100.0
pod 1 1 100.0
total 77 79 97.4


line stmt bran cond sub pod time code
1             package Object::Array::Plugin::ListMoreUtils;
2              
3 3     3   9360 use strict;
  3         8  
  3         140  
4 3     3   16 use warnings;
  3         7  
  3         281  
5              
6             our @UTILS;
7             BEGIN {
8 3     3   90 @UTILS = qw(
9             any
10             all
11             none
12             notall
13             true
14             false
15             firstidx first_index
16             lastidx last_index
17             insert_after
18             insert_after_string
19             apply
20             after
21             after_incl
22             before
23             before_incl
24             indexes
25             firstval first_value
26             lastval last_value
27             natatime
28             uniq
29             minmax
30             );
31             }
32              
33 3     3   2933 use List::MoreUtils ();
  3         4931  
  3         65  
34 3     3   19 use Sub::Install ();
  3         5  
  3         102  
35 3         44 use Sub::Exporter -setup => {
36             exports => [ @UTILS, 'contains' ],
37 3     3   14 };
  3         6  
38              
39             my %NEED_REF = (
40             map { $_ => 1 }
41             qw(
42             insert_after
43             insert_after_string
44             ),
45             );
46              
47             =head1 NAME
48              
49             Object::Array::Plugin::ListMoreUtils
50              
51             =head1 DESCRIPTION
52              
53             Add methods to Object::Array corresponding to functions from List::MoreUtils.
54              
55             =head1 METHODS
56              
57             See List::MoreUtils for details of these methods (functions).
58              
59             =head2 any
60              
61             =head2 all
62              
63             =head2 none
64              
65             =head2 notall
66              
67             =head2 true
68              
69             =head2 false
70              
71             =head2 firstidx
72              
73             =head2 first_index
74              
75             =head2 lastidx
76              
77             =head2 last_index
78              
79             =head2 insert_after
80              
81             =head2 insert_after_string
82              
83             =head2 apply
84              
85             =head2 after
86              
87             =head2 after_incl
88              
89             =head2 before
90              
91             =head2 before_incl
92              
93             =head2 indexes
94              
95             =head2 firstval
96              
97             =head2 first_value
98              
99             =head2 lastval
100              
101             =head2 last_value
102              
103             =head2 natatime
104              
105             =head2 uniq
106              
107             =head2 minmax
108              
109             =head1 NEW METHODS
110              
111             =head2 contains
112              
113             if ($arr->contains(1)) { ... }
114              
115             Convenient wrapper around firstidx. Uses C<==> to compare
116             references and numbers, C for everything else.
117              
118             =cut
119              
120             BEGIN {
121 3     3   8 for my $util (@UTILS) {
122             Sub::Install::install_sub({
123             as => $util,
124             code => sub {
125 31     31   393 my $self = shift;
126 3     3   4898 no strict 'refs';
  3         16  
  3         319  
127             # use $self->ref explicitly because List::MoreUtils
128             # segfaults otherwise (at least under 5.6.1) --
129             # probably unfriendliness with overloading
130 31 100       142 &{"List::MoreUtils::$util"}(
  31         264  
131             @_, $NEED_REF{$util} ? $self->ref : $self->elements,
132             );
133             },
134 75         16439 });
135             }
136             }
137              
138             sub _is_number {
139 11     11   19 my $val = shift;
140             # XXX horrible, but catches cases like 5 <=> "5.00"
141 3     3   420 use warnings FATAL => qw(numeric);
  3         6  
  3         974  
142 11         20 eval { $val = 0 + $val };
  11         47  
143 11         81 return $@ !~ /isn't numeric/;
144             }
145              
146             sub contains {
147 6     6 1 18 my ($self, $value) = @_;
148 6         9 my $code;
149 6 100 100     29 if (not defined $value) {
    100          
150 1     5   5 $code = sub { not defined $_ };
  5         14  
151             } elsif (ref($value) || _is_number($value)) {
152 3 100 100 8   12 $code = sub { defined($_) && (ref($_) || _is_number($_)) && $_ == $value };
  8   33     47  
153             } else {
154 2 100 100 9   12 $code = sub { defined($_) && !ref($_) && $_ eq $value };
  9         68  
155             }
156 6         19 return $self->firstidx($code) != -1;
157             }
158              
159             1;