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