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