Update Scalar-List-Utils to CPAN version 1.40

  [DELTA]

1.40 -- 2014/08/30 11:36:36
  [CHANGES]
   * Added entire new module, Sub::Util to contain functions related
     to CODE refs
   * Added subname inspired by Sub::Identify
   * Added set_subname copied and renamed from Sub::Name
   * Also moved set_prototype into Sub::Name, with back-compat wrapper
     in Scalar::Util
   * Added prototype wrapper of CODE::prototype, for completeness
   * Nicer module documentation format, allows neater use of L</...>

  [THANKS]
   * This change was written at the YAPC::EU 2014 Hackathon hosted by
     Liz Mattijsen and Wendy van Dijk; much thanks to them for being its
     catalyst.

8 files changed, 571 insertions, 92 deletions

diff --git a/cpan/Scalar-List-Utils/ListUtil.xs b/cpan/Scalar-List-Utils/ListUtil.xs
index e6a2eaa673..1b213793e5 100644
--- a/cpan/Scalar-List-Utils/ListUtil.xs
+++ b/cpan/Scalar-List-Utils/ListUtil.xs
@@ -82,6 +82,9 @@ static enum slu_accum accum_type(SV *sv) {
     return ACC_NV;
 }
 
+/* Magic for set_subname */
+static MGVTBL subname_vtbl;
+
 MODULE=List::Util       PACKAGE=List::Util
 
 void
@@ -237,6 +240,8 @@ CODE:
         retsv = TARG;
 
     switch(accum) {
+    case ACC_SV: /* nothing to do */
+        break;
     case ACC_IV:
         sv_setiv(retsv, retiv);
         break;
@@ -1064,7 +1069,7 @@ CODE:
     croak("vstrings are not implemented in this release of perl");
 #endif
 
-int
+SV *
 looks_like_number(sv)
     SV *sv
 PROTOTYPE: $
@@ -1076,47 +1081,18 @@ CODE:
     }
 #if PERL_BCDVERSION < 0x5008005
     if(SvPOK(sv) || SvPOKp(sv)) {
-        RETVAL = !!looks_like_number(sv);
+        RETVAL = looks_like_number(sv) ? &PL_sv_yes : &PL_sv_no;
     }
     else {
-        RETVAL = SvFLAGS(sv) & (SVf_NOK|SVp_NOK|SVf_IOK|SVp_IOK);
+        RETVAL = (SvFLAGS(sv) & (SVf_NOK|SVp_NOK|SVf_IOK|SVp_IOK)) ? &PL_sv_yes : &PL_sv_no;
     }
 #else
-    RETVAL = !!looks_like_number(sv);
+    RETVAL = looks_like_number(sv) ? &PL_sv_yes : &PL_sv_no;
 #endif
 OUTPUT:
     RETVAL
 
 void
-set_prototype(subref, proto)
-    SV *subref
-    SV *proto
-PROTOTYPE: &$
-CODE:
-{
-    SvGETMAGIC(subref);
-    if(SvROK(subref)) {
-        SV *sv = SvRV(subref);
-        if(SvTYPE(sv) != SVt_PVCV) {
-            /* not a subroutine reference */
-            croak("set_prototype: not a subroutine reference");
-        }
-        if(SvPOK(proto)) {
-            /* set the prototype */
-            sv_copypv(sv, proto);
-        }
-        else {
-            /* delete the prototype */
-            SvPOK_off(sv);
-        }
-    }
-    else {
-        croak("set_prototype: not a reference");
-    }
-    XSRETURN(1);
-}
-
-void
 openhandle(SV *sv)
 PROTOTYPE: $
 CODE:
@@ -1145,6 +1121,162 @@ CODE:
     XSRETURN_UNDEF;
 }
 
