modules/fallback/List/MoreUtils.pm

   1 package List::MoreUtils;
   2
   3 use 5.00503;
   4 use strict;
   5
   6 require Exporter;
   7 require DynaLoader;
   8
   9
  10 use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
  11 @ISA = qw(Exporter DynaLoader);
  12
  13 %EXPORT_TAGS = (
  14     all => [ qw(any all none notall true false firstidx first_index lastidx
  15                 last_index insert_after insert_after_string apply after after_incl before
  16                 before_incl indexes firstval first_value lastval last_value each_array
  17                 each_arrayref pairwise natatime mesh zip uniq minmax part bsearch) ],
  18 );
  19
  20 @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
  21
  22 $VERSION = '0.25_02';
  23
  24 eval {
  25     local $ENV{PERL_DL_NONLAZY} = 0 if $ENV{PERL_DL_NONLAZY};
  26     bootstrap List::MoreUtils $VERSION;
  27     1;
  28 } if not $ENV{LIST_MOREUTILS_PP};
  29
  30 eval <<'EOP' if not defined &any;
  31
  32 require POSIX;
  33
  34 sub any (&@) {
  35     my $f = shift;
  36     return if ! @_;
  37     for (@_) {
  38         return 1 if $f->();
  39     }
  40     return 0;
  41 }
  42
  43 sub all (&@) {
  44     my $f = shift;
  45     return if ! @_;
  46     for (@_) {
  47         return 0 if ! $f->();
  48     }
  49     return 1;
  50 }
  51
  52 sub none (&@) {
  53     my $f = shift;
  54     return 1 if ! @_;
  55     for (@_) {
  56         return 0 if $f->();
  57     }
  58     return 1;
  59 }
  60
  61 sub notall (&@) {
  62     my $f = shift;
  63     return if ! @_;
  64     for (@_) {
  65         return 1 if ! $f->();
  66     }
  67     return 0;
  68 }
  69
  70 sub true (&@) {
  71     my $f = shift;
  72     my $count = 0;
  73     for (@_) {
  74         $count++ if $f->();
  75     }
  76     return $count;
  77 }
  78
  79 sub false (&@) {
  80     my $f = shift;
  81     my $count = 0;
  82     for (@_) {
  83         $count++ if ! $f->();
  84     }
  85     return $count;
  86 }
  87
  88 sub firstidx (&@) {
  89     my $f = shift;
  90     for my $i (0 .. $#_) {
  91         local *_ = \$_[$i];
  92         return $i if $f->();
  93     }
  94     return -1;
  95 }
  96
  97 sub lastidx (&@) {
  98     my $f = shift;
  99     for my $i (reverse 0 .. $#_) {
 100         local *_ = \$_[$i];
 101         return $i if $f->();
 102     }
 103     return -1;
 104 }
 105
 106 sub insert_after (&$\@) {
 107     my ($code, $val, $list) = @_;
 108     my $c = -1;
 109     local *_;
 110     for my $i (0 .. $#$list) {
 111         $_ = $list->[$i];
 112         $c = $i, last if $code->();
 113     }
 114     @$list = (@{$list}[0..$c], $val, @{$list}[$c+1..$#$list]) and return 1 if $c != -1;
 115     return 0;
 116 }
 117
 118 sub insert_after_string ($$\@) {
 119     my ($string, $val, $list) = @_;
 120     my $c = -1;
 121     for my $i (0 .. $#$list) {
 122         local $^W = 0;
 123         $c = $i, last if $string eq $list->[$i];
 124     }
 125     @$list = (@{$list}[0..$c], $val, @{$list}[$c+1..$#$list]) and return 1 if $c != -1;
 126     return 0;
 127 }
 128
 129 sub apply (&@) {
 130     my $action = shift;
 131     &$action for my @values = @_;
 132     wantarray ? @values : $values[-1];
 133 }
 134
 135 sub after (&@)
 136 {
 137     my $test = shift;
 138     my $started;
 139     my $lag;
 140     grep $started ||= do { my $x=$lag; $lag=$test->(); $x},  @_;
 141 }
 142
 143 sub after_incl (&@)
 144 {
 145     my $test = shift;
 146     my $started;
 147     grep $started ||= $test->(), @_;
 148 }
 149
 150 sub before (&@)
 151 {
 152     my $test = shift;
 153     my $keepgoing=1;
 154     grep $keepgoing &&= !$test->(),  @_;
 155 }
 156
 157 sub before_incl (&@)
 158 {
 159     my $test = shift;
 160     my $keepgoing=1;
 161     my $lag=1;
 162     grep $keepgoing &&= do { my $x=$lag; $lag=!$test->(); $x},  @_;
 163 }
 164
 165 sub indexes (&@)
 166 {
 167     my $test = shift;
 168     grep {local *_=\$_[$_]; $test->()} 0..$#_;
 169 }
 170
 171 sub lastval (&@)
 172 {
 173     my $test = shift;
 174     my $ix;
 175     for ($ix=$#_; $ix>=0; $ix--)
 176     {
 177         local *_ = \$_[$ix];
 178         my $testval = $test->();
 179         $_[$ix] = $_;    # simulate $_ as alias
 180         return $_ if $testval;
 181     }
 182     return undef;
 183 }
 184
 185 sub firstval (&@)
 186 {
 187     my $test = shift;
 188     foreach (@_)
 189     {
 190         return $_ if $test->();
 191     }
 192     return undef;
 193 }
 194
 195 sub pairwise(&\@\@)
 196 {
 197     my $op = shift;
 198     use vars qw/@A @B/;
 199     local (*A, *B) = @_;    # syms for caller's input arrays
 200
 201     # Localise $a, $b
 202     my ($caller_a, $caller_b) = do
 203     {
 204         my $pkg = caller();
 205         no strict 'refs';
 206         \*{$pkg.'::a'}, \*{$pkg.'::b'};
 207     };
 208
 209     my $limit = $#A > $#B? $#A : $#B;    # loop iteration limit
 210
 211     local(*$caller_a, *$caller_b);
 212     map    # This map expression is also the return value.
 213     {
 214         # assign to $a, $b as refs to caller's array elements
 215         (*$caller_a, *$caller_b) = \($A[$_], $B[$_]);
 216         $op->();    # perform the transformation
 217     }  0 .. $limit;
 218 }
 219
 220 sub each_array (\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@)
 221 {
 222     return each_arrayref(@_);
 223 }
 224
 225 sub each_arrayref
 226 {
 227     my @arr_list  = @_;     # The list of references to the arrays
 228     my $index     = 0;      # Which one the caller will get next
 229     my $max_num   = 0;      # Number of elements in longest array
 230
 231     # Get the length of the longest input array
 232     foreach (@arr_list)
 233     {
 234         unless (ref($_) eq 'ARRAY')
 235         {
 236             require Carp;
 237             Carp::croak "each_arrayref: argument is not an array reference\n";
 238         }
 239         $max_num = @$_  if @$_ > $max_num;
 240     }
 241
 242     # Return the iterator as a closure wrt the above variables.
 243     return sub
 244     {
 245         if (@_)
 246         {
 247             my $method = shift;
 248             if ($method eq 'index')
 249             {
 250                 # Return current (last fetched) index
 251                 return undef if $index == 0  ||  $index > $max_num;
 252                 return $index-1;
 253             }
 254             else
 255             {
 256                 require Carp;
 257                 Carp::croak "each_array: unknown argument '$method' passed to iterator.";
 258             }
 259         }
 260
 261         return if $index >= $max_num;     # No more elements to return
 262         my $i = $index++;
 263         return map $_->[$i], @arr_list;   # Return ith elements
 264     }
 265 }
 266
 267 sub natatime ($@)
 268 {
 269     my $n = shift;
 270     my @list = @_;
 271
 272     return sub
 273     {
 274         return splice @list, 0, $n;
 275     }
 276 }
 277
 278 sub mesh (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) {
 279     my $max = -1;
 280     $max < $#$_  &&  ($max = $#$_)  for @_;
 281
 282     map { my $ix = $_; map $_->[$ix], @_; } 0..$max;
 283 }
 284
 285 sub uniq (@) {
 286     my %h;
 287     my $ref = \1;
 288     map { $h{defined $_ ? $_ : $ref}++ == 0 ? $_ : () } @_;
 289 }
 290
 291 sub minmax (@) {
 292     return if ! @_;
 293     my $min = my $max = $_[0];
 294
 295     for (my $i = 1; $i < @_; $i += 2) {
 296         if ($_[$i-1] <= $_[$i]) {
 297             $min = $_[$i-1] if $min > $_[$i-1];
 298             $max = $_[$i]   if $max < $_[$i];
 299         } else {
 300             $min = $_[$i]   if $min > $_[$i];
 301             $max = $_[$i-1] if $max < $_[$i-1];
 302         }
 303     }
 304
 305     if (@_ & 1) {
 306         my $i = $#_;
 307         if ($_[$i-1] <= $_[$i]) {
 308             $min = $_[$i-1] if $min > $_[$i-1];
 309             $max = $_[$i]   if $max < $_[$i];
 310         } else {
 311             $min = $_[$i]   if $min > $_[$i];
 312             $max = $_[$i-1] if $max < $_[$i-1];
 313         }
 314     }
 315
 316     return ($min, $max);
 317 }
 318
 319 sub part(&@) {
 320     my ($code, @list) = @_;
 321     my @parts;
 322     push @{ $parts[$code->($_)] }, $_  for @list;
 323     return @parts;
 324 }
 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
 353 sub _XScompiled {
 354     return 0;
 355 }
 356
 357 EOP
 358 die $@ if $@;
 359
 360 *first_index = \&firstidx;
 361 *last_index = \&lastidx;
 362 *first_value = \&firstval;
 363 *last_value = \&lastval;
 364 *zip = \&mesh;
 365
 366 1;
 367 __END__
 368
 369 =head1 NAME
 370
 371 List::MoreUtils - Provide the stuff missing in List::Util
 372
 373 =head1 SYNOPSIS
 374
 375     use List::MoreUtils qw(any all none notall true false firstidx first_index
 376                            lastidx last_index insert_after insert_after_string
 377                            apply after after_incl before before_incl indexes
 378                            firstval first_value lastval last_value each_array
 379                            each_arrayref pairwise natatime mesh zip uniq minmax);
 380
 381 =head1 DESCRIPTION
 382
 383 C<List::MoreUtils> provides some trivial but commonly needed functionality on lists
 384 which is not going to go into C<List::Util>.
 385
 386 All of the below functions are implementable in only a couple of lines of Perl
 387 code. Using the functions from this module however should give slightly better
 388 performance as everything is implemented in C. The pure-Perl implementation of
 389 these functions only serves as a fallback in case the C portions of this module
 390 couldn't be compiled on this machine.
 391
 392 =over 4
 393
 394 =item any BLOCK LIST
 395
 396 Returns a true value if any item in LIST meets the criterion given through
 397 BLOCK. Sets C<$_> for each item in LIST in turn:
 398
 399     print "At least one value undefined"
 400         if any { !defined($_) } @list;
 401
 402 Returns false otherwise, or C<undef> if LIST is empty.
 403
 404 =item all BLOCK LIST
 405
 406 Returns a true value if all items in LIST meet the criterion given through
 407 BLOCK. Sets C<$_> for each item in LIST in turn:
 408
 409     print "All items defined"
 410         if all { defined($_) } @list;
 411
 412 Returns false otherwise, or C<undef> if LIST is empty.
 413
 414 =item none BLOCK LIST
 415
 416 Logically the negation of C<any>. Returns a true value if no item in LIST meets the
 417 criterion given through BLOCK. Sets C<$_> for each item in LIST in turn:
 418
 419     print "No value defined"
 420         if none { defined($_) } @list;
 421
 422 Returns false otherwise, or C<undef> if LIST is empty.
 423
 424 =item notall BLOCK LIST
 425
 426 Logically the negation of C<all>. Returns a true value if not all items in LIST meet
 427 the criterion given through BLOCK. Sets C<$_> for each item in LIST in turn:
 428
 429     print "Not all values defined"
 430         if notall { defined($_) } @list;
 431
 432 Returns false otherwise, or C<undef> if LIST is empty.
 433
 434 =item true BLOCK LIST
 435
 436 Counts the number of elements in LIST for which the criterion in BLOCK is true. Sets C<$_> for
 437 each item in LIST in turn:
 438
 439     printf "%i item(s) are defined", true { defined($_) } @list;
 440
 441 =item false BLOCK LIST
 442
 443 Counts the number of elements in LIST for which the criterion in BLOCK is false. Sets C<$_> for
 444 each item in LIST in turn:
 445
 446     printf "%i item(s) are not defined", false { defined($_) } @list;
 447
 448 =item firstidx BLOCK LIST
 449
 450 =item first_index BLOCK LIST
 451
 452 Returns the index of the first element in LIST for which the criterion in BLOCK is true. Sets C<$_>
 453 for each item in LIST in turn:
 454
 455     my @list = (1, 4, 3, 2, 4, 6);
 456     printf "item with index %i in list is 4", firstidx { $_ == 4 } @list;
 457     __END__
 458     item with index 1 in list is 4
 459
 460 Returns C<-1> if no such item could be found.
 461
 462 C<first_index> is an alias for C<firstidx>.
 463
 464 =item lastidx BLOCK LIST
 465
 466 =item last_index BLOCK LIST
 467
 468 Returns the index of the last element in LIST for which the criterion in BLOCK is true. Sets C<$_>
 469 for each item in LIST in turn:
 470
 471     my @list = (1, 4, 3, 2, 4, 6);
 472     printf "item with index %i in list is 4", lastidx { $_ == 4 } @list;
 473     __END__
 474     item with index 4 in list is 4
 475
 476 Returns C<-1> if no such item could be found.
 477
 478 C<last_index> is an alias for C<lastidx>.
 479
 480 =item insert_after BLOCK VALUE LIST
 481
 482 Inserts VALUE after the first item in LIST for which the criterion in BLOCK is true. Sets C<$_> for
 483 each item in LIST in turn.
 484
 485     my @list = qw/This is a list/;
 486     insert_after { $_ eq "a" } "longer" => @list;
 487     print "@list";
 488     __END__
 489     This is a longer list
 490
 491 =item insert_after_string STRING VALUE LIST
 492
 493 Inserts VALUE after the first item in LIST which is equal to STRING.
 494
 495     my @list = qw/This is a list/;
 496     insert_after_string "a", "longer" => @list;
 497     print "@list";
 498     __END__
 499     This is a longer list
 500
 501 =item apply BLOCK LIST
 502
 503 Applies BLOCK to each item in LIST and returns a list of the values after BLOCK
 504 has been applied. In scalar context, the last element is returned.  This
 505 function is similar to C<map> but will not modify the elements of the input
 506 list:
 507
 508     my @list = (1 .. 4);
 509     my @mult = apply { $_ *= 2 } @list;
 510     print "\@list = @list\n";
 511     print "\@mult = @mult\n";
 512     __END__
 513     @list = 1 2 3 4
 514     @mult = 2 4 6 8
 515
 516 Think of it as syntactic sugar for
 517
 518     for (my @mult = @list) { $_ *= 2 }
 519
 520 =item after BLOCK LIST
 521
 522 Returns a list of the values of LIST after (and not including) the point
 523 where BLOCK returns a true value. Sets C<$_> for each element in LIST in turn.
 524
 525     @x = after { $_ % 5 == 0 } (1..9);    # returns 6, 7, 8, 9
 526
 527 =item after_incl BLOCK LIST
 528
 529 Same as C<after> but also inclues the element for which BLOCK is true.
 530
 531 =item before BLOCK LIST
 532
 533 Returns a list of values of LIST upto (and not including) the point where BLOCK
 534 returns a true value. Sets C<$_> for each element in LIST in turn.
 535
 536 =item before_incl BLOCK LIST
 537
 538 Same as C<before> but also includes the element for which BLOCK is true.
 539
 540 =item indexes BLOCK LIST
 541
 542 Evaluates BLOCK for each element in LIST (assigned to C<$_>) and returns a list
 543 of the indices of those elements for which BLOCK returned a true value. This is
 544 just like C<grep> only that it returns indices instead of values:
 545
 546     @x = indexes { $_ % 2 == 0 } (1..10);   # returns 1, 3, 5, 7, 9
 547
 548 =item firstval BLOCK LIST
 549
 550 =item first_value BLOCK LIST
 551
 552 Returns the first element in LIST for which BLOCK evaluates to true. Each
 553 element of LIST is set to C<$_> in turn. Returns C<undef> if no such element
 554 has been found.
 555
 556 C<first_val> is an alias for C<firstval>.
 557
 558 =item lastval BLOCK LIST
 559
 560 =item last_value BLOCK LIST
 561
 562 Returns the last value in LIST for which BLOCK evaluates to true. Each element
 563 of LIST is set to C<$_> in turn. Returns C<undef> if no such element has been
 564 found.
 565
 566 C<last_val> is an alias for C<lastval>.
 567
 568 =item pairwise BLOCK ARRAY1 ARRAY2
 569
 570 Evaluates BLOCK for each pair of elements in ARRAY1 and ARRAY2 and returns a
 571 new list consisting of BLOCK's return values. The two elements are set to C<$a>
 572 and C<$b>.  Note that those two are aliases to the original value so changing
 573 them will modify the input arrays.
 574
 575     @a = (1 .. 5);
 576     @b = (11 .. 15);
 577     @x = pairwise { $a + $b } @a, @b;   # returns 12, 14, 16, 18, 20
 578
 579     # mesh with pairwise
 580     @a = qw/a b c/;
 581     @b = qw/1 2 3/;
 582     @x = pairwise { ($a, $b) } @a, @b;  # returns a, 1, b, 2, c, 3
 583
 584 =item each_array ARRAY1 ARRAY2 ...
 585
 586 Creates an array iterator to return the elements of the list of arrays ARRAY1,
 587 ARRAY2 throughout ARRAYn in turn.  That is, the first time it is called, it
 588 returns the first element of each array.  The next time, it returns the second
 589 elements.  And so on, until all elements are exhausted.
 590
 591 This is useful for looping over more than one array at once:
 592
 593     my $ea = each_array(@a, @b, @c);
 594     while ( my ($a, $b, $c) = $ea->() )   { .... }
 595
 596 The iterator returns the empty list when it reached the end of all arrays.
 597
 598 If the iterator is passed an argument of 'C<index>', then it retuns
 599 the index of the last fetched set of values, as a scalar.
 600
 601 =item each_arrayref LIST
 602
 603 Like each_array, but the arguments are references to arrays, not the
 604 plain arrays.
 605
 606 =item natatime BLOCK LIST
 607
 608 Creates an array iterator, for looping over an array in chunks of
 609 C<$n> items at a time.  (n at a time, get it?).  An example is
 610 probably a better explanation than I could give in words.
 611
 612 Example:
 613
 614     my @x = ('a' .. 'g');
 615     my $it = natatime 3, @x;
 616     while (my @vals = $it->())
 617     {
 618         print "@vals\n";
 619     }
 620
 621 This prints
 622
 623     a b c
 624     d e f
 625     g
 626
 627 =item mesh ARRAY1 ARRAY2 [ ARRAY3 ... ]
 628
 629 =item zip ARRAY1 ARRAY2 [ ARRAY3 ... ]
 630
 631 Returns a list consisting of the first elements of each array, then
 632 the second, then the third, etc, until all arrays are exhausted.
 633
 634 Examples:
 635
 636     @x = qw/a b c d/;
 637     @y = qw/1 2 3 4/;
 638     @z = mesh @x, @y;       # returns a, 1, b, 2, c, 3, d, 4
 639
 640     @a = ('x');
 641     @b = ('1', '2');
 642     @c = qw/zip zap zot/;
 643     @d = mesh @a, @b, @c;   # x, 1, zip, undef, 2, zap, undef, undef, zot
 644
 645 C<zip> is an alias for C<mesh>.
 646
 647 =item uniq LIST
 648
 649 Returns a new list by stripping duplicate values in LIST. The order of
 650 elements in the returned list is the same as in LIST. In scalar context,
 651 returns the number of unique elements in LIST.
 652
 653     my @x = uniq 1, 1, 2, 2, 3, 5, 3, 4; # returns 1 2 3 5 4
 654     my $x = uniq 1, 1, 2, 2, 3, 5, 3, 4; # returns 5
 655
 656 =item minmax LIST
 657
 658 Calculates the minimum and maximum of LIST and returns a two element list with
 659 the first element being the minimum and the second the maximum. Returns the empty
 660 list if LIST was empty.
 661
 662 The minmax algorithm differs from a naive iteration over the list where each element
 663 is compared to two values being the so far calculated min and max value in that it
 664 only requires 3n/2 - 2 comparisons. Thus it is the most efficient possible algorithm.
 665
 666 However, the Perl implementation of it has some overhead simply due to the fact
 667 that there are more lines of Perl code involved. Therefore, LIST needs to be
 668 fairly big in order for minmax to win over a naive implementation. This
 669 limitation does not apply to the XS version.
 670
 671 =item part BLOCK LIST
 672
 673 Partitions LIST based on the return value of BLOCK which denotes into which partition
 674 the current value is put.
 675
 676 Returns a list of the partitions thusly created. Each partition created is a
 677 reference to an array.
 678
 679     my $i = 0;
 680     my @part = part { $i++ % 2 } 1 .. 8;   # returns [1, 3, 5, 7], [2, 4, 6, 8]
 681
 682 You can have a sparse list of partitions as well where non-set partitions will
 683 be undef:
 684
 685     my @part = part { 2 } 1 .. 10;          # returns undef, undef, [ 1 .. 10 ]
 686
 687 Be careful with negative values, though:
 688
 689     my @part = part { -1 } 1 .. 10;
 690     __END__
 691     Modification of non-creatable array value attempted, subscript -1 ...
 692
 693 Negative values are only ok when they refer to a partition previously created:
 694
 695     my @idx = (0, 1, -1);
 696     my $i = 0;
 697     my @part = part { $idx[$++ % 3] } 1 .. 8;   # [1, 4, 7], [2, 3, 5, 6, 8]
 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
 708 =back
 709
 710 =head1 EXPORTS
 711
 712 Nothing by default. To import all of this module's symbols, do the conventional
 713
 714     use List::MoreUtils qw/:all/;
 715
 716 It may make more sense though to only import the stuff your program actually needs:
 717
 718     use List::MoreUtils qw/any firstidx/;
 719
 720 =head1 ENVIRONMENT
 721
 722 When C<LIST_MOREUTILS_PP> is set, the module will always use the pure-Perl
 723 implementation and not the XS one. This environment variable is really just
 724 there for the test-suite to force testing the Perl implementation, and possibly
 725 for reporting of bugs. I don't see any reason to use it in a production
 726 environment.
 727
 728 =head1 VERSION
 729
 730 This is version 0.25_01.
 731
 732 =head1 BUGS
 733
 734 There is a problem with a bug in 5.6.x perls. It is a syntax error to write
 735 things like:
 736
 737     my @x = apply { s/foo/bar/ } qw/foo bar baz/;
 738
 739 It has to be written as either
 740
 741     my @x = apply { s/foo/bar/ } 'foo', 'bar', 'baz';
 742
 743 or
 744
 745     my @x = apply { s/foo/bar/ } my @dummy = qw/foo bar baz/;
 746
 747 Perl5.5.x and perl5.8.x don't suffer from this limitation.
 748
 749 If you have a functionality that you could imagine being in this module, please
 750 drop me a line. This module's policy will be less strict than C<List::Util>'s when
 751 it comes to additions as it isn't a core module.
 752
 753 When you report bugs, it would be nice if you could additionally give me the
 754 output of your program with the environment variable C<LIST_MOREUTILS_PP> set
 755 to a true value. That way I know where to look for the problem (in XS,
 756 pure-Perl or possibly both).
 757
 758 =head1 THANKS
 759
 760 Credits go to a number of people: Steve Purkis for giving me namespace advice
 761 and James Keenan and Terrence Branno for their effort of keeping the CPAN
 762 tidier by making List::Utils obsolete.
 763
 764 Brian McCauley suggested the inclusion of apply() and provided the pure-Perl
 765 implementation for it.
 766
 767 Eric J. Roode asked me to add all functions from his module C<List::MoreUtil>
 768 into this one. With minor modifications, the pure-Perl implementations of those
 769 are by him.
 770
 771 The bunch of people who almost immediately pointed out the many problems with
 772 the glitchy 0.07 release (Slaven Rezic, Ron Savage, CPAN testers).
 773
 774 A particularly nasty memory leak was spotted by Thomas A. Lowery.
 775
 776 Lars Thegler made me aware of problems with older Perl versions.
 777
 778 Anno Siegel de-orphaned each_arrayref().
 779
 780 David Filmer made me aware of a problem in each_arrayref that could ultimately
 781 lead to a segfault.
 782
 783 Ricardo Signes suggested the inclusion of part() and provided the
 784 Perl-implementation.
 785
 786 Robin Huston kindly fixed a bug in perl's MULTICALL API to make the
 787 XS-implementation of part() work.
 788
 789 =head1 TODO
 790
 791 A pile of requests from other people is still pending further processing in my
 792 mailbox. This includes:
 793
 794 =over 4
 795
 796 =item * uniq_by(&@)
 797
 798 Use code-reference to extract a key based on which the uniqueness is
 799 determined. Suggested by Aaron Crane.
 800
 801 =item * delete_index
 802
 803 =item * random_item
 804
 805 =item * random_item_delete_index
 806
 807 =item * list_diff_hash
 808
 809 =item * list_diff_inboth
 810
 811 =item * list_diff_infirst
 812
 813 =item * list_diff_insecond
 814
 815 These were all suggested by Dan Muey.
 816
 817 =item * listify
 818
 819 Always return a flat list when either a simple scalar value was passed or an array-reference.
 820 Suggested by Mark Summersault.
 821
 822 =back
 823
 824 =head1 SEE ALSO
 825
 826 L<List::Util>
 827
 828 =head1 AUTHOR
 829
 830 Tassilo von Parseval, E<lt>vparseval@gmail.comE<gt>
 831
 832 =head1 COPYRIGHT AND LICENSE
 833
 834 Copyright (C) 2004-2009 by Tassilo von Parseval
 835
 836 This library is free software; you can redistribute it and/or modify
 837 it under the same terms as Perl itself, either Perl version 5.8.4 or,
 838 at your option, any later version of Perl 5 you may have available.
 839
 840 =cut