Commit | Line | Data |
---|---|---|
d81c2d6a CBW |
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; | |
d81c2d6a CBW |
11 | |
12 | our @ISA = qw( Exporter ); | |
13 | our @EXPORT_OK = qw( | |
14 | prototype set_prototype | |
15 | subname set_subname | |
16 | ); | |
17 | ||
f5ac400e | 18 | our $VERSION = "1.46_01"; |
d81c2d6a CBW |
19 | $VERSION = eval $VERSION; |
20 | ||
3d58dd24 SH |
21 | require List::Util; # as it has the XS |
22 | List::Util->VERSION( $VERSION ); # Ensure we got the right XS version (RT#100863) | |
23 | ||
d81c2d6a CBW |
24 | =head1 NAME |
25 | ||
26 | Sub::Util - A selection of utility subroutines for subs and CODE references | |
27 | ||
28 | =head1 SYNOPSIS | |
29 | ||
46274848 | 30 | use Sub::Util qw( prototype set_prototype subname set_subname ); |
d81c2d6a CBW |
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 | ||
46274848 SH |
52 | I<Since version 1.40.> |
53 | ||
d81c2d6a CBW |
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; |