cpan/Scalar-List-Utils/lib/Sub/Util.pm

   1 # Copyright (c) 2014 Paul Evans <leonerd@leonerd.org.uk>. All rights reserved.
   2 # This program is free software; you can redistribute it and/or
   3 # modify it under the same terms as Perl itself.
   4
   5 package Sub::Util;
   6
   7 use strict;
   8 use warnings;
   9
  10 require Exporter;
  11
  12 our @ISA = qw( Exporter );
  13 our @EXPORT_OK = qw(
  14   prototype set_prototype
  15   subname set_subname
  16 );
  17
  18 our $VERSION    = "1.42_01";
  19 $VERSION   = eval $VERSION;
  20
  21 require List::Util; # as it has the XS
  22 List::Util->VERSION( $VERSION ); # Ensure we got the right XS version (RT#100863)
  23
  24 =head1 NAME
  25
  26 Sub::Util - A selection of utility subroutines for subs and CODE references
  27
  28 =head1 SYNOPSIS
  29
  30     use Sub::Util qw( prototype set_prototype subname set_subname );
  31
  32 =head1 DESCRIPTION
  33
  34 C<Sub::Util> contains a selection of utility subroutines that are useful for
  35 operating on subs and CODE references.
  36
  37 The rationale for inclusion in this module is that the function performs some
  38 work for which an XS implementation is essential because it cannot be
  39 implemented in Pure Perl, and which is sufficiently-widely used across CPAN
  40 that its popularity warrants inclusion in a core module, which this is.
  41
  42 =cut
  43
  44 =head1 FUNCTIONS
  45
  46 =cut
  47
  48 =head2 prototype
  49
  50     my $proto = prototype( $code )
  51
  52 I<Since version 1.40.>
  53
  54 Returns the prototype of the given C<$code> reference, if it has one, as a
  55 string. This is the same as the C<CORE::prototype> operator; it is included
  56 here simply for symmetry and completeness with the other functions.
  57
  58 =cut
  59
  60 sub prototype
  61 {
  62   my ( $code ) = @_;
  63   return CORE::prototype( $code );
  64 }
  65
  66 =head2 set_prototype
  67
  68     my $code = set_prototype $prototype, $code;
  69
  70 I<Since version 1.40.>
  71
  72 Sets the prototype of the function given by the C<$code> reference, or deletes
  73 it if C<$prototype> is C<undef>. Returns the C<$code> reference itself.
  74
  75 I<Caution>: This function takes arguments in a different order to the previous
  76 copy of the code from C<Scalar::Util>. This is to match the order of
  77 C<set_subname>, and other potential additions in this file. This order has
  78 been chosen as it allows a neat and simple chaining of other
  79 C<Sub::Util::set_*> functions as might become available, such as:
  80
  81  my $code =
  82     set_subname   name_here =>
  83     set_prototype '&@'      =>
  84     set_attribute ':lvalue' =>
  85        sub { ...... };
  86
  87 =cut
  88
  89 =head2 subname
  90
  91     my $name = subname( $code )
  92
  93 I<Since version 1.40.>
  94
  95 Returns the name of the given C<$code> reference, if it has one. Normal named
  96 subs will give a fully-qualified name consisting of the package and the
  97 localname separated by C<::>. Anonymous code references will give C<__ANON__>
  98 as the localname. If a name has been set using L</set_subname>, this name will
  99 be returned instead.
 100
 101 This function was inspired by C<sub_fullname> from L<Sub::Identify>. The
 102 remaining functions that C<Sub::Identify> implements can easily be emulated
 103 using regexp operations, such as
 104
 105  sub get_code_info { return (subname $_[0]) =~ m/^(.+)::(.+?)$/ }
 106  sub sub_name      { return (get_code_info $_[0])[0] }
 107  sub stash_name    { return (get_code_info $_[0])[1] }
 108
 109 I<Users of Sub::Name beware>: This function is B<not> the same as
 110 C<Sub::Name::subname>; it returns the existing name of the sub rather than
 111 changing it. To set or change a name, see instead L</set_subname>.
 112
 113 =cut
 114
 115 =head2 set_subname
 116
 117     my $code = set_subname $name, $code;
 118
 119 I<Since version 1.40.>
 120
 121 Sets the name of the function given by the C<$code> reference. Returns the
 122 C<$code> reference itself. If the C<$name> is unqualified, the package of the
 123 caller is used to qualify it.
 124
 125 This is useful for applying names to anonymous CODE references so that stack
 126 traces and similar situations, to give a useful name rather than having the
 127 default of C<__ANON__>. Note that this name is only used for this situation;
 128 the C<set_subname> will not install it into the symbol table; you will have to
 129 do that yourself if required.
 130
 131 However, since the name is not used by perl except as the return value of
 132 C<caller>, for stack traces or similar, there is no actual requirement that
 133 the name be syntactically valid as a perl function name. This could be used to
 134 attach extra information that could be useful in debugging stack traces.
 135
 136 This function was copied from C<Sub::Name::subname> and renamed to the naming
 137 convention of this module.
 138
 139 =cut
 140
 141 =head1 AUTHOR
 142
 143 The general structure of this module was written by Paul Evans
 144 <leonerd@leonerd.org.uk>.
 145
 146 The XS implementation of L</set_subname> was copied from L<Sub::Name> by
 147 Matthijs van Duin <xmath@cpan.org>
 148
 149 =cut
 150
 151 1;