summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/tlperl/lib/Sub
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /systems/texlive/tlnet/tlpkg/tlperl/lib/Sub
Initial commit
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/lib/Sub')
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Sub/Util.pm151
1 files changed, 151 insertions, 0 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Sub/Util.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Sub/Util.pm
new file mode 100644
index 0000000000..edcc6544f6
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Sub/Util.pm
@@ -0,0 +1,151 @@
+# 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;
+
+our @ISA = qw( Exporter );
+our @EXPORT_OK = qw(
+ prototype set_prototype
+ subname set_subname
+);
+
+our $VERSION = "1.50";
+$VERSION = eval $VERSION;
+
+require List::Util; # as it has the XS
+List::Util->VERSION( $VERSION ); # Ensure we got the right XS version (RT#100863)
+
+=head1 NAME
+
+Sub::Util - A selection of utility subroutines for subs and CODE references
+
+=head1 SYNOPSIS
+
+ use Sub::Util qw( prototype 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 )
+
+I<Since version 1.40.>
+
+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;