+MODULE=List::Util       PACKAGE=Sub::Util
+
+void
+set_prototype(proto, code)
+    SV *proto
+    SV *code
+PREINIT:
+    SV *cv; /* not CV * */
+PPCODE:
+    SvGETMAGIC(code);
+    if(!SvROK(code))
+        croak("set_prototype: not a reference");
+
+    cv = SvRV(code);
+    if(SvTYPE(cv) != SVt_PVCV)
+        croak("set_prototype: not a subroutine reference");
+
+    if(SvPOK(proto)) {
+        /* set the prototype */
+        sv_copypv(cv, proto);
+    }
+    else {
+        /* delete the prototype */
+        SvPOK_off(cv);
+    }
+
+    PUSHs(code);
+    XSRETURN(1);
+
+void
+set_subname(name, sub)
+    char *name
+    SV *sub
+PREINIT:
+    CV *cv = NULL;
+    GV *gv;
+    HV *stash = CopSTASH(PL_curcop);
+    char *s, *end = NULL;
+    MAGIC *mg;
+PPCODE:
+    if (!SvROK(sub) && SvGMAGICAL(sub))
+        mg_get(sub);
+    if (SvROK(sub))
+        cv = (CV *) SvRV(sub);
+    else if (SvTYPE(sub) == SVt_PVGV)
+        cv = GvCVu(sub);
+    else if (!SvOK(sub))
+        croak(PL_no_usym, "a subroutine");
+    else if (PL_op->op_private & HINT_STRICT_REFS)
+        croak("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use",
+              SvPV_nolen(sub), "a subroutine");
+    else if ((gv = gv_fetchpv(SvPV_nolen(sub), FALSE, SVt_PVCV)))
+        cv = GvCVu(gv);
+    if (!cv)
+        croak("Undefined subroutine %s", SvPV_nolen(sub));
+    if (SvTYPE(cv) != SVt_PVCV && SvTYPE(cv) != SVt_PVFM)
+        croak("Not a subroutine reference");
+    for (s = name; *s++; ) {
+        if (*s == ':' && s[-1] == ':')
+            end = ++s;
+        else if (*s && s[-1] == '\'')
+            end = s;
+    }
+    s--;
+    if (end) {
+        char *namepv = savepvn(name, end - name);
+        stash = GvHV(gv_fetchpv(namepv, TRUE, SVt_PVHV));
+        Safefree(namepv);
+        name = end;
+    }
+
+    /* under debugger, provide information about sub location */
+    if (PL_DBsub && CvGV(cv)) {
+        HV *hv = GvHV(PL_DBsub);
+
+        char* new_pkg = HvNAME(stash);
+
+        char* old_name = GvNAME( CvGV(cv) );
+        char* old_pkg = HvNAME( GvSTASH(CvGV(cv)) );
+
+        int old_len = strlen(old_name) + strlen(old_pkg);
+        int new_len = strlen(name) + strlen(new_pkg);
+
+        char* full_name;
+        Newxz(full_name, (old_len > new_len ? old_len : new_len) + 3, char);
+
+        strcat(full_name, old_pkg);
+        strcat(full_name, "::");
+        strcat(full_name, old_name);
+
+        SV** old_data = hv_fetch(hv, full_name, strlen(full_name), 0);
+
+        if (old_data) {
+            strcpy(full_name, new_pkg);
+            strcat(full_name, "::");
+            strcat(full_name, name);
+
+            SvREFCNT_inc(*old_data);
+            if (!hv_store(hv, full_name, strlen(full_name), *old_data, 0))
+                SvREFCNT_dec(*old_data);
+        }
+        Safefree(full_name);
+    }
+
+    gv = (GV *) newSV(0);
+    gv_init(gv, stash, name, s - name, TRUE);
+
+    /*
+     * set_subname needs to create a GV to store the name. The CvGV field of a
+     * CV is not refcounted, so perl wouldn't know to SvREFCNT_dec() this GV if
+     * it destroys the containing CV. We use a MAGIC with an empty vtable
+     * simply for the side-effect of using MGf_REFCOUNTED to store the
+     * actually-counted reference to the GV.
+     */
+    mg = SvMAGIC(cv);
+    while (mg && mg->mg_virtual != &subname_vtbl)
+        mg = mg->mg_moremagic;
+    if (!mg) {
+        Newxz(mg, 1, MAGIC);
+        mg->mg_moremagic = SvMAGIC(cv);
+        mg->mg_type = PERL_MAGIC_ext;
+        mg->mg_virtual = &subname_vtbl;
+        SvMAGIC_set(cv, mg);
+    }
+    if (mg->mg_flags & MGf_REFCOUNTED)
+        SvREFCNT_dec(mg->mg_obj);
+    mg->mg_flags |= MGf_REFCOUNTED;
+    mg->mg_obj = (SV *) gv;
+    SvRMAGICAL_on(cv);
+    CvANON_off(cv);
+#ifndef CvGV_set
+    CvGV(cv) = gv;
+#else
+    CvGV_set(cv, gv);
+#endif
+    PUSHs(sub);
+
+void
+subname(code)
+    SV *code
+PREINIT:
+    CV *cv;
+    GV *gv;
+PPCODE:
+    if (!SvROK(code) && SvGMAGICAL(code))
+        mg_get(code);
+
+    if(!SvROK(code) || SvTYPE(cv = (CV *)SvRV(code)) != SVt_PVCV)
+        croak("Not a subroutine reference");
+
+    if(!(gv = CvGV(cv)))
+        XSRETURN(0);
+
+    mPUSHs(newSVpvf("%s::%s", HvNAME(GvSTASH(gv)), GvNAME(gv)));
+    XSRETURN(1);
+
 BOOT:
 {
     HV *lu_stash = gv_stashpvn("List::Util", 10, TRUE);
diff --git a/cpan/Scalar-List-Utils/lib/List/Util.pm b/cpan/Scalar-List-Utils/lib/List/Util.pm
index c99bcd41ee..9296221b15 100644
--- a/cpan/Scalar-List-Utils/lib/List/Util.pm
+++ b/cpan/Scalar-List-Utils/lib/List/Util.pm
@@ -14,7 +14,7 @@ our @EXPORT_OK  = qw(
   all any first min max minstr maxstr none notall product reduce sum sum0 shuffle
   pairmap pairgrep pairfirst pairs pairkeys pairvalues
 );
-our $VERSION    = "1.39";
+our $VERSION    = "1.40";
 our $XS_VERSION = $VERSION;
 $VERSION    = eval $VERSION;
 
@@ -110,7 +110,9 @@ C<undef> being returned
 The remaining list-reduction functions are all specialisations of this generic
 idea.
 
-=head2 $b = any { BLOCK } @list
+=head2 any
+
+    my $bool = any { BLOCK } @list;
 
 I<Since version 1.33.>
 
@@ -126,26 +128,34 @@ instead, as it can short-circuit after the first true result.
         # at least one string has more than 10 characters
     }
 
