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 5package Sub::Util; 6 7use strict; 8use warnings; 9 10require Exporter; 11 12our @ISA = qw( Exporter ); 13our @EXPORT_OK = qw( 14 prototype set_prototype 15 subname set_subname 16); 17 18our $VERSION = "1.63"; 19$VERSION =~ tr/_//d; 20 21require List::Util; # as it has the XS 22List::Util->VERSION( $VERSION ); # Ensure we got the right XS version (RT#100863) 23 24=head1 NAME 25 26Sub::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 34C<Sub::Util> contains a selection of utility subroutines that are useful for 35operating on subs and CODE references. 36 37The rationale for inclusion in this module is that the function performs some 38work for which an XS implementation is essential because it cannot be 39implemented in Pure Perl, and which is sufficiently-widely used across CPAN 40that 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 52I<Since version 1.40.> 53 54Returns the prototype of the given C<$code> reference, if it has one, as a 55string. This is the same as the C<CORE::prototype> operator; it is included 56here simply for symmetry and completeness with the other functions. 57 58=cut 59 60sub 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 70I<Since version 1.40.> 71 72Sets the prototype of the function given by the C<$code> reference, or deletes 73it if C<$prototype> is C<undef>. Returns the C<$code> reference itself. 74 75I<Caution>: This function takes arguments in a different order to the previous 76copy of the code from C<Scalar::Util>. This is to match the order of 77C<set_subname>, and other potential additions in this file. This order has 78been chosen as it allows a neat and simple chaining of other 79C<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 93I<Since version 1.40.> 94 95Returns the name of the given C<$code> reference, if it has one. Normal named 96subs will give a fully-qualified name consisting of the package and the 97localname separated by C<::>. Anonymous code references will give C<__ANON__> 98as the localname. If the package the code was compiled in has been deleted 99(e.g. using C<delete_package> from L<Symbol>), C<__ANON__> will be returned as 100the package name. If a name has been set using L</set_subname>, this name will be 101returned instead. 102 103This function was inspired by C<sub_fullname> from L<Sub::Identify>. The 104remaining functions that C<Sub::Identify> implements can easily be emulated 105using regexp operations, such as 106 107 sub get_code_info { return (subname $_[0]) =~ m/^(.+)::(.*?)$/ } 108 sub sub_name { return (get_code_info $_[0])[0] } 109 sub stash_name { return (get_code_info $_[0])[1] } 110 111I<Users of Sub::Name beware>: This function is B<not> the same as 112C<Sub::Name::subname>; it returns the existing name of the sub rather than 113changing it. To set or change a name, see instead L</set_subname>. 114 115=cut 116 117=head2 set_subname 118 119 my $code = set_subname $name, $code; 120 121I<Since version 1.40.> 122 123Sets the name of the function given by the C<$code> reference. Returns the 124C<$code> reference itself. If the C<$name> is unqualified, the package of the 125caller is used to qualify it. 126 127This is useful for applying names to anonymous CODE references so that stack 128traces and similar situations, to give a useful name rather than having the 129default of C<__ANON__>. Note that this name is only used for this situation; 130the C<set_subname> will not install it into the symbol table; you will have to 131do that yourself if required. 132 133However, since the name is not used by perl except as the return value of 134C<caller>, for stack traces or similar, there is no actual requirement that 135the name be syntactically valid as a perl function name. This could be used to 136attach extra information that could be useful in debugging stack traces. 137 138This function was copied from C<Sub::Name::subname> and renamed to the naming 139convention of this module. 140 141=cut 142 143=head1 AUTHOR 144 145The general structure of this module was written by Paul Evans 146<leonerd@leonerd.org.uk>. 147 148The XS implementation of L</set_subname> was copied from L<Sub::Name> by 149Matthijs van Duin <xmath@cpan.org> 150 151=cut 152 1531; 154