File Coverage

blib/lib/Sub/Util.pm
Criterion Covered Total %
statement 6 8 75.0
branch n/a
condition n/a
subroutine 2 3 66.6
pod 1 1 100.0
total 9 12 75.0


line stmt bran cond sub pod time code
1             # Copyright (c) 2014 Paul Evans . 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 4     4   121125 use strict;
  4         29  
  4         109  
8 4     4   19 use warnings;
  4         6  
  4         728  
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.61";
19             $VERSION =~ tr/_//d;
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 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
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 operator; it is included
56             here simply for symmetry and completeness with the other functions.
57              
58             =cut
59              
60             sub prototype
61             {
62 0     0 1   my ( $code ) = @_;
63 0           return CORE::prototype( $code );
64             }
65              
66             =head2 set_prototype
67              
68             my $code = set_prototype $prototype, $code;
69              
70             I
71              
72             Sets the prototype of the function given by the C<$code> reference, or deletes
73             it if C<$prototype> is C. Returns the C<$code> reference itself.
74              
75             I: This function takes arguments in a different order to the previous
76             copy of the code from C. This is to match the order of
77             C, 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 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
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 the package the code was compiled in has been deleted
99             (e.g. using C from L), C<__ANON__> will be returned as
100             the package name. If a name has been set using L, this name will be
101             returned instead.
102              
103             This function was inspired by C from L. The
104             remaining functions that C implements can easily be emulated
105             using 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              
111             I: This function is B the same as
112             C; it returns the existing name of the sub rather than
113             changing it. To set or change a name, see instead L.
114              
115             =cut
116              
117             =head2 set_subname
118              
119             my $code = set_subname $name, $code;
120              
121             I
122              
123             Sets the name of the function given by the C<$code> reference. Returns the
124             C<$code> reference itself. If the C<$name> is unqualified, the package of the
125             caller is used to qualify it.
126              
127             This is useful for applying names to anonymous CODE references so that stack
128             traces and similar situations, to give a useful name rather than having the
129             default of C<__ANON__>. Note that this name is only used for this situation;
130             the C will not install it into the symbol table; you will have to
131             do that yourself if required.
132              
133             However, since the name is not used by perl except as the return value of
134             C, for stack traces or similar, there is no actual requirement that
135             the name be syntactically valid as a perl function name. This could be used to
136             attach extra information that could be useful in debugging stack traces.
137              
138             This function was copied from C and renamed to the naming
139             convention of this module.
140              
141             =cut
142              
143             =head1 AUTHOR
144              
145             The general structure of this module was written by Paul Evans
146             .
147              
148             The XS implementation of L was copied from L by
149             Matthijs van Duin
150              
151             =cut
152              
153             1;