-=head2 $b = all { BLOCK } @list
+=head2 all
+
+    my $bool = all { BLOCK } @list;
 
 I<Since version 1.33.>
 
-Similar to C<any>, except that it requires all elements of the C<@list> to make
-the C<BLOCK> return true. If any element returns false, then it returns false.
-If the C<BLOCK> never returns false or the C<@list> was empty then it returns
-true.
+Similar to L</any>, except that it requires all elements of the C<@list> to
+make the C<BLOCK> return true. If any element returns false, then it returns
+false. If the C<BLOCK> never returns false or the C<@list> was empty then it
+returns true.
+
+=head2 none
 
-=head2 $b = none { BLOCK } @list
+=head2 notall
 
-=head2 $b = notall { BLOCK } @list
+    my $bool = none { BLOCK } @list;
+
+    my $bool = notall { BLOCK } @list;
 
 I<Since version 1.33.>
 
-Similar to C<any> and C<all>, but with the return sense inverted. C<none>
-returns true only if no value in the LIST causes the BLOCK to return true, and
-C<notall> returns true only if not all of the values do.
+Similar to L</any> and L</all>, but with the return sense inverted. C<none>
+returns true only if no value in the C<@list> causes the C<BLOCK> to return
+true, and C<notall> returns true only if not all of the values do.
+
+=head2 first
 
-=head2 $val = first { BLOCK } @list
+    my $val = first { BLOCK } @list;
 
 Similar to C<grep> in that it evaluates C<BLOCK> setting C<$_> to each element
 of C<@list> in turn. C<first> returns the first element where the result from
@@ -156,7 +166,9 @@ then C<undef> is returned.
     $foo = first { $_ > $value } @list    # first value in @list which
                                           # is greater than $value
 
-=head2 $num = max @list
+=head2 max
+
+    my $num = max @list;
 
 Returns the entry in the list with the highest numerical value. If the list is
 empty then C<undef> is returned.
@@ -165,9 +177,11 @@ empty then C<undef> is returned.
     $foo = max 3,9,12               # 12
     $foo = max @bar, @baz           # whatever
 
-=head2 $str = maxstr @list
+=head2 maxstr
+
+    my $str = maxstr @list;
 
-Similar to C<max>, but treats all the entries in the list as strings and
+Similar to L</max>, but treats all the entries in the list as strings and
 returns the highest string as defined by the C<gt> operator. If the list is
 empty then C<undef> is returned.
 
@@ -175,18 +189,22 @@ empty then C<undef> is returned.
     $foo = maxstr "hello","world"   # "world"
     $foo = maxstr @bar, @baz        # whatever
 
-=head2 $num = min @list
+=head2 min
+
+    my $num = min @list;
 
-Similar to C<max> but returns the entry in the list with the lowest numerical
+Similar to L</max> but returns the entry in the list with the lowest numerical
 value. If the list is empty then C<undef> is returned.
 
     $foo = min 1..10                # 1
     $foo = min 3,9,12               # 3
     $foo = min @bar, @baz           # whatever
 
-=head2 $str = minstr @list
+=head2 minstr
 
