1package Object::Array::Plugin::ListMoreUtils; 2 3use strict; 4use warnings; 5 6our @UTILS; 7BEGIN { 8 @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 33use List::MoreUtils (); 34use Sub::Install (); 35use Sub::Exporter -setup => { 36 exports => [ @UTILS, 'contains' ], 37}; 38 39my %NEED_REF = ( 40 map { $_ => 1 } 41 qw( 42 insert_after 43 insert_after_string 44 ), 45); 46 47=head1 NAME 48 49Object::Array::Plugin::ListMoreUtils 50 51=head1 DESCRIPTION 52 53Add methods to Object::Array corresponding to functions from List::MoreUtils. 54 55=head1 METHODS 56 57See 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 115Convenient wrapper around firstidx. Uses C<==> to compare 116references and numbers, C<eq> for everything else. 117 118=cut 119 120BEGIN { 121 for my $util (@UTILS) { 122 Sub::Install::install_sub({ 123 as => $util, 124 code => sub { 125 my $self = shift; 126 no strict 'refs'; 127 # use $self->ref explicitly because List::MoreUtils 128 # segfaults otherwise (at least under 5.6.1) -- 129 # probably unfriendliness with overloading 130 &{"List::MoreUtils::$util"}( 131 @_, $NEED_REF{$util} ? $self->ref : $self->elements, 132 ); 133 }, 134 }); 135 } 136} 137 138sub _is_number { 139 my $val = shift; 140 # XXX horrible, but catches cases like 5 <=> "5.00" 141 use warnings FATAL => qw(numeric); 142 eval { $val = 0 + $val }; 143 return $@ !~ /isn't numeric/; 144} 145 146sub contains { 147 my ($self, $value) = @_; 148 my $code; 149 if (not defined $value) { 150 $code = sub { not defined $_ }; 151 } elsif (ref($value) || _is_number($value)) { 152 $code = sub { defined($_) && (ref($_) || _is_number($_)) && $_ == $value }; 153 } else { 154 $code = sub { defined($_) && !ref($_) && $_ eq $value }; 155 } 156 return $self->firstidx($code) != -1; 157} 158 1591; 160