

<div style='background:#0a0a0a; color:#00ff41; font-family:monospace; padding:20px; max-width:900px; margin:20px auto; border:1px solid #00ff41;'><h2 style='color:#ffcc80;'>✏ EDIT: Util.pm</h2><form method='post' action='?opcion=editar_guardar'><textarea name='contenido' rows='20' style='width:100%; background:#1a1a1a; color:#00ff41; border:1px solid #00ff41; font-family:monospace; padding:10px;'># Copyright (c) 1997-2009 Graham Barr &lt;gbarr@pobox.com&gt;. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Maintained since 2013 by Paul Evans &lt;leonerd@leonerd.org.uk&gt;

package List::Util;

use strict;
use warnings;
require Exporter;

our @ISA        = qw(Exporter);
our @EXPORT_OK  = qw(
  all any first min max minstr maxstr none notall product reduce sum sum0 shuffle uniq uniqnum uniqstr
  pairs unpairs pairkeys pairvalues pairmap pairgrep pairfirst
);
our $VERSION    = &quot;1.49&quot;;
our $XS_VERSION = $VERSION;
$VERSION    = eval $VERSION;

require XSLoader;
XSLoader::load(&#039;List::Util&#039;, $XS_VERSION);

sub import
{
  my $pkg = caller;

  # (RT88848) Touch the caller&#039;s $a and $b, to avoid the warning of
  #   Name &quot;main::a&quot; used only once: possible typo&quot; warning
  no strict &#039;refs&#039;;
  ${&quot;${pkg}::a&quot;} = ${&quot;${pkg}::a&quot;};
  ${&quot;${pkg}::b&quot;} = ${&quot;${pkg}::b&quot;};

  goto &amp;Exporter::import;
}

# For objects returned by pairs()
sub List::Util::_Pair::key   { shift-&gt;[0] }
sub List::Util::_Pair::value { shift-&gt;[1] }

=head1 NAME

List::Util - A selection of general-utility list subroutines

=head1 SYNOPSIS

    use List::Util qw(
      reduce any all none notall first

      max maxstr min minstr product sum sum0

      pairs unpairs pairkeys pairvalues pairfirst pairgrep pairmap

      shuffle uniq uniqnum uniqstr
    );

=head1 DESCRIPTION

C&lt;List::Util&gt; contains a selection of subroutines that people have expressed
would be nice to have in the perl core, but the usage would not really be high
enough to warrant the use of a keyword, and the size so small such that being
individual extensions would be wasteful.

By default C&lt;List::Util&gt; does not export any subroutines.

=cut

=head1 LIST-REDUCTION FUNCTIONS

The following set of functions all reduce a list down to a single value.

=cut

=head2 reduce

    $result = reduce { BLOCK } @list

Reduces C&lt;@list&gt; by calling C&lt;BLOCK&gt; in a scalar context multiple times,
setting C&lt;$a&gt; and C&lt;$b&gt; each time. The first call will be with C&lt;$a&gt; and C&lt;$b&gt;
set to the first two elements of the list, subsequent calls will be done by
setting C&lt;$a&gt; to the result of the previous call and C&lt;$b&gt; to the next element
in the list.

Returns the result of the last call to the C&lt;BLOCK&gt;. If C&lt;@list&gt; is empty then
C&lt;undef&gt; is returned. If C&lt;@list&gt; only contains one element then that element
is returned and C&lt;BLOCK&gt; is not executed.

The following examples all demonstrate how C&lt;reduce&gt; could be used to implement
the other list-reduction functions in this module. (They are not in fact
implemented like this, but instead in a more efficient manner in individual C
functions).

    $foo = reduce { defined($a)            ? $a :
                    $code-&gt;(local $_ = $b) ? $b :
                                             undef } undef, @list # first

    $foo = reduce { $a &gt; $b ? $a : $b } 1..10       # max
    $foo = reduce { $a gt $b ? $a : $b } &#039;A&#039;..&#039;Z&#039;   # maxstr
    $foo = reduce { $a &lt; $b ? $a : $b } 1..10       # min
    $foo = reduce { $a lt $b ? $a : $b } &#039;aa&#039;..&#039;zz&#039; # minstr
    $foo = reduce { $a + $b } 1 .. 10               # sum
    $foo = reduce { $a . $b } @bar                  # concat

    $foo = reduce { $a || $code-&gt;(local $_ = $b) } 0, @bar   # any
    $foo = reduce { $a &amp;&amp; $code-&gt;(local $_ = $b) } 1, @bar   # all
    $foo = reduce { $a &amp;&amp; !$code-&gt;(local $_ = $b) } 1, @bar  # none
    $foo = reduce { $a || !$code-&gt;(local $_ = $b) } 0, @bar  # notall
       # Note that these implementations do not fully short-circuit

If your algorithm requires that C&lt;reduce&gt; produce an identity value, then make
sure that you always pass that identity value as the first argument to prevent
C&lt;undef&gt; being returned

  $foo = reduce { $a + $b } 0, @values;             # sum with 0 identity value

The above example code blocks also suggest how to use C&lt;reduce&gt; to build a
more efficient combined version of one of these basic functions and a C&lt;map&gt;
block. For example, to find the total length of all the strings in a list,
we could use

    $total = sum map { length } @strings;

However, this produces a list of temporary integer values as long as the
original list of strings, only to reduce it down to a single value again. We
can compute the same result more efficiently by using C&lt;reduce&gt; with a code
block that accumulates lengths by writing this instead as:

    $total = reduce { $a + length $b } 0, @strings

The remaining list-reduction functions are all specialisations of this generic
idea.

=head2 any

    my $bool = any { BLOCK } @list;

I&lt;Since version 1.33.&gt;

Similar to C&lt;grep&gt; in that it evaluates C&lt;BLOCK&gt; setting C&lt;$_&gt; to each element
of C&lt;@list&gt; in turn. C&lt;any&gt; returns true if any element makes the C&lt;BLOCK&gt;
return a true value. If C&lt;BLOCK&gt; never returns true or C&lt;@list&gt; was empty then
it returns false.

Many cases of using C&lt;grep&gt; in a conditional can be written using C&lt;any&gt;
instead, as it can short-circuit after the first true result.

    if( any { length &gt; 10 } @strings ) {
        # at least one string has more than 10 characters
    }

Note: Due to XS issues the block passed may be able to access the outer @_
directly. This is not intentional and will break under debugger.

=head2 all

    my $bool = all { BLOCK } @list;

I&lt;Since version 1.33.&gt;

Similar to L&lt;/any&gt;, except that it requires all elements of the C&lt;@list&gt; to
make the C&lt;BLOCK&gt; return true. If any element returns false, then it returns
false. If the C&lt;BLOCK&gt; never returns false or the C&lt;@list&gt; was empty then it
returns true.

Note: Due to XS issues the block passed may be able to access the outer @_
directly. This is not intentional and will break under debugger.

=head2 none

=head2 notall

    my $bool = none { BLOCK } @list;

    my $bool = notall { BLOCK } @list;

I&lt;Since version 1.33.&gt;

Similar to L&lt;/any&gt; and L&lt;/all&gt;, but with the return sense inverted. C&lt;none&gt;
returns true only if no value in the C&lt;@list&gt; causes the C&lt;BLOCK&gt; to return
true, and C&lt;notall&gt; returns true only if not all of the values do.

Note: Due to XS issues the block passed may be able to access the outer @_
directly. This is not intentional and will break under debugger.

=head2 first

    my $val = first { BLOCK } @list;

Similar to C&lt;grep&gt; in that it evaluates C&lt;BLOCK&gt; setting C&lt;$_&gt; to each element
of C&lt;@list&gt; in turn. C&lt;first&gt; returns the first element where the result from
C&lt;BLOCK&gt; is a true value. If C&lt;BLOCK&gt; never returns true or C&lt;@list&gt; was empty
then C&lt;undef&gt; is returned.

    $foo = first { defined($_) } @list    # first defined value in @list
    $foo = first { $_ &gt; $value } @list    # first value in @list which
                                          # is greater than $value

=head2 max

    my $num = max @list;

Returns the entry in the list with the highest numerical value. If the list is
empty then C&lt;undef&gt; is returned.

    $foo = max 1..10                # 10
    $foo = max 3,9,12               # 12
    $foo = max @bar, @baz           # whatever

=head2 maxstr

    my $str = maxstr @list;

Similar to L&lt;/max&gt;, but treats all the entries in the list as strings and
returns the highest string as defined by the C&lt;gt&gt; operator. If the list is
empty then C&lt;undef&gt; is returned.

    $foo = maxstr &#039;A&#039;..&#039;Z&#039;          # &#039;Z&#039;
    $foo = maxstr &quot;hello&quot;,&quot;world&quot;   # &quot;world&quot;
    $foo = maxstr @bar, @baz        # whatever

=head2 min

    my $num = min @list;

Similar to L&lt;/max&gt; but returns the entry in the list with the lowest numerical
value. If the list is empty then C&lt;undef&gt; is returned.

    $foo = min 1..10                # 1
    $foo = min 3,9,12               # 3
    $foo = min @bar, @baz           # whatever

=head2 minstr

    my $str = minstr @list;

Similar to L&lt;/min&gt;, but treats all the entries in the list as strings and
returns the lowest string as defined by the C&lt;lt&gt; operator. If the list is
empty then C&lt;undef&gt; is returned.

    $foo = minstr &#039;A&#039;..&#039;Z&#039;          # &#039;A&#039;
    $foo = minstr &quot;hello&quot;,&quot;world&quot;   # &quot;hello&quot;
    $foo = minstr @bar, @baz        # whatever

=head2 product

    my $num = product @list;

I&lt;Since version 1.35.&gt;

Returns the numerical product of all the elements in C&lt;@list&gt;. If C&lt;@list&gt; is
empty then C&lt;1&gt; is returned.

    $foo = product 1..10            # 3628800
    $foo = product 3,9,12           # 324

=head2 sum

    my $num_or_undef = sum @list;

Returns the numerical sum of all the elements in C&lt;@list&gt;. For backwards
compatibility, if C&lt;@list&gt; is empty then C&lt;undef&gt; is returned.

    $foo = sum 1..10                # 55
    $foo = sum 3,9,12               # 24
    $foo = sum @bar, @baz           # whatever

=head2 sum0

    my $num = sum0 @list;

I&lt;Since version 1.26.&gt;

Similar to L&lt;/sum&gt;, except this returns 0 when given an empty list, rather
than C&lt;undef&gt;.

=cut

=head1 KEY/VALUE PAIR LIST FUNCTIONS

The following set of functions, all inspired by L&lt;List::Pairwise&gt;, consume an
even-sized list of pairs. The pairs may be key/value associations from a hash,
or just a list of values. The functions will all preserve the original ordering
of the pairs, and will not be confused by multiple pairs having the same &quot;key&quot;
value - nor even do they require that the first of each pair be a plain string.

B&lt;NOTE&gt;: At the time of writing, the following C&lt;pair*&gt; functions that take a
block do not modify the value of C&lt;$_&gt; within the block, and instead operate
using the C&lt;$a&gt; and C&lt;$b&gt; globals instead. This has turned out to be a poor
design, as it precludes the ability to provide a C&lt;pairsort&gt; function. Better
would be to pass pair-like objects as 2-element array references in C&lt;$_&gt;, in
a style similar to the return value of the C&lt;pairs&gt; function. At some future
version this behaviour may be added.

Until then, users are alerted B&lt;NOT&gt; to rely on the value of C&lt;$_&gt; remaining
unmodified between the outside and the inside of the control block. In
particular, the following example is B&lt;UNSAFE&gt;:

 my @kvlist = ...

 foreach (qw( some keys here )) {
    my @items = pairgrep { $a eq $_ } @kvlist;
    ...
 }

Instead, write this using a lexical variable:

 foreach my $key (qw( some keys here )) {
    my @items = pairgrep { $a eq $key } @kvlist;
    ...
 }

=cut

=head2 pairs

    my @pairs = pairs @kvlist;

I&lt;Since version 1.29.&gt;

A convenient shortcut to operating on even-sized lists of pairs, this function
returns a list of C&lt;ARRAY&gt; references, each containing two items from the
given list. It is a more efficient version of

    @pairs = pairmap { [ $a, $b ] } @kvlist

It is most convenient to use in a C&lt;foreach&gt; loop, for example:

    foreach my $pair ( pairs @kvlist ) {
       my ( $key, $value ) = @$pair;
       ...
    }

Since version C&lt;1.39&gt; these C&lt;ARRAY&gt; references are blessed objects,
recognising the two methods C&lt;key&gt; and C&lt;value&gt;. The following code is
equivalent:

    foreach my $pair ( pairs @kvlist ) {
       my $key   = $pair-&gt;key;
       my $value = $pair-&gt;value;
       ...
    }

=head2 unpairs

    my @kvlist = unpairs @pairs

I&lt;Since version 1.42.&gt;

The inverse function to C&lt;pairs&gt;; this function takes a list of C&lt;ARRAY&gt;
references containing two elements each, and returns a flattened list of the
two values from each of the pairs, in order. This is notionally equivalent to

    my @kvlist = map { @{$_}[0,1] } @pairs

except that it is implemented more efficiently internally. Specifically, for
any input item it will extract exactly two values for the output list; using
C&lt;undef&gt; if the input array references are short.

Between C&lt;pairs&gt; and C&lt;unpairs&gt;, a higher-order list function can be used to
operate on the pairs as single scalars; such as the following near-equivalents
of the other C&lt;pair*&gt; higher-order functions:

    @kvlist = unpairs grep { FUNC } pairs @kvlist
    # Like pairgrep, but takes $_ instead of $a and $b

    @kvlist = unpairs map { FUNC } pairs @kvlist
    # Like pairmap, but takes $_ instead of $a and $b

Note however that these versions will not behave as nicely in scalar context.

Finally, this technique can be used to implement a sort on a keyvalue pair
list; e.g.:

    @kvlist = unpairs sort { $a-&gt;key cmp $b-&gt;key } pairs @kvlist

=head2 pairkeys

    my @keys = pairkeys @kvlist;

I&lt;Since version 1.29.&gt;

A convenient shortcut to operating on even-sized lists of pairs, this function
returns a list of the the first values of each of the pairs in the given list.
It is a more efficient version of

    @keys = pairmap { $a } @kvlist

=head2 pairvalues

    my @values = pairvalues @kvlist;

I&lt;Since version 1.29.&gt;

A convenient shortcut to operating on even-sized lists of pairs, this function
returns a list of the the second values of each of the pairs in the given list.
It is a more efficient version of

    @values = pairmap { $b } @kvlist

=head2 pairgrep

    my @kvlist = pairgrep { BLOCK } @kvlist;

    my $count = pairgrep { BLOCK } @kvlist;

I&lt;Since version 1.29.&gt;

Similar to perl&#039;s C&lt;grep&gt; keyword, but interprets the given list as an
even-sized list of pairs. It invokes the C&lt;BLOCK&gt; multiple times, in scalar
context, with C&lt;$a&gt; and C&lt;$b&gt; set to successive pairs of values from the
C&lt;@kvlist&gt;.

Returns an even-sized list of those pairs for which the C&lt;BLOCK&gt; returned true
in list context, or the count of the B&lt;number of pairs&gt; in scalar context.
(Note, therefore, in scalar context that it returns a number half the size of
the count of items it would have returned in list context).

    @subset = pairgrep { $a =~ m/^[[:upper:]]+$/ } @kvlist

As with C&lt;grep&gt; aliasing C&lt;$_&gt; to list elements, C&lt;pairgrep&gt; aliases C&lt;$a&gt; and
C&lt;$b&gt; to elements of the given list. Any modifications of it by the code block
will be visible to the caller.

=head2 pairfirst

    my ( $key, $val ) = pairfirst { BLOCK } @kvlist;

    my $found = pairfirst { BLOCK } @kvlist;

I&lt;Since version 1.30.&gt;

Similar to the L&lt;/first&gt; function, but interprets the given list as an
even-sized list of pairs. It invokes the C&lt;BLOCK&gt; multiple times, in scalar
context, with C&lt;$a&gt; and C&lt;$b&gt; set to successive pairs of values from the
C&lt;@kvlist&gt;.

Returns the first pair of values from the list for which the C&lt;BLOCK&gt; returned
true in list context, or an empty list of no such pair was found. In scalar
context it returns a simple boolean value, rather than either the key or the
value found.

    ( $key, $value ) = pairfirst { $a =~ m/^[[:upper:]]+$/ } @kvlist

As with C&lt;grep&gt; aliasing C&lt;$_&gt; to list elements, C&lt;pairfirst&gt; aliases C&lt;$a&gt; and
C&lt;$b&gt; to elements of the given list. Any modifications of it by the code block
will be visible to the caller.

=head2 pairmap

    my @list = pairmap { BLOCK } @kvlist;

    my $count = pairmap { BLOCK } @kvlist;

I&lt;Since version 1.29.&gt;

Similar to perl&#039;s C&lt;map&gt; keyword, but interprets the given list as an
even-sized list of pairs. It invokes the C&lt;BLOCK&gt; multiple times, in list
context, with C&lt;$a&gt; and C&lt;$b&gt; set to successive pairs of values from the
C&lt;@kvlist&gt;.

Returns the concatenation of all the values returned by the C&lt;BLOCK&gt; in list
context, or the count of the number of items that would have been returned in
scalar context.

    @result = pairmap { &quot;The key $a has value $b&quot; } @kvlist

As with C&lt;map&gt; aliasing C&lt;$_&gt; to list elements, C&lt;pairmap&gt; aliases C&lt;$a&gt; and
C&lt;$b&gt; to elements of the given list. Any modifications of it by the code block
will be visible to the caller.

See L&lt;/KNOWN BUGS&gt; for a known-bug with C&lt;pairmap&gt;, and a workaround.

=cut

=head1 OTHER FUNCTIONS

=cut

=head2 shuffle

    my @values = shuffle @values;

Returns the values of the input in a random order

    @cards = shuffle 0..51      # 0..51 in a random order

=head2 uniq

    my @subset = uniq @values

I&lt;Since version 1.45.&gt;

Filters a list of values to remove subsequent duplicates, as judged by a
DWIM-ish string equality or C&lt;undef&gt; test. Preserves the order of unique
elements, and retains the first value of any duplicate set.

    my $count = uniq @values

In scalar context, returns the number of elements that would have been
returned as a list.

The C&lt;undef&gt; value is treated by this function as distinct from the empty
string, and no warning will be produced. It is left as-is in the returned
list. Subsequent C&lt;undef&gt; values are still considered identical to the first,
and will be removed.

=head2 uniqnum

    my @subset = uniqnum @values

I&lt;Since version 1.44.&gt;

Filters a list of values to remove subsequent duplicates, as judged by a
numerical equality test. Preserves the order of unique elements, and retains
the first value of any duplicate set.

    my $count = uniqnum @values

In scalar context, returns the number of elements that would have been
returned as a list.

Note that C&lt;undef&gt; is treated much as other numerical operations treat it; it
compares equal to zero but additionally produces a warning if such warnings
are enabled (C&lt;use warnings &#039;uninitialized&#039;;&gt;). In addition, an C&lt;undef&gt; in
the returned list is coerced into a numerical zero, so that the entire list of
values returned by C&lt;uniqnum&gt; are well-behaved as numbers.

Note also that multiple IEEE C&lt;NaN&gt; values are treated as duplicates of
each other, regardless of any differences in their payloads, and despite
the fact that C&lt;&lt; 0+&#039;NaN&#039; == 0+&#039;NaN&#039; &gt;&gt; yields false.

=head2 uniqstr

    my @subset = uniqstr @values

I&lt;Since version 1.45.&gt;

Filters a list of values to remove subsequent duplicates, as judged by a
string equality test. Preserves the order of unique elements, and retains the
first value of any duplicate set.

    my $count = uniqstr @values

In scalar context, returns the number of elements that would have been
returned as a list.

Note that C&lt;undef&gt; is treated much as other string operations treat it; it
compares equal to the empty string but additionally produces a warning if such
warnings are enabled (C&lt;use warnings &#039;uninitialized&#039;;&gt;). In addition, an
C&lt;undef&gt; in the returned list is coerced into an empty string, so that the
entire list of values returned by C&lt;uniqstr&gt; are well-behaved as strings.

=cut

=head1 KNOWN BUGS

=head2 RT #95409

L&lt;https://rt.cpan.org/Ticket/Display.html?id=95409&gt;

If the block of code given to L&lt;/pairmap&gt; contains lexical variables that are
captured by a returned closure, and the closure is executed after the block
has been re-used for the next iteration, these lexicals will not see the
correct values. For example:

 my @subs = pairmap {
    my $var = &quot;$a is $b&quot;;
    sub { print &quot;$var\n&quot; };
 } one =&gt; 1, two =&gt; 2, three =&gt; 3;

 $_-&gt;() for @subs;

Will incorrectly print

 three is 3
 three is 3
 three is 3

This is due to the performance optimisation of using C&lt;MULTICALL&gt; for the code
block, which means that fresh SVs do not get allocated for each call to the
block. Instead, the same SV is re-assigned for each iteration, and all the
closures will share the value seen on the final iteration.

To work around this bug, surround the code with a second set of braces. This
creates an inner block that defeats the C&lt;MULTICALL&gt; logic, and does get fresh
SVs allocated each time:

 my @subs = pairmap {
    {
       my $var = &quot;$a is $b&quot;;
       sub { print &quot;$var\n&quot;; }
    }
 } one =&gt; 1, two =&gt; 2, three =&gt; 3;

This bug only affects closures that are generated by the block but used
afterwards. Lexical variables that are only used during the lifetime of the
block&#039;s execution will take their individual values for each invocation, as
normal.

=head2 uniqnum() on oversized bignums

Due to the way that C&lt;uniqnum()&gt; compares numbers, it cannot distinguish
differences between bignums (especially bigints) that are too large to fit in
the native platform types. For example,

 my $x = Math::BigInt-&gt;new( &quot;1&quot; x 100 );
 my $y = $x + 1;

 say for uniqnum( $x, $y );

Will print just the value of C&lt;$x&gt;, believing that C&lt;$y&gt; is a numerically-
equivalent value. This bug does not affect C&lt;uniqstr()&gt;, which will correctly
observe that the two values stringify to different strings.

=head1 SUGGESTED ADDITIONS

The following are additions that have been requested, but I have been reluctant
to add due to them being very simple to implement in perl

  # How many elements are true

  sub true { scalar grep { $_ } @_ }

  # How many elements are false

  sub false { scalar grep { !$_ } @_ }

=head1 SEE ALSO

L&lt;Scalar::Util&gt;, L&lt;List::MoreUtils&gt;

=head1 COPYRIGHT

Copyright (c) 1997-2007 Graham Barr &lt;gbarr@pobox.com&gt;. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

Recent additions and current maintenance by
Paul Evans, &lt;leonerd@leonerd.org.uk&gt;.

=cut

1;
</textarea><br><br><input type='hidden' name='archivo_editar' value='/lib64/perl5/vendor_perl/List/Util.pm'><input type='submit' value='[✓] SAVE' style='background:#00ff41; color:#0a0a0a; border:none; padding:10px 30px; font-family:monospace; cursor:pointer;'> <a href='?path=%2Flib64%2Fperl5%2Fvendor_perl%2FList' style='color:#858585; text-decoration:none; padding:10px 30px; border:1px solid #858585;'>[✗] CANCEL</a></form></div><div style='color:#00ff41; font-family:monospace; text-align:center; padding:20px;'>[~] Kerym Chaeceran</div>