-Similar to C<min>, but treats all the entries in the list as strings and
+    my $str = minstr @list;
+
+Similar to L</min>, but treats all the entries in the list as strings and
 returns the lowest string as defined by the C<lt> operator. If the list is
 empty then C<undef> is returned.
 
@@ -194,7 +212,9 @@ empty then C<undef> is returned.
     $foo = minstr "hello","world"   # "hello"
     $foo = minstr @bar, @baz        # whatever
 
-=head2 $num = product @list
+=head2 product
+
+    my $num = product @list;
 
 I<Since version 1.35.>
 
@@ -204,7 +224,9 @@ empty then C<1> is returned.
     $foo = product 1..10            # 3628800
     $foo = product 3,9,12           # 324
 
-=head2 $num_or_undef = sum @list
+=head2 sum
+
+    my $num_or_undef = sum @list;
 
 Returns the numerical sum of all the elements in C<@list>. For backwards
 compatibility, if C<@list> is empty then C<undef> is returned.
@@ -213,12 +235,14 @@ compatibility, if C<@list> is empty then C<undef> is returned.
     $foo = sum 3,9,12               # 24
     $foo = sum @bar, @baz           # whatever
 
-=head2 $num = sum0 @list
+=head2 sum0
+
+    my $num = sum0 @list;
 
 I<Since version 1.26.>
 
-Similar to C<sum>, except this returns 0 when given an empty list, rather than
-C<undef>.
+Similar to L</sum>, except this returns 0 when given an empty list, rather
+than C<undef>.
 
 =cut
 
@@ -232,9 +256,11 @@ value - nor even do they require that the first of each pair be a plain string.
 
 =cut
 
-=head2 @kvlist = pairgrep { BLOCK } @kvlist
+=head2 pairgrep
+
+    my @kvlist = pairgrep { BLOCK } @kvlist;
 
-=head2 $count = pairgrep { BLOCK } @kvlist
+    my $count = pairgrep { BLOCK } @kvlist;
 
 I<Since version 1.29.>
 
@@ -254,13 +280,15 @@ As with C<grep> aliasing C<$_> to list elements, C<pairgrep> aliases C<$a> and
 C<$b> to elements of the given list. Any modifications of it by the code block
 will be visible to the caller.
 
-=head2 ( $key, $val ) = pairfirst { BLOCK } @kvlist
+=head2 pairfirst
 
-=head2 $found = pairfirst { BLOCK } @kvlist
+    my ( $key, $val ) = pairfirst { BLOCK } @kvlist;
+
+    my $found = pairfirst { BLOCK } @kvlist;
 
 I<Since version 1.30.>
 
-Similar to the C<first> function, but interprets the given list as an
+Similar to the L</first> function, but interprets the given list as an
 even-sized list of pairs. It invokes the C<BLOCK> multiple times, in scalar
 context, with C<$a> and C<$b> set to successive pairs of values from the
 C<@kvlist>.
@@ -276,9 +304,11 @@ As with C<grep> aliasing C<$_> to list elements, C<pairfirst> aliases C<$a> and
 C<$b> to elements of the given list. Any modifications of it by the code block
 will be visible to the caller.
 
-=head2 @list = pairmap { BLOCK } @kvlist
+=head2 pairmap
+
+    my @list = pairmap { BLOCK } @kvlist;
 
-=head2 $count = pairmap { BLOCK } @kvlist
+    my $count = pairmap { BLOCK } @kvlist;
 
 I<Since version 1.29.>
 
@@ -299,7 +329,9 @@ will be visible to the caller.
 
 See L</KNOWN BUGS> for a known-bug with C<pairmap>, and a workaround.
 
-=head2 @pairs = pairs @kvlist
+=head2 pairs
+
+    my @pairs = pairs @kvlist;
 
 I<Since version 1.29.>
 
@@ -325,7 +357,9 @@ the two methods C<key> and C<value>. The following code is equivalent:
        ...
     }
 
-=head2 @keys = pairkeys @kvlist
+=head2 pairkeys
+
+    my @keys = pairkeys @kvlist;
 
 I<Since version 1.29.>
 
@@ -335,7 +369,9 @@ It is a more efficient version of
 
     @keys = pairmap { $a } @kvlist
 
-=head2 @values = pairvalues @kvlist
+=head2 pairvalues
+
+    my @values = pairvalues @kvlist;
 
 I<Since version 1.29.>
 
@@ -351,7 +387,9 @@ It is a more efficient version of
 
 =cut
 
-=head2 @values = shuffle @values
+=head2 shuffle
+
+    my @values = shuffle @values;
 
 Returns the values of the input in a random order
 
@@ -365,7 +403,7 @@ Returns the values of the input in a random order
 
 L<https://rt.cpan.org/Ticket/Display.html?id=95409>
 
