File Coverage

blib/lib/Sub/HandlesVia/HandlerLibrary/Enum.pm
Criterion Covered Total %
statement 50 53 94.3
branch 13 20 65.0
condition 2 6 33.3
subroutine 15 15 100.0
pod 3 8 37.5
total 83 102 81.3


line stmt bran cond sub pod time code
1 1     1   655 use 5.008;
  1         4  
2 1     1   16 use strict;
  1         2  
  1         20  
3 1     1   5 use warnings;
  1         2  
  1         88  
4              
5             package Sub::HandlesVia::HandlerLibrary::Enum;
6              
7             our $AUTHORITY = 'cpan:TOBYINK';
8             our $VERSION = '0.046';
9              
10 1     1   8 use Exporter::Tiny;
  1         2  
  1         6  
11 1     1   530 use Sub::HandlesVia::HandlerLibrary;
  1         3  
  1         49  
12             our @ISA = qw(
13             Exporter::Tiny
14             Sub::HandlesVia::HandlerLibrary
15             );
16              
17 1     1   7 use Sub::HandlesVia::Handler qw( handler );
  1         2  
  1         6  
18 1     1   86 use Types::Standard qw( is_Str Any );
  1         2  
  1         4  
19              
20             sub HandleIs () { 1 }
21             sub HandleNamedIs () { 2 }
22             sub HandleSet () { 4 }
23             sub HandleNamedSet () { 8 }
24              
25             our @EXPORT = qw(
26             HandleIs
27             HandleNamedIs
28             HandleSet
29             HandleNamedSet
30             );
31              
32             sub preprocess_spec {
33 2     2 0 13 my ( $class, $target, $attrname, $spec ) = @_;
34 2 100       12 if ( my $values = delete $spec->{enum} ) {
35 1         5 require Type::Tiny::Enum;
36 1   33     16 $spec->{isa} ||= 'Type::Tiny::Enum'->new( values => $values );
37             }
38             }
39              
40             sub expand_shortcut {
41 1     1 0 6 require Carp;
42 1         5 my ( $class, $target, $attrname, $spec, $shortcut ) = @_;
43 1         3 my %handlers;
44              
45             my $type = $spec->{isa}
46 1 50       6 or Carp::croak( "No type constraint!" );
47 1 50       14 $type->can( 'values' )
48             or Carp::croak( "Type constraint does not have a `values` method!" );
49 1         14 my @values = @{ $type->values };
  1         5  
50              
51 1 50       11 if ( HandleIs & $shortcut ) {
52 1         10 $handlers{"is_$_"} = [ is => $_ ] for @values;
53             }
54 1 50       5 if ( HandleNamedIs & $shortcut ) {
55 0         0 $handlers{"$attrname\_is_$_"} = [ is => $_ ] for @values;
56             }
57 1 50       4 if ( HandleSet & $shortcut ) {
58 0         0 $handlers{"set_$_"} = [ set => $_ ] for @values;
59             }
60 1 50       4 if ( HandleNamedSet & $shortcut ) {
61 1         7 $handlers{"$attrname\_set_$_"} = [ set => $_ ] for @values;
62             }
63              
64 1         5 return \%handlers;
65             }
66              
67             # Non-exhaustive list!
68             sub handler_names {
69 1     1 0 18 qw( is assign set );
70             }
71              
72             sub has_handler {
73 14     14 0 36 my ($me, $handler_name) = @_;
74 14 100       88 return 1 if $handler_name =~ /^(is|assign|set)$/;
75 6 50 33     67 return 1 if is_Str $handler_name and $handler_name =~ /^(is|assign|set)_(.+)$/;
76 0         0 return 0;
77             }
78              
79             sub get_handler {
80 20     20 0 41 my ($me, $handler_name) = @_;
81            
82 20 100       84 $handler_name =~ /^(is|assign|set)_(.+)$/
83             or return $me->SUPER::get_handler( $handler_name );
84            
85 6         18 my $handler_type = $1;
86 6         13 my $param = $2;
87            
88 6         14 return $me->get_handler( $handler_type )->curry( $param );
89             }
90              
91             sub assign {
92 4     4 1 16 handler
93             name => 'Enum:assign',
94             args => 1,
95             signature => [Any],
96             template => '« $ARG »',
97             lvalue_template => '$GET = $ARG',
98             usage => '$value',
99             documentation => "Sets the enum to a new value.",
100             }
101              
102             sub set {
103 3     3 1 14 handler
104             name => 'Enum:set',
105             args => 1,
106             signature => [Any],
107             template => '« $ARG »',
108             lvalue_template => '$GET = $ARG',
109             usage => '$value',
110             documentation => "Sets the enum to a new value.",
111             }
112              
113             sub is {
114 7     7 1 30 handler
115             name => "Enum:is",
116             args => 1,
117             signature => [Any],
118             template => "\$GET eq \$ARG",
119             documentation => "Returns C<< \$object->attr eq \$str >>.",
120             };
121              
122             1;
123              
124             __END__
125              
126             =head1 NAME
127              
128             Sub::HandlesVia::HandlerLibrary::Enum - library of enum-related methods
129              
130             =head1 SYNOPSIS
131              
132             package My::Class {
133             use Moo;
134             use Sub::HandlesVia;
135             use Types::Standard 'Enum';
136             has status => (
137             is => 'ro',
138             isa => Enum[ 'pass', 'fail' ],
139             handles_via => 'Enum',
140             handles => {
141             'is_pass' => [ is => 'pass' ],
142             'is_fail' => [ is => 'fail' ],
143             'assign_pass' => [ assign => 'pass' ],
144             'assign_fail' => [ assign => 'fail' ],
145             },
146             default => sub { 'fail' },
147             );
148             }
149              
150             Or, using a shortcut:
151              
152             package My::Class {
153             use Moo;
154             use Sub::HandlesVia;
155             use Types::Standard 'Enum';
156             has status => (
157             is => 'ro',
158             isa => Enum[ 'pass', 'fail' ],
159             handles_via => 'Enum',
160             handles => {
161             'is_pass' => 'is_pass',
162             'is_fail' => 'is_fail',
163             'assign_pass' => 'assign_pass',
164             'assign_fail' => 'assign_fail',
165             },
166             default => sub { 'fail' },
167             );
168             }
169              
170             (Sub::HandlesVia::HandlerLibrary::Enum will split on "_".)
171              
172             =head1 DESCRIPTION
173              
174             This is a library of methods for L<Sub::HandlesVia>.
175              
176             =head1 DELEGATABLE METHODS
177              
178             This allows for delegation roughly compatible with L<MooseX::Enumeration>
179             and L<MooX::Enumeration>, even though that's basically a renamed subset of
180             L<Sub::HandlesVia::HandlerLibrary::String> anyway.
181              
182             =head2 C<< is( $value ) >>
183              
184             Returns a boolean indicating whether the enum is that value.
185              
186             my $object = My::Class->new( status => 'pass' );
187             say $object->is_pass(); ## ==> true
188             say $object->is_fail(); ## ==> false
189              
190             =head2 C<< assign( $value ) >>
191              
192             Sets the enum to the value.
193              
194             my $object = My::Class->new( status => 'pass' );
195             say $object->is_pass(); ## ==> true
196             say $object->is_fail(); ## ==> false
197             $object->assign_fail();
198             say $object->is_pass(); ## ==> false
199             say $object->is_fail(); ## ==> true
200              
201             =head2 C<< set( $value ) >>
202              
203             An alias for C<assign>.
204              
205             =head1 TYPE CONSTRAINT SHORTCUT
206              
207             The Enum handler library also allows an C<enum> shortcut in the attribute
208             spec.
209              
210             package My::Class {
211             use Moo;
212             use Sub::HandlesVia;
213             has status => (
214             is => 'ro',
215             enum => [ 'pass', 'fail' ],
216             handles_via => 'Enum',
217             handles => {
218             'is_pass' => [ is => 'pass' ],
219             'is_fail' => [ is => 'fail' ],
220             'assign_pass' => [ assign => 'pass' ],
221             'assign_fail' => [ assign => 'fail' ],
222             },
223             default => sub { 'fail' },
224             );
225             }
226              
227             =head1 SHORTCUT CONSTANTS
228              
229             This module provides some shortcut constants for indicating a list of
230             delegations.
231              
232             package My::Class {
233             use Moo;
234             use Types::Standard qw( Enum );
235             use Sub::HandlesVia;
236             use Sub::HandlesVia::HandlerLibrary::Enum qw( HandleIs );
237             has status => (
238             is => 'ro',
239             isa => Enum[ 'pass', 'fail' ],
240             handles_via => 'Enum',
241             handles => HandleIs,
242             default => sub { 'fail' },
243             );
244             }
245              
246             Any of these shortcuts can be combined using the C< | > operator.
247              
248             has status => (
249             is => 'ro',
250             isa => Enum[ 'pass', 'fail' ],
251             handles_via => 'Enum',
252             handles => HandleIs | HandleSet,
253             default => sub { 'fail' },
254             );
255              
256             =head2 C<< HandleIs >>
257              
258             Creates delegations named like C<< is_pass >> and C<< is_fail >>.
259              
260             =head2 C<< HandleNamedIs >>
261              
262             Creates delegations named like C<< status_is_pass >> and C<< status_is_fail >>.
263              
264             =head2 C<< HandleSet >>
265              
266             Creates delegations named like C<< set_pass >> and C<< set_fail >>.
267              
268             =head2 C<< HandleNamedSet >>
269              
270             Creates delegations named like C<< status_set_pass >> and C<< status_set_fail >>.
271              
272             =head1 BUGS
273              
274             Please report any bugs to
275             L<https://github.com/tobyink/p5-sub-handlesvia/issues>.
276              
277             =head1 SEE ALSO
278              
279             L<Sub::HandlesVia>.
280              
281             =head1 AUTHOR
282              
283             Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
284              
285             =head1 COPYRIGHT AND LICENCE
286              
287             This software is copyright (c) 2022 by Toby Inkster.
288              
289             This is free software; you can redistribute it and/or modify it under
290             the same terms as the Perl 5 programming language system itself.
291              
292             =head1 DISCLAIMER OF WARRANTIES
293              
294             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
295             WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
296             MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
297