1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
# You may distribute under the terms of either the GNU General Public License
# or the Artistic License (the same terms as Perl itself)
#
# (C) Paul Evans, 2021-2024 -- leonerd@leonerd.org.uk
package Commandable::Finder::SubAttributes::Attrs 0.14;
use v5.26;
use warnings;
# We can't use 'signatures' feature here because the order of attributes vs.
# signature changed in perl 5.28. The syntax we want to use only works on 5.28
# onwards but it would be nice to still support 5.26 for a while longer.
use Carp;
use meta 0.003_003;
no warnings qw( meta::experimental );
use Attribute::Storage 0.12;
=head1 NAME
C<Commandable::Finder::SubAttributes::Attrs> - subroutine attribute definitions for C<Commandable::Finder::SubAttributes>
=head1 DESCRIPTION
This module contains the attribute definitions to apply to subroutines when
using L<Commandable::Finder::SubAttributes>. It should not be used directly.
=cut
sub import_into
{
my ( $pkg, $caller ) = @_;
# Importing these lexically is a bit of a mess.
my $callermeta = meta::package->get( $caller );
$callermeta->add_symbol( '&MODIFY_CODE_ATTRIBUTES' => \&MODIFY_CODE_ATTRIBUTES );
push $callermeta->get_or_add_symbol( '@ISA' )->reference->@*, __PACKAGE__;
}
sub Command_description :ATTR(CODE)
{
my ( $class, $text ) = @_;
return $text;
}
sub Command_arg :ATTR(CODE,MULTI)
{
my ( $class, $args, $name, $description ) = @_;
my $optional = $name =~ s/\?$//;
my $slurpy = $name =~ s/\.\.\.$//;
my %arg = (
name => $name,
description => $description,
optional => $optional,
slurpy => $slurpy,
# TODO: all sorts involving type, etc...
);
push @$args, \%arg;
return $args;
}
sub Command_opt :ATTR(CODE,MULTI)
{
my ( $class, $opts, $name, $description, $default ) = @_;
my $mode = "set";
$mode = "value" if $name =~ s/=$//;
$mode = "inc" if $name =~ s/\+$//;
my $negatable = $name =~ s/\!$//;
my $multi = $name =~ s/\@$//;
my %optspec = (
name => $name,
description => $description,
mode => $mode,
multi => $multi,
negatable => $negatable,
default => $default,
);
push @$opts, \%optspec;
return $opts;
}
sub GlobalOption :ATTR(SCALAR)
{
my ( $class, $name, $description ) = @_;
return [ $name, $description ];
}
=head1 AUTHOR
Paul Evans <leonerd@leonerd.org.uk>
=cut
0x55AA;
|