-If the block of code given to C<pairmap> contains lexical variables that are
+If the block of code given to L</pairmap> 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:
diff --git a/cpan/Scalar-List-Utils/lib/List/Util/XS.pm b/cpan/Scalar-List-Utils/lib/List/Util/XS.pm
index e605d88e3d..ad45203b7d 100644
--- a/cpan/Scalar-List-Utils/lib/List/Util/XS.pm
+++ b/cpan/Scalar-List-Utils/lib/List/Util/XS.pm
@@ -2,7 +2,7 @@ package List::Util::XS;
 use strict;
 use List::Util;
 
-our $VERSION = "1.39";       # FIXUP
+our $VERSION = "1.40";       # FIXUP
 $VERSION = eval $VERSION;    # FIXUP
 
 1;
diff --git a/cpan/Scalar-List-Utils/lib/Scalar/Util.pm b/cpan/Scalar-List-Utils/lib/Scalar/Util.pm
index 06d3660469..043852a907 100644
--- a/cpan/Scalar-List-Utils/lib/Scalar/Util.pm
+++ b/cpan/Scalar-List-Utils/lib/Scalar/Util.pm
@@ -14,9 +14,10 @@ our @ISA       = qw(Exporter);
 our @EXPORT_OK = qw(
   blessed refaddr reftype weaken unweaken isweak
 
-  dualvar isdual isvstring looks_like_number openhandle readonly set_prototype tainted
+  dualvar isdual isvstring looks_like_number openhandle readonly set_prototype
+  tainted
 );
-our $VERSION    = "1.39";
+our $VERSION    = "1.40";
 $VERSION   = eval $VERSION;
 
 our @EXPORT_FAIL;
@@ -45,6 +46,13 @@ sub export_fail {
   @_;
 }
 
+# set_prototype has been moved to Sub::Util with a different interface
+sub set_prototype(&$)
+{
+  my ( $code, $proto ) = @_;
+  return Sub::Util::set_prototype( $proto, $code );
+}
+
 1;
 
 __END__
@@ -75,7 +83,9 @@ By default C<Scalar::Util> does not export any subroutines.
 
 The following functions all perform some useful activity on reference values.
 
-=head2 $pkg = blessed( $ref )
+=head2 blessed
+
+    my $pkg = blessed( $ref );
 
 If C<$ref> is a blessed reference the name of the package that it is blessed
 into is returned. Otherwise C<undef> is returned.
@@ -92,7 +102,9 @@ into is returned. Otherwise C<undef> is returned.
 Take care when using this function simply as a truth test (such as in
 C<if(blessed $ref)...>) because the package name C<"0"> is defined yet false.
 
-=head2 $addr = refaddr( $ref )
+=head2 refaddr
+
+    my $addr = refaddr( $ref );
 
 If C<$ref> is reference the internal memory address of the referenced value is
 returned as a plain integer. Otherwise C<undef> is returned.
@@ -104,7 +116,9 @@ returned as a plain integer. Otherwise C<undef> is returned.
     $obj  = bless {}, "Foo";
     $addr = refaddr $obj;               # eg 88123488
 
-=head2 $type = reftype( $ref )
+=head2 reftype
+
+    my $type = reftype( $ref );
 
 If C<$ref> is a reference the basic Perl type of the variable referenced is
 returned as a plain string (such as C<ARRAY> or C<HASH>). Otherwise C<undef>
@@ -117,9 +131,11 @@ is returned.
     $obj  = bless {}, "Foo";
     $type = reftype $obj;               # HASH
 
-=head2 weaken( REF )
+=head2 weaken
 
-The lvalue C<REF> will be turned into a weak reference. This means that it
+    weaken( $ref );
+
+The lvalue C<$ref> will be turned into a weak reference. This means that it
 will not hold a reference count on the object it references. Also when the
 reference count on that object reaches zero, the reference will be set to
 undef. This function mutates the lvalue passed as its argument and returns no
@@ -154,14 +170,16 @@ references to objects will be strong, causing the remaining objects to never be
 destroyed because there is now always a strong reference to them in the @object
 array.
 
-=head2 unweaken( REF )
+=head2 unweaken
+
+    unweaken( $ref );
 
 I<Since version 1.36.>
 
 The lvalue C<REF> will be turned from a weak reference back into a normal
 (strong) reference again. This function mutates the lvalue passed as its
 argument and returns no value. This undoes the action performed by
-C<weaken()>.
+L</weaken>.
 
 This function is slightly neater and more convenient than the
 otherwise-equivalent code
@@ -173,7 +191,9 @@ otherwise-equivalent code
 (because in particular, simply assigning a weak reference back to itself does
 not work to unweaken it; C<$REF = $REF> does not work).
 
