File Coverage

blib/lib/meta.pm
Criterion Covered Total %
statement 12 12 100.0
branch 1 2 50.0
condition n/a
subroutine 4 4 100.0
pod n/a
total 17 18 94.4


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2023-2025 -- leonerd@leonerd.org.uk
5              
6             package meta 0.015;
7              
8 13     13   3240337 use v5.14;
  13         51  
9 13     13   82 use warnings;
  13         27  
  13         960  
10              
11             require XSLoader;
12             XSLoader::load( __PACKAGE__, our $VERSION );
13              
14 13     13   79 use Carp;
  13         21  
  13         5802  
15              
16             # Hackery to make warnings::warnif callable from XS, on perls too old to have
17             # warnif_at_level
18             $^V ge v5.28 or
19             *warnif_trampoline = sub { warnings::warnif(@_); };
20              
21             =head1 NAME
22              
23             C - meta-programming API
24              
25             =head1 SYNOPSIS
26              
27             =for highlighter language=perl
28              
29             use v5.14;
30             use meta;
31              
32             my $metapkg = meta::get_package( "MyApp::Some::Package" );
33              
34             $metapkg->add_symbol(
35             '&a_function' => sub { say "New function was created" }
36             );
37              
38             MyApp::Some::Package::a_function();
39              
40             =head1 DESCRIPTION
41              
42             This package provides an API for metaprogramming; that is, allowing code to
43             inspect or manipulate parts of its own program structure. Parts of the perl
44             interpreter itself can be accessed by means of "meta"-objects provided by this
45             package. Methods on these objects allow inspection of details, as well as
46             creating new items or removing existing ones.
47              
48             The intention of this API is to provide a nicer replacement for existing
49             tricks such as C and using globrefs, and also to be a more
50             consistent place to add new abilities, such as more APIs for inspection and
51             alteration of internal structures, metaprogramming around the new C<'class'>
52             feature, and other such uses.
53              
54             This module should be considered B; no API stability guarantees
55             are made at this time. Behaviour may be added, altered, or removed in later
56             versions. Once a workable API shape has been found, it is hoped that this
57             module will eventually become dual-life and shipped as part of Perl core, as
58             the implementation for PPC 0022. See the link in the L section.
59              
60             This module attempts to find a balance between accurately representing
61             low-level concepts within the current implementation of the Perl interpreter,
62             while also providing higher-level abstractions that provide useful behaviour
63             for code that uses it. One place this can be seen is the lower-level
64             L method, which directly maps to the way that GVs are stored in
65             symbol table stashes but requires the user to be aware of the GV-less
66             optimisised storage of CVs, as compared to the higher-level L
67             method which provides an abstraction over this complication and presents the
68             more useful but less accurate impression of separately named symbols that
69             neatly map to their values.
70              
71             I all the entry-point functions and constructors in
72             this module will provoke warnings in the C category. They
73             can be silenced by
74              
75             use meta;
76             no warnings 'meta::experimental';
77              
78             I the various C-prefixed variant accessor
79             methods print deprecation warnings. They are likely to be removed soon.
80              
81             =cut
82              
83             =head1 FUNCTIONS
84              
85             =head2 get_package
86              
87             $metapkg = meta::get_package( $pkgname );
88              
89             Returns a metapackage reference representing the given package name, creating
90             it if it did not previously exist.
91              
92             An alternative to C<< meta::package->get >> in a plain function style.
93              
94             =head2 get_this_package
95              
96             $metapkg = meta::get_this_package;
97              
98             I
99              
100             Returns a metapackage reference representing the package of the code that
101             called the function.
102              
103             Useful for performing meta-programming on the contents of a module during its
104             C or loading time. Equivalent to but more efficient than the following:
105              
106             meta::get_package(__PACKAGE__)
107              
108             =head2 for_reference
109              
110             $metasym = meta::for_reference( $ref );
111              
112             I
113              
114             Returns a metasymbol reference representing the glob, variable or subroutine
115             that is pointed to by the given reference.
116              
117             Note that passing in a reference to a symbol table hash ("stash") does not
118             result in a metapackage. For that you will have to call L or
119             similar.
120              
121             =cut
122              
123             =head1 METHODS ON C
124              
125             =head2 get
126              
127             $metapkg = meta::package->get( $pkgname );
128              
129             I
130              
131             Returns a metapackage reference representing the given package name, creating
132             it if it did not previously exist.
133              
134             An alternative to C in an object constructor style.
135              
136             =head2 is_class
137              
138             $bool = $metapkg->is_class;
139              
140             I
141              
142             Returns true if on a version of Perl that supports C, and
143             the package being represented is a real C created by that feature.
144             False for regular packages, and always false on earlier versions of Perl
145             before that feature was introduced.
146              
147             =head2 name
148              
149             $name = $metapkg->name;
150              
151             Returns the name of the package being represented.
152              
153             =head2 get_glob
154              
155             $metaglob = $metapkg->get_glob( $name );
156              
157             Returns a metaglob reference representing the given symbol name within the
158             package, if it exists. Throws an exception if not.
159              
160             =head2 try_get_glob, can_glob
161              
162             $metaglob = $metapkg->try_get_glob( $name );
163             $metaglob = $metapkg->can_glob( $name );
164              
165             Similar to L but returns undef if the glob does not exist.
166              
167             =head2 list_globs
168              
169             @metaglobs = $metapkg->list_globs;
170              
171             I
172              
173             Returns a list of all the globs in the package that may refer to symbols (i.e.
174             not subpackages). They are returned in no particular order.
175              
176             For a more convenient return value form, see also L.
177              
178             =head2 list_subpackage_globs
179              
180             =head2 list_all_globs
181              
182             @metaglobs = $metapkg->list_subpackage_globs;
183             @metaglobs = $metapkg->list_all_globs;
184              
185             I
186              
187             Returns a list of all the globs in the package that refer to subpackages, or
188             all globs, including subpackages. They are returned in no particular order.
189              
190             For a more convenient return value form, see also L.
191              
192             =head2 get_symbol
193              
194             $metasym = $metapkg->get_symbol( $name );
195              
196             Returns a metasymbol reference representing the given symbol name within the
197             package. The symbol name should include the leading sigil; one of the
198             characters C<*>, C<$>, C<@>, C<%> or C<&>. Throws an exception if the symbol
199             does not exist.
200              
201             =head2 try_get_symbol, can_symbol
202              
203             $metasym = $metapkg->try_get_symbol( $name );
204             $metasym = $metapkg->can_symbol( $name );
205              
206             Similar to L but returns undef if the symbol does not exist.
207              
208             =head2 add_symbol
209              
210             $metasym = $metapkg->add_symbol( $name, $valueref );
211              
212             Creates a new symbol of the given name in the given package. The new symbol
213             will refer to the item given by reference, whose type must match the sigil
214             of the symbol name. Returns a metasymbol reference as per L. If
215             a symbol already existed of the given name then an exception is thrown.
216              
217             I that this does not create a copy of a variable, but stores an alias
218             to the referred item itself within the symbol table.
219              
220             $metapkg->add_symbol( '@things', \my @array );
221              
222             push @array, "more", "values";
223             # these values are now visible in the @things array
224              
225             If adding a scalar, array or hash variable, the C<$valueref> argument is
226             optional. If not provided then a new, blank variable of the correct type will
227             be created.
228              
229             =head2 get_or_add_symbol
230              
231             $metasym = $metapkg->get_or_add_symbol( $name, $valueref );
232              
233             I
234              
235             Similar to L but creates a new symbol if it didn't already exist
236             as per L.
237              
238             Note that if the symbol did already exist it is returned and C<$valueref> will
239             be ignored. The symbol will not be modified in that case to point to the value
240             referred to instead.
241              
242             =head2 remove_symbol
243              
244             $metapkg->remove_symbol( $name );
245              
246             Removes a symbol of the given name from the given package. If the symbol was
247             the last item in the glob then the glob too is removed from the package. If
248             the named symbol did not previously exist then an exception is thrown.
249              
250             To only conditionally remove a symbol if it already exists, test for it first
251             by using L:
252              
253             $metapkg->try_get_symbol( '$variable' ) and
254             $metapkg->remove_symbol( '$variable' );
255              
256             =head2 list_symbols
257              
258             %sub_metasyms = $metapkg->list_symbols;
259             %sub_metasyms = $metapkg->list_symbols( sigils => $filter );
260              
261             I
262              
263             Returns an even-sized key/value list containing the symbols within the given
264             package instance. Each symbol is returned as a pair, with its sigil-prefixed
265             basename first, followed by a metasymbol instance representing it. Since the
266             sigil-prefixed names must be unique, it is convenient to assign this list into
267             a hash. The symbols are returned in no particular order.
268              
269             If the optional C named parameter is given, it should be a string of
270             possible symbol sigils (the characters C<$>, C<@>, C<%> or C<&>). In this
271             case, only symbols whose sigil is present in this string will be returned.
272              
273             =head2 list_subpackages
274              
275             %sub_metapkgs = $metapkg->list_subpackages;
276              
277             I
278              
279             Returns an even-sized key/value list containing the immediate sub-packages of
280             the given package instance. Each sub-package is returned as a pair, with its
281             basename first (minus the "::" suffix), followed by a metapackage instance
282             representing it. Since the names of each sub-package must be unique, it is
283             convenient to assign this list into a hash. The sub-packages are returned in
284             no particular order.
285              
286             =cut
287              
288             # Named param handling is a lot easier in pureperl
289             sub meta::package::list_symbols
290             {
291 2     2   183930 my ( $self, %params ) = @_;
292 2         5 my $sigils = delete $params{sigils};
293 2 50       8 keys %params and
294             croak "Unrecognised named parameters to meta::package::list_symbols: " . join( ", ", sort keys %params );
295 2         1086 return meta::package::_list_symbols( $self, $sigils );
296             }
297              
298             =head2 add_named_sub
299              
300             $metasub = $metapkg->add_named_sub( $name, $code );
301              
302             I
303              
304             A convenient shortcut for adding a subroutine symbol and setting the subname
305             of the newly-added sub. Equivalent to calling L and then
306             L on its result, but more efficient as it does not have to
307             create a separate fake GV to store the subname in.
308              
309             Note that C<$name> should be given as a barename, without the leading C<&>
310             sigil.
311              
312             =cut
313              
314             =head1 METHODS ON METASYMBOLS
315              
316             =head2 is_glob, is_scalar, ...
317              
318             $bool = $metasym->is_glob;
319             $bool = $metasym->is_scalar;
320             $bool = $metasym->is_array;
321             $bool = $metasym->is_hash;
322             $bool = $metasym->is_subroutine;
323              
324             Returns true if the symbol being referred to is of the given type, or false if
325             not.
326              
327             =head2 reference
328              
329             $ref = $metasym->reference;
330              
331             Returns a regular Perl reference to the symbol being represented.
332              
333             =cut
334              
335             =head1 METHODS ON C
336              
337             =cut
338              
339             @meta::glob::ISA = qw( meta::symbol );
340              
341             =head2 get
342              
343             $metaglob = meta::glob->get( $globname );
344              
345             I
346              
347             Returns a metaglob reference representing the given symbol from the symbol
348             table from a fully-qualified name, if it exists. Throws an exception if not.
349              
350             =head2 try_get
351              
352             $metaglob = meta::glob->try_get( $globname );
353              
354             I
355              
356             Similar to L but returns undef if the given symbol does not exist.
357              
358             =head2 get_or_add
359              
360             $metaglob = meta::glob->get_or_add( $globname );
361              
362             I
363              
364             Similar to L but creates the symbol if it didn't already exist.
365              
366             =head2 basename
367              
368             $name = $metaglob->basename;
369              
370             Returns the name of the glob I.
371              
372             =head2 get_scalar, get_array, ...
373              
374             $metasym = $metaglob->get_scalar;
375             $metasym = $metaglob->get_array;
376             $metasym = $metaglob->get_hash;
377             $metasym = $metaglob->get_code;
378              
379             Returns a metasymbol reference representing the symbol in the given slot of
380             the glob, if it exists. Throws an exception if not.
381              
382             =head2 try_get_scalar, try_get_array, ...
383              
384             Similar to L, L, etc... but returns undef if the
385             given slot does not exist.
386              
387             =cut
388              
389             =head1 METHODS ON METAVARIABLES
390              
391             =cut
392              
393             @meta::variable::ISA = qw( meta::symbol );
394              
395             =head2 value
396              
397             $scalar = $metavar->value;
398             @array = $metavar->value;
399             %hash = $metavar->value;
400              
401             $count = scalar $metavar->value;
402              
403             Returns the current value of the variable, as if it appeared in regular Perl
404             code.
405              
406             =cut
407              
408             =head1 METHODS ON METASUBROUTINES
409              
410             =cut
411              
412             @meta::subroutine::ISA = qw( meta::symbol );
413              
414             =head2 is_method
415              
416             $bool = $metasub->is_method;
417              
418             I
419              
420             Returns true if on a version of Perl that supports C, and
421             the subroutine being represented is a real C created by that feature.
422             False for regular C-based subroutines, and always false on earlier
423             versions of Perl before that feature was introduced.
424              
425             =head2 subname
426              
427             $name = $metasub->subname;
428              
429             Returns the (fully-qualified) name of the subroutine.
430              
431             =head2 set_subname
432              
433             $metasub = $metasub->set_subname( $name );
434              
435             I
436              
437             Sets a new name for the subroutine.
438              
439             If C<$name> is not fully-qualified (i.e. does not contain a C<::> sequence),
440             then the package name of the caller is used to create the fully-qualified name
441             to be stored.
442              
443             =head2 prototype
444              
445             $proto = $metasub->prototype;
446              
447             Returns the prototype of the subroutine.
448              
449             =head2 set_prototype
450              
451             $metasub = $metasub->set_prototype( $proto );
452              
453             I
454              
455             Sets a new prototype for the subroutine.
456              
457             Returns the C<$metasub> instance itself to allow for easy chaining.
458              
459             =head2 signature
460              
461             $metasig = $metasub->signature;
462              
463             I
464              
465             If on Perl version 5.26 or above and the subroutine has a signature, returns
466             an object reference representing details about the signature. This can be
467             queried using the methods below. If the subroutine does not use a signature
468             (or on Perl versions before 5.26) returns C.
469              
470             =cut
471              
472             =head1 METHODS ON SUBROUTINE METASIGNATURES
473              
474             =head2 mandatory_params
475              
476             $n = $metasig->mandatory_params;
477              
478             Returns the number of parameters that are mandatory (i.e. do not have a
479             defaulting expression). This is the minimum number of argument values that
480             must be passed to any call of this function and does not count a final slurpy
481             parameter.
482              
483             Note that the implicit C<$self> parameter to a C subroutine is
484             included in this count. This count will always be at least 1 on such a method.
485              
486             =head2 optional_params
487              
488             $n = $metasig->optional_params;
489              
490             Returns the number of parameters that are optional (i.e. have a defaulting
491             expression).
492              
493             =head2 named_param
494              
495             %params = $metasig->named_param;
496              
497             I
498              
499             If the subroutine defines any named parameters (as provided by Perl version
500             5.43.5 or later), returns a list of name/value pairs containing them. This
501             list is returned in no particular order. Each gives the name of one parameter,
502             and its value is a structure object responding to the following methods:
503              
504             $named_param->name;
505             $named_param->is_required;
506              
507             On Perls older than when signature named parameters were added, this method
508             always simply returns an empty list.
509              
510             =head2 slurpy
511              
512             $slurpy = $metasig->slurpy;
513              
514             Returns the sigil character associated with the final slurpy parameter if it
515             exists (i.e. C<%> or C<@>), or C if no slurpy parameter is defined.
516              
517             =head2 min_args
518              
519             =head2 max_args
520              
521             $n = $metasig->min_args;
522              
523             $n = $metasig->max_args;
524              
525             Returns the minimum or maximum number of argument values that can be passed to
526             a call to this function. In many situations there is no upper bound, so
527             C may return C. These are simply the boundaries of argument
528             count beyond which the function is I to complain. It may of course
529             raise an error during arugment processing for a variety of other reaosns.
530              
531             In the absence of named parameters, C is the same as
532             C, and C is either C if there is a slurpy
533             parameter, or the sum of C and C if not.
534              
535             When named parameters (on Perl 5.43.5 or above) are being used, C
536             counts 1 for every mandatory positional parameter, and 2 for every mandatory
537             named parameter. C will always be C when named parameters are
538             being used, because Perl always accepts multiple duplicate values for any
539             given name; the final one having the effective value.
540              
541             =cut
542              
543             =head1 TODO
544              
545             =over 4
546              
547             =item
548              
549             Access to the new parts of API introduced by Perl 5.38 to deal with classes,
550             methods, fields.
551              
552             =back
553              
554             =cut
555              
556             =head1 SEE ALSO
557              
558             L
559              
560             =cut
561              
562             =head1 AUTHOR
563              
564             Paul Evans
565              
566             =cut
567              
568             0x55AA;