Revision 61352a49
Von Moritz Bunkus vor fast 14 Jahren hinzugefügt
| modules/fallback/List/MoreUtils.pm | ||
|---|---|---|
| 5 | 5 |
|
| 6 | 6 |
require Exporter; |
| 7 | 7 |
require DynaLoader; |
| 8 |
|
|
| 9 |
|
|
| 8 | 10 |
use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS); |
| 9 | 11 |
@ISA = qw(Exporter DynaLoader); |
| 10 | 12 |
|
| ... | ... | |
| 12 | 14 |
all => [ qw(any all none notall true false firstidx first_index lastidx |
| 13 | 15 |
last_index insert_after insert_after_string apply after after_incl before |
| 14 | 16 |
before_incl indexes firstval first_value lastval last_value each_array |
| 15 |
each_arrayref pairwise natatime mesh zip uniq minmax part) ], |
|
| 17 |
each_arrayref pairwise natatime mesh zip uniq minmax part bsearch) ],
|
|
| 16 | 18 |
); |
| 17 | 19 |
|
| 18 | 20 |
@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
|
| 19 | 21 |
|
| 20 |
$VERSION = '0.22'; |
|
| 22 |
$VERSION = '0.25_02';
|
|
| 21 | 23 |
|
| 22 | 24 |
eval {
|
| 23 | 25 |
local $ENV{PERL_DL_NONLAZY} = 0 if $ENV{PERL_DL_NONLAZY};
|
| ... | ... | |
| 27 | 29 |
|
| 28 | 30 |
eval <<'EOP' if not defined &any; |
| 29 | 31 |
|
| 32 |
require POSIX; |
|
| 33 |
|
|
| 30 | 34 |
sub any (&@) {
|
| 31 | 35 |
my $f = shift; |
| 32 | 36 |
return if ! @_; |
| ... | ... | |
| 47 | 51 |
|
| 48 | 52 |
sub none (&@) {
|
| 49 | 53 |
my $f = shift; |
| 50 |
return if ! @_; |
|
| 54 |
return 1 if ! @_;
|
|
| 51 | 55 |
for (@_) {
|
| 52 | 56 |
return 0 if $f->(); |
| 53 | 57 |
} |
| ... | ... | |
| 280 | 284 |
|
| 281 | 285 |
sub uniq (@) {
|
| 282 | 286 |
my %h; |
| 283 |
map { $h{$_}++ == 0 ? $_ : () } @_;
|
|
| 287 |
my $ref = \1; |
|
| 288 |
map { $h{defined $_ ? $_ : $ref}++ == 0 ? $_ : () } @_;
|
|
| 284 | 289 |
} |
| 285 | 290 |
|
| 286 | 291 |
sub minmax (@) {
|
| ... | ... | |
| 318 | 323 |
return @parts; |
| 319 | 324 |
} |
| 320 | 325 |
|
| 326 |
sub bsearch(&@) {
|
|
| 327 |
my $code = shift; |
|
| 328 |
|
|
| 329 |
my $rc; |
|
| 330 |
my $i = 0; |
|
| 331 |
my $j = @_; |
|
| 332 |
do {
|
|
| 333 |
my $k = int(($i + $j) / 2); |
|
| 334 |
|
|
| 335 |
return if $k >= @_; |
|
| 336 |
|
|
| 337 |
local *_ = \$_[$k]; |
|
| 338 |
$rc = $code->(); |
|
| 339 |
|
|
| 340 |
$rc == 0 and |
|
| 341 |
return wantarray ? $_ : 1; |
|
| 342 |
|
|
| 343 |
if ($rc < 0) {
|
|
| 344 |
$i = $k + 1; |
|
| 345 |
} else {
|
|
| 346 |
$j = $k - 1; |
|
| 347 |
} |
|
| 348 |
} until $i > $j; |
|
| 349 |
|
|
| 350 |
return; |
|
| 351 |
} |
|
| 352 |
|
|
| 321 | 353 |
sub _XScompiled {
|
| 322 | 354 |
return 0; |
| 323 | 355 |
} |
| 324 | 356 |
|
| 325 | 357 |
EOP |
| 358 |
die $@ if $@; |
|
| 326 | 359 |
|
| 327 | 360 |
*first_index = \&firstidx; |
| 328 | 361 |
*last_index = \&lastidx; |
| ... | ... | |
| 663 | 696 |
my $i = 0; |
| 664 | 697 |
my @part = part { $idx[$++ % 3] } 1 .. 8; # [1, 4, 7], [2, 3, 5, 6, 8]
|
| 665 | 698 |
|
| 699 |
=item bsearch BLOCK LIST |
|
| 700 |
|
|
| 701 |
Performs a binary search on LIST which must be a sorted list of values. BLOCK |
|
| 702 |
must return a negative value if the current element (stored in C<$_>) is smaller, |
|
| 703 |
a positive value if it is bigger and zero if it matches. |
|
| 704 |
|
|
| 705 |
Returns a boolean value in scalar context. In list context, it returns the element |
|
| 706 |
if it was found, otherwise the empty list. |
|
| 707 |
|
|
| 666 | 708 |
=back |
| 667 | 709 |
|
| 668 | 710 |
=head1 EXPORTS |
| ... | ... | |
| 685 | 727 |
|
| 686 | 728 |
=head1 VERSION |
| 687 | 729 |
|
| 688 |
This is version 0.22.
|
|
| 730 |
This is version 0.25_01.
|
|
| 689 | 731 |
|
| 690 | 732 |
=head1 BUGS |
| 691 | 733 |
|
| ... | ... | |
| 785 | 827 |
|
| 786 | 828 |
=head1 AUTHOR |
| 787 | 829 |
|
| 788 |
Tassilo von Parseval, E<lt>tassilo.von.parseval@rwth-aachen.deE<gt>
|
|
| 830 |
Tassilo von Parseval, E<lt>vparseval@gmail.comE<gt>
|
|
| 789 | 831 |
|
| 790 | 832 |
=head1 COPYRIGHT AND LICENSE |
| 791 | 833 |
|
| 792 |
Copyright (C) 2004-2006 by Tassilo von Parseval
|
|
| 834 |
Copyright (C) 2004-2009 by Tassilo von Parseval
|
|
| 793 | 835 |
|
| 794 | 836 |
This library is free software; you can redistribute it and/or modify |
| 795 | 837 |
it under the same terms as Perl itself, either Perl version 5.8.4 or, |
Auch abrufbar als: Unified diff
Aktualisierung mitgelieferte List::MoreUtils von 0.22 auf 0.25_02