-=head2 $weak = isweak( $ref )
+=head2 isweak
+
+    my $weak = isweak( $ref );
 
 Returns true if C<$ref> is a weak reference.
 
@@ -189,7 +209,9 @@ B<NOTE>: Copying a weak reference creates a normal, strong, reference.
 
 =head1 OTHER FUNCTIONS
 
-=head2 $var = dualvar( $num, $string )
+=head2 dualvar
+
+    my $var = dualvar( $num, $string );
 
 Returns a scalar that has the value C<$num> in a numeric context and the value
 C<$string> in a string context.
@@ -198,7 +220,9 @@ C<$string> in a string context.
     $num = $foo + 2;                    # 12
     $str = $foo . " world";             # Hello world
 
-=head2 $dual = isdual( $var )
+=head2 isdual
+
+    my $dual = isdual( $var );
 
 I<Since version 1.26.>
 
@@ -228,7 +252,9 @@ You can capture its numeric and string content using:
     $err = dualvar $!, $!;
     $dual = isdual($err);               # true
 
-=head2 $vstring = isvstring( $var )
+=head2 isvstring
+
+    my $vstring = isvstring( $var );
 
 If C<$var> is a scalar which was coded as a vstring the result is true.
 
@@ -236,12 +262,16 @@ If C<$var> is a scalar which was coded as a vstring the result is true.
     $fmt  = isvstring($vs) ? "%vd" : "%s"; #true
     printf($fmt,$vs);
 
-=head2 $isnum = looks_like_number( $var )
+=head2 looks_like_number
+
+    my $isnum = looks_like_number( $var );
 
 Returns true if perl thinks C<$var> is a number. See
 L<perlapi/looks_like_number>.
 
-=head2 $fh = openhandle( $fh )
+=head2 openhandle
+
+    my $fh = openhandle( $fh );
 
 Returns C<$fh> itself if C<$fh> may be used as a filehandle and is open, or is
 is a tied handle. Otherwise C<undef> is returned.
@@ -251,7 +281,9 @@ is a tied handle. Otherwise C<undef> is returned.
     $fh = openhandle(*NOTOPEN);         # undef
     $fh = openhandle("scalar");         # undef
 
-=head2 $ro = readonly( $var )
+=head2 readonly
+
+    my $ro = readonly( $var );
 
 Returns true if C<$var> is readonly.
 
@@ -260,14 +292,18 @@ Returns true if C<$var> is readonly.
     $readonly = foo($bar);              # false
     $readonly = foo(0);                 # true
 
-=head2 $code = set_prototype( $code, $prototype )
+=head2 set_prototype
+
+    my $code = set_prototype( $code, $prototype );
 
 Sets the prototype of the function given by the C<$code> reference, or deletes
 it if C<$prototype> is C<undef>. Returns the C<$code> reference itself.
 
     set_prototype \&foo, '$$';
 
-=head2 $t = tainted( $var )
+=head2 tainted
+
+    my $t = tainted( $var );
 
 Return true if C<$var> is tainted.
 
@@ -283,12 +319,12 @@ Module use may give one of the following errors during import.
 =item Weak references are not implemented in the version of perl
 
 The version of perl that you are using does not implement weak references, to
-use C<isweak> or C<weaken> you will need to use a newer release of perl.
+use L</isweak> or L</weaken> you will need to use a newer release of perl.
 
 =item Vstrings are not implemented in the version of perl
 
 The version of perl that you are using does not implement Vstrings, to use
-C<isvstring> you will need to use a newer release of perl.
+L</isvstring> you will need to use a newer release of perl.
 
 =item C<NAME> is only available with the XS version of Scalar::Util
 
@@ -316,10 +352,15 @@ Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved.
 This program is free software; you can redistribute it and/or modify it
 under the same terms as Perl itself.
 
-Except weaken and isweak which are
+Additionally L</weaken> and L</isweak> which are
 
 Copyright (c) 1999 Tuomas J. Lukka <lukka@iki.fi>. All rights reserved.
 This program is free software; you can redistribute it and/or modify it
 under the same terms as perl itself.
 
+Copyright (C) 2004, 2008  Matthijs van Duin.  All rights reserved.
+Copyright (C) 2014 cPanel Inc.  All rights reserved.
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
 =cut
diff --git a/cpan/Scalar-List-Utils/lib/Sub/Util.pm b/cpan/Scalar-List-Utils/lib/Sub/Util.pm
new file mode 100644
index 0000000000..6d03163c11
--- /dev/null
+++ b/cpan/Scalar-List-Utils/lib/Sub/Util.pm
@@ -0,0 +1,147 @@
+# Copyright (c) 2014 Paul Evans <leonerd@leonerd.org.uk>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package Sub::Util;
+
+use strict;
+use warnings;
+
+require Exporter;
+require List::Util; # as it has the XS
+
+our @ISA = qw( Exporter );
+our @EXPORT_OK = qw(
+  prototype set_prototype
+  subname set_subname
+);
+
+our $VERSION    = "1.40";
+$VERSION   = eval $VERSION;
+
+=head1 NAME
+
+Sub::Util - A selection of utility subroutines for subs and CODE references
+
+=head1 SYNOPSIS
+
+    use Sub::Util qw( set_prototype subname set_subname );
+
+=head1 DESCRIPTION
+
+C<Sub::Util> contains a selection of utility subroutines that are useful for
+operating on subs and CODE references.
+
+The rationale for inclusion in this module is that the function performs some
+work for which an XS implementation is essential because it cannot be
+implemented in Pure Perl, and which is sufficiently-widely used across CPAN
+that its popularity warrants inclusion in a core module, which this is.
+
+=cut
+
+=head1 FUNCTIONS
+
+=cut
+
+=head2 prototype
+
+    my $proto = prototype( $code )
+
+Returns the prototype of the given C<$code> reference, if it has one, as a
+string. This is the same as the C<CORE::prototype> operator; it is included
+here simply for symmetry and completeness with the other functions.
+
+=cut
+
+sub prototype
+{
+  my ( $code ) = @_;
+  return CORE::prototype( $code );
+}
+
+=head2 set_prototype
+
+    my $code = set_prototype $prototype, $code;
+
+I<Since version 1.40.>
+
+Sets the prototype of the function given by the C<$code> reference, or deletes
+it if C<$prototype> is C<undef>. Returns the C<$code> reference itself.
+
+I<Caution>: This function takes arguments in a different order to the previous
+copy of the code from C<Scalar::Util>. This is to match the order of
+C<set_subname>, and other potential additions in this file. This order has
+been chosen as it allows a neat and simple chaining of other
+C<Sub::Util::set_*> functions as might become available, such as:
+
+ my $code =
+    set_subname   name_here =>
+    set_prototype '&@'      =>
+    set_attribute ':lvalue' =>
+       sub { ...... };
+
+=cut
+
+=head2 subname
+
+    my $name = subname( $code )
+
+I<Since version 1.40.>
+
+Returns the name of the given C<$code> reference, if it has one. Normal named
+subs will give a fully-qualified name consisting of the package and the
+localname separated by C<::>. Anonymous code references will give C<__ANON__>
+as the localname. If a name has been set using L</set_subname>, this name will
+be returned instead.
+
+This function was inspired by C<sub_fullname> from L<Sub::Identify>. The
+remaining functions that C<Sub::Identify> implements can easily be emulated
+using regexp operations, such as
+
+ sub get_code_info { return (subname $_[0]) =~ m/^(.+)::(.+?)$/ }
+ sub sub_name      { return (get_code_info $_[0])[0] }
+ sub stash_name    { return (get_code_info $_[0])[1] }
+
+I<Users of Sub::Name beware>: This function is B<not> the same as
+C<Sub::Name::subname>; it returns the existing name of the sub rather than
+changing it. To set or change a name, see instead L</set_subname>.
+
+=cut
+
+=head2 set_subname
+
+    my $code = set_subname $name, $code;
+
+I<Since version 1.40.>
+
+Sets the name of the function given by the C<$code> reference. Returns the
+C<$code> reference itself. If the C<$name> is unqualified, the package of the
+caller is used to qualify it.
+
+This is useful for applying names to anonymous CODE references so that stack
+traces and similar situations, to give a useful name rather than having the
+default of C<__ANON__>. Note that this name is only used for this situation;
+the C<set_subname> will not install it into the symbol table; you will have to
+do that yourself if required.
+
+However, since the name is not used by perl except as the return value of
+C<caller>, for stack traces or similar, there is no actual requirement that
+the name be syntactically valid as a perl function name. This could be used to
+attach extra information that could be useful in debugging stack traces.
+
+This function was copied from C<Sub::Name::subname> and renamed to the naming
+convention of this module.
+
+=cut
+
+=head1 AUTHOR
+
+The general structure of this module was written by Paul Evans
+<leonerd@leonerd.org.uk>.
+
+The XS implementation of L</set_subname> was copied from L<Sub::Name> by
+Matthijs van Duin <xmath@cpan.org>
+
+=cut
+
+1;
diff --git a/cpan/Scalar-List-Utils/t/prototype.t b/cpan/Scalar-List-Utils/t/prototype.t
new file mode 100644
index 0000000000..32549a8ead
--- /dev/null
+++ b/cpan/Scalar-List-Utils/t/prototype.t
@@ -0,0 +1,40 @@
+#!./perl
+
+use strict;
+use warnings;
+
+use Sub::Util qw( prototype set_prototype );
+use Test::More tests => 13;
+
+sub f { }
+is( prototype('f'), undef, 'no prototype');
+is( CORE::prototype('f'), undef, 'no prototype from CORE');
+
+my $r = set_prototype('$', \&f);
+is( prototype('f'), '$', 'prototype');
+is( CORE::prototype('f'), '$', 'prototype from CORE');
+is( $r,   \&f, 'return value');
+
+set_prototype(undef, \&f);
+is( prototype('f'), undef, 'remove prototype');
+
+set_prototype('', \&f);
+is( prototype('f'), '', 'empty prototype');
+
+sub g (@) { }
+is( prototype('g'), '@', '@ prototype');
+
+set_prototype(undef, \&g);
+is( prototype('g'), undef, 'remove prototype');
+
+sub stub;
+is( prototype('stub'), undef, 'non existing sub');
+
+set_prototype('$$$', \&stub);
+is( prototype('stub'), '$$$', 'change non existing sub');
+
+sub f_decl ($$$$);
+is( prototype('f_decl'), '$$$$', 'forward declaration');
+
+set_prototype('\%', \&f_decl);
+is( prototype('f_decl'), '\%', 'change forward declaration');
diff --git a/cpan/Scalar-List-Utils/t/proto.t b/cpan/Scalar-List-Utils/t/scalarutil-proto.t
index e9b653a666..e9b653a666 100644
--- a/cpan/Scalar-List-Utils/t/proto.t
+++ b/cpan/Scalar-List-Utils/t/scalarutil-proto.t
diff --git a/cpan/Scalar-List-Utils/t/subname.t b/cpan/Scalar-List-Utils/t/subname.t
new file mode 100644
index 0000000000..1bf8a9f698
--- /dev/null
+++ b/cpan/Scalar-List-Utils/t/subname.t
@@ -0,0 +1,81 @@
+use strict;
+use warnings;
+
+BEGIN { $^P |= 0x210 }
+
+use Test::More tests => 18;
+
+use B::Deparse;
+use Sub::Util qw( subname set_subname );
+
+{
+  sub localfunc {}
+  sub fully::qualified::func {}
+
+  is(subname(\&subname), "Sub::Util::subname",
+    'subname of \&subname');
+  is(subname(\&localfunc), "main::localfunc",
+    'subname of \&localfunc');
+  is(subname(\&fully::qualified::func), "fully::qualified::func",
+    'subname of \&fully::qualfied::func');
+
+  # Because of the $^P debug flag, we'll get [file:line] as well
+  like(subname(sub {}), qr/^main::__ANON__\[.+:\d+\]$/, 'subname of anon sub');
+
+  ok(!eval { subname([]) }, 'subname [] dies');
+}
+
+my $x = set_subname foo => sub { (caller 0)[3] };
+my $line = __LINE__ - 1;
+my $file = __FILE__;
+my $anon = $DB::sub{"main::__ANON__[${file}:${line}]"};
+
+is($x->(), "main::foo");
+
+{
+  package Blork;
+
+  use Sub::Util qw( set_subname );
+
+  set_subname " Bar!", $x;
+  ::is($x->(), "Blork:: Bar!");
+
+  set_subname "Foo::Bar::Baz", $x;
+  ::is($x->(), "Foo::Bar::Baz");
+
+  set_subname "set_subname (dynamic $_)", \&set_subname  for 1 .. 3;
+
+  for (4 .. 5) {
+      set_subname "Dynamic $_", $x;
+      ::is($x->(), "Blork::Dynamic $_");
+  }
+
+  ::is($DB::sub{"main::foo"}, $anon);
+
+  for (4 .. 5) {
+      ::is($DB::sub{"Blork::Dynamic $_"}, $anon);
+  }
+
+  for ("Blork:: Bar!", "Foo::Bar::Baz") {
+      ::is($DB::sub{$_}, $anon);
+  }
+}
+
+# RT42725
+{
+  my $source = eval {
+      B::Deparse->new->coderef2text(set_subname foo => sub{ @_ });
+  };
+
+  ok !$@;
+
+  like $source, qr/\@\_/;
+}
+
+# subname of set_subname
+{
+  is(subname(set_subname "my-scary-name-here", sub {}), "main::my-scary-name-here",
+    'subname of set_subname');
+}
+
+# vim: ft=perl