3c507f025

Build Type

push

github-actions

Committed by GitHub

Commit Message

<a href="https://github.com/tobyink/p5-type-tiny/commit/<a class=hub.com/tobyink/p5-type-tiny/commit/<a class="double-link" href="https://git"><a class=hub.com/tobyink/p5-type-tiny/commit/<a class="double-link" href="https://git"><a class=hub.com/tobyink/p5-type-tiny/commit/<a class="double-link" href="https://git"><a class=hub.com/tobyink/p5-type-tiny/commit/<a class="double-link" href="https://git"><a class=hub.com/tobyink/p5-type-tiny/commit/3c507f02550e7e6bd441d8b3fc94888dd699202d">3c507f025">&lt;a href=&quot;https://github.com/tobyink/p5-type-tiny/commit/</a><a class="double-link" href="https://github.com/tobyink/p5-type-tiny/commit/&lt;a class=&quot;double-link&quot; href=&quot;https://git">&lt;a class=</a>hub.com/tobyink/p5-type-tiny/commit/&lt;a class=&quot;double-link&quot; href=&quot;https://git">&lt;a class=</a>hub.com/tobyink/p5-type-tiny/commit/&lt;a class=&quot;double-link&quot; href=&quot;https://git">&lt;a class=</a>hub.com/tobyink/p5-type-tiny/commit/3c507f02550e7e6bd441d8b3fc94888dd699202d">3c507f025</a><a href="https://github.com/tobyink/p5-type-tiny/commit/3c507f02550e7e6bd441d8b3fc94888dd699202d">&lt;a href=&quot;https://github.com/tobyink/p5-type-tiny/commit/3c507f02550e7e6bd441d8b3fc94888dd699202d&quot;&gt;&amp;quot;&amp;gt;&amp;amp;lt;a href=&amp;amp;quot;https://github.com/tobyink/p5-type-tiny/commit/&amp;lt;/a&amp;gt;&amp;lt;a class=&amp;quot;double-link&amp;quot; href=&amp;quot;https://github.com/tobyink/p5-type-tiny/commit/&amp;amp;lt;a class=&amp;amp;quot;double-link&amp;amp;quot; href=&amp;amp;quot;https://git&amp;quot;&amp;gt;&amp;amp;lt;a class=&amp;lt;/a&amp;gt;hub.com/tobyink/p5-type-tiny/commit/3c507f02550e7e6bd441d8b3fc94888dd699202d&amp;quot;&amp;gt;3c507f025&amp;lt;/a&amp;gt;&amp;lt;a href=&amp;quot;https://github.com/tobyink/p5-type-tiny/commit/3c507f02550e7e6bd441d8b3fc94888dd699202d&amp;quot;&amp;gt;&amp;amp;lt;a href=&amp;amp;quot;https://github.com/tobyink/p5-type-tiny/commit/3c507f02550e7e6bd441d8b3fc94888d&amp;lt;/a&amp;gt;d699202d</a>&quot;&gt;&amp;quot;&amp;gt;Merge &amp;lt;/a&amp;gt;&amp;lt;a class=&amp;quot;double-link&amp;quot; href=&amp;quot;https://github.com/tobyink/p5-type-tiny/commit/&amp;lt;a class=&amp;quot;double-link&amp;quot; href=&amp;quot;https://github.com/tobyink/p5-type-tiny/commit/&lt;a class=&quot;double-link&quot; href=&quot;https://github.com/tobyink/p5-type-tiny/commit/4a739e75c... (continued)

Run Details

92 of 92 new or added lines in 1 file covered. (100.0%)

3609 of 3612 relevant lines covered (99.92%)

28747.42 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

96.74

/lib/Type/Tiny/Bitfield.pm

package Type::Tiny::Bitfield;

use 5.008001;
use strict;
use warnings;

BEGIN {
        $Type::Tiny::Bitfield::AUTHORITY = 'cpan:TOBYINK';
        $Type::Tiny::Bitfield::VERSION   = '2.002001';
}

$Type::Tiny::Bitfield::VERSION =~ tr/_//d;

sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak }

use Exporter::Tiny 1.004001 ();
use Type::Tiny ();
use Types::Common::Numeric qw( +PositiveOrZeroInt );
use Eval::TypeTiny qw( eval_closure );

our @ISA = qw( Type::Tiny Exporter::Tiny );

sub _is_power_of_two { not $_[0] & $_[0]-1 }

sub _exporter_fail {
        my ( $class, $type_name, $values, $globals ) = @_;
        my $caller = $globals->{into};
        my $type = $class->new(
                name      => $type_name,
                values    => { %$values },
                coercion  => 1,
        );
        $INC{'Type/Registry.pm'}
                ? 'Type::Registry'->for_class( $caller )->add_type( $type, $type_name )
                : ( $Type::Registry::DELAYED{$caller}{$type_name} = $type )
                unless( ref($caller) or $caller eq '-lexical' or $globals->{'lexical'} );
        return map +( $_->{name} => $_->{code} ), @{ $type->exportables };
}

sub new {
        my $proto = shift;
        
        my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_;
        _croak
                "Bitfield type constraints cannot have a parent constraint passed to the constructor"
                if exists $opts{parent};
        _croak
                "Bitfield type constraints cannot have a constraint coderef passed to the constructor"
                if exists $opts{constraint};
        _croak
                "Bitfield type constraints cannot have a inlining coderef passed to the constructor"
                if exists $opts{inlined};
        _croak "Need to supply hashref of values"
                unless exists $opts{values};
        
        $opts{parent} = PositiveOrZeroInt;
        
        for my $key ( keys %{ $opts{values} } ) {
                _croak "Not an all-caps name in a bitfield: $key"
                        unless $key =~ /^[A-Z][A-Z0-9]*(_[A-Z0-9]+)*/
        }
        my $ALL = 0;
        my %already = ();
        for my $value ( values %{ $opts{values} } ) {
                _croak "Not a positive power of 2 in a bitfield: $value"
                        unless is_PositiveOrZeroInt( $value ) && _is_power_of_two( $value );
                _croak "Duplicate value in a bitfield: $value"
                        if $already{$value}++;
                $ALL |= ( 0 + $value );
        }
        $opts{ALL} = $ALL;
        
        $opts{constraint} = sub {
                not shift() & ~$ALL;
        };
        
        if ( defined $opts{coercion}
        and !ref $opts{coercion}
        and 1 eq $opts{coercion} ) {
                delete $opts{coercion};
                $opts{_build_coercion} = sub {
                        require Types::Standard;
                        my $c = shift;
                        my $t = $c->type_constraint;
                        $c->add_type_coercions(
                                Types::Standard::Str(),
                                $t->_stringy_coercion,
                        );
                };
        } #/ if ( defined $opts{coercion...})
        
        return $proto->SUPER::new( %opts );
} #/ sub new

sub values {
        $_[0]{values}
}

sub _lockdown {
        my ( $self, $callback ) = @_;
        $callback->( $self->{values} );
}

sub exportables {
        my ( $self, $base_name ) = @_;
        if ( not $self->is_anon ) {
                $base_name ||= $self->name;
        }
        
        my $exportables = $self->SUPER::exportables( $base_name );
        
        require Eval::TypeTiny;
        require B;
        
        for my $key ( keys %{ $self->values } ) {
                my $value = $self->values->{$key};
                push @$exportables, {
                        name => uc( sprintf '%s_%s', $base_name, $key ),
                        tags => [ 'constants' ],
                        code => Eval::TypeTiny::eval_closure(
                                source      => sprintf( 'sub () { %d }', $value ),
                                environment => {},
                        ),
                };
        }
        
        my $weak = $self;
        require Scalar::Util;
        Scalar::Util::weaken( $weak );
        push @$exportables, {
                name => sprintf( '%s_to_Str', $base_name ),
                tags => [ 'from' ],
                code => sub { $weak->to_string( @_ ) },
        };
        
        return $exportables;
}

sub can_be_inlined {
        !!1;
}

sub inline_check {
        my ( $self, $var ) = @_;
        
        return sprintf(
                '( %s and not %s & ~%d )',
                PositiveOrZeroInt->inline_check( $var ),
                $var,
                $self->{ALL},
        );
}

sub _stringy_coercion {
        my ( $self, $varname ) = @_;
        $varname ||= '$_';
        my %vals = %{ $self->values };
        my $pfx  = uc( "$self" );
        my $pfxl = length $pfx;
        my $hash = sprintf(
                '( %s )',
                join(
                        q{, },
                        map sprintf( '%s => %d', B::perlstring($_), $vals{$_} ),
                        sort keys %vals,
                ),
        );
        return qq{do { my \$bits = 0; my \%lookup = $hash; for my \$tok ( grep /\\w/, split /[\\s|+]+/, uc( $varname ) ) { if ( substr( \$tok, 0, $pfxl) eq "$pfx" ) { \$tok = substr( \$tok, $pfxl ); \$tok =~ s/^_//; } if ( exists \$lookup{\$tok} ) { \$bits |= \$lookup{\$tok}; next; } require Carp; Carp::carp("Unknown token: \$tok"); } \$bits; }};
}

sub from_string {
        my ( $self, $str ) = @_;
        $self->{from_string} ||= eval_closure(
                environment => {},
                source      => sprintf( 'sub { my $STR = shift; %s }', $self->_stringy_coercion( '$STR' ) ),
        );
        $self->{from_string}->( $str );
}

sub to_string {
        my ( $self, $int ) = @_;
        is_PositiveOrZeroInt( $int ) or return;
        my %values = %{ $self->values };
        $self->{all_names} ||= [ sort { $values{$a} <=> $values{$b} } keys %values ];
        $int += 0;
        my @names;
        for my $n ( @{ $self->{all_names} } ) {
                push @names, $n if $int & $values{$n};
        }
        return join q{|}, @names;
}

sub AUTOLOAD {
        my $self = shift;
        my ( $m ) = ( our $AUTOLOAD =~ /::(\w+)$/ );
        return if $m eq 'DESTROY';
        if ( ref $self and exists $self->{values}{$m} ) {
                return 0 + $self->{values}{$m};
        }
        return $self->SUPER::AUTOLOAD( @_ );
}

sub can {
        my ( $self, $m ) = ( shift, @_ );
        if ( ref $self and exists $self->{values}{$m} ) {
                return sub () { 0 + $self->{values}{$m} };
        }
        return $self->SUPER::can( @_ );
}

1;

__END__

=pod

=encoding utf-8

=head1 NAME

Type::Tiny::Bitfield - bitfield/bitflag type constraints

=head1 SYNOPSIS

Using Type::Tiny::Bitfield's export feature:

  package LightSource {
    use Moo;
    
    use Type::Tiny::Bitfield LedSet => {
      RED   => 1,
      GREEN => 2,
      BLUE  => 4,
    };
    
    has leds => ( is => 'ro', isa => LedSet, default => 0, coerce => 1 );
    
    sub new_red {
      my $class = shift;
      return $class->new( leds => LEDSET_RED );
    }
    
    sub new_green {
      my $class = shift;
      return $class->new( leds => LEDSET_GREEN );
    }
    
    sub new_yellow {
      my $class = shift;
      return $class->new( leds => LEDSET_RED | LEDSET_GREEN );
    }
  }

Using Type::Tiny::Bitfield's object-oriented interface:

  package LightSource {
    use Moo;
    use Type::Tiny::Bitfield;
    
    my $LedSet = Type::Tiny::Bitfield->new(
      name   => 'LedSet',
      values => {
        RED   => 1,
        GREEN => 2,
        BLUE  => 4,
      },
      coercion => 1,
    );
    
    has leds => ( is => 'ro', isa => $LedSet, default => 0, coerce => 1 );
    
    sub new_red {
      my $class = shift;
      return $class->new( leds => $LedSet->RED );
    }
    
    sub new_green {
      my $class = shift;
      return $class->new( leds => $LedSet->GREEN );
    }
    
    sub new_yellow {
      my $class = shift;
      return $class->new( leds => $LedSet->coerce('red|green') );
    }
  }

=head1 STATUS

This module is covered by the
L<Type-Tiny stability policy|Type::Tiny::Manual::Policies/"STABILITY">.

=head1 DESCRIPTION

Bitfield type constraints.

This package inherits from L<Type::Tiny>; see that for most documentation.
Major differences are listed below:

=head2 Attributes

=over

=item C<values>

Hashref of bits allowed in the bitfield. Keys must be UPPER_SNAKE_CASE strings.
Values must be positive integers which are powers of two. The same number
cannot be used multiple times.

=item C<constraint>

Unlike Type::Tiny, you I<cannot> pass a constraint coderef to the constructor.
Instead rely on the default.

=item C<inlined>

Unlike Type::Tiny, you I<cannot> pass an inlining coderef to the constructor.
Instead rely on the default.

=item C<parent>

Parent is always B<Types::Common::Numeric::PositiveOrZeroInt>, and cannot be
passed to the constructor.

=item C<coercion>

If C<< coercion => 1 >> is passed to the constructor, the type will have an
automatic coercion from B<Str>. Types built by the C<import> method will
always have C<< coercion => 1 >>.

In the SYNOPSIS example, the coercion from B<Str> will accept strings like:

  "RED"
  "red"
  "Red Green"
  "Red+Blue"
  "blue | GREEN"
  "LEDSET_RED + LeDsEt_green"

=back

=head2 Methods

This class uses C<AUTOLOAD> to allow the names of each bit in the bitfield
to be used as methods.

For example, in the synopsis, C<< LedSet->GREEN >> would return 2.

Other methods it provides:

=over

=item C<< from_string( $str ) >>

Provides the standard coercion from a string, even if this type constraint
doesn't have a coercion.

=item C<< to_string( $int ) >>

Does the reverse coercion.

=back

=head2 Exports

Type::Tiny::Bitfield can be used as an exporter.

  use Type::Tiny::Bitfield LedSet => {
    RED    => 1,
    GREEN  => 2,
    BLUE   => 4,
  };

This will export the following functions into your namespace:

=over

=item C<< LedSet >>

=item C<< is_LedSet( $value ) >>

=item C<< assert_LedSet( $value ) >>

=item C<< to_LedSet( $string ) >>

=item C<< LedSet_to_Str( $value ) >>

=item C<< LEDSET_RED >>

=item C<< LEDSET_GREEN >>

=item C<< LEDSET_BLUE >>

=back

Multiple bitfield types can be exported at once:

  use Type::Tiny::Enum (
    LedSet     => { RED => 1, GREEN => 2, BLUE => 4 },
    LedPattern => [ FLASHING => 1 ],
  );

=head1 BUGS

Please report any bugs to
L<https://github.com/tobyink/p5-type-tiny/issues>.

=head1 SEE ALSO

L<Type::Tiny::Manual>.

L<Type::Tiny>.

=head1 AUTHOR

Toby Inkster E<lt>tobyink@cpan.orgE<gt>.

=head1 COPYRIGHT AND LICENCE

This software is copyright (c) 2023 by Toby Inkster.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=head1 DISCLAIMER OF WARRANTIES

THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

1	package Type::Tiny::Bitfield;
2
3	use 5.008001;	8✔
4	use strict;	8✔
5	use warnings;	8✔
6
7	BEGIN {
8	$Type::Tiny::Bitfield::AUTHORITY = 'cpan:TOBYINK';	8✔
9	$Type::Tiny::Bitfield::VERSION = '2.002001';	8✔
10	}
11
12	$Type::Tiny::Bitfield::VERSION =~ tr/_//d;
13
14	sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak }	16✔
15
16	use Exporter::Tiny 1.004001 ();	8✔
17	use Type::Tiny ();	8✔
18	use Types::Common::Numeric qw( +PositiveOrZeroInt );	8✔
19	use Eval::TypeTiny qw( eval_closure );	8✔
20
21	our @ISA = qw( Type::Tiny Exporter::Tiny );
22
23	sub _is_power_of_two { not $_[0] & $_[0]-1 }	54✔
24
25	sub _exporter_fail {
26	my ( $class, $type_name, $values, $globals ) = @_;	24✔
27	my $caller = $globals->{into};	24✔
28	my $type = $class->new(	24✔
29	name => $type_name,
30	values => { %$values },
31	coercion => 1,
32	);
33	$INC{'Type/Registry.pm'}
34	? 'Type::Registry'->for_class( $caller )->add_type( $type, $type_name )
35	: ( $Type::Registry::DELAYED{$caller}{$type_name} = $type )
36	unless( ref($caller) or $caller eq '-lexical' or $globals->{'lexical'} );	8✔
37	return map +( $_->{name} => $_->{code} ), @{ $type->exportables };	8✔
38	}
39
40	sub new {
41	my $proto = shift;	24✔
42
43	my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_;	24✔
44	_croak
45	"Bitfield type constraints cannot have a parent constraint passed to the constructor"
46	if exists $opts{parent};	24✔
47	_croak
48	"Bitfield type constraints cannot have a constraint coderef passed to the constructor"
49	if exists $opts{constraint};	24✔
50	_croak
51	"Bitfield type constraints cannot have a inlining coderef passed to the constructor"
52	if exists $opts{inlined};	24✔
53	_croak "Need to supply hashref of values"
54	unless exists $opts{values};	24✔
55
56	$opts{parent} = PositiveOrZeroInt;	24✔
57
58	for my $key ( keys %{ $opts{values} } ) {	24✔
59	_croak "Not an all-caps name in a bitfield: $key"	72✔
60	unless $key =~ /^[A-Z][A-Z0-9](_[A-Z0-9]+)/
61	}
62	my $ALL = 0;	16✔
63	my %already = ();	16✔
64	for my $value ( values %{ $opts{values} } ) {	16✔
65	_croak "Not a positive power of 2 in a bitfield: $value"	54✔
66	unless is_PositiveOrZeroInt( $value ) && _is_power_of_two( $value );
67	_croak "Duplicate value in a bitfield: $value"
68	if $already{$value}++;	46✔
69	$ALL \|= ( 0 + $value );	46✔
70	}
71	$opts{ALL} = $ALL;	8✔
72
73	$opts{constraint} = sub {
74	not shift() & ~$ALL;	×
75	};	8✔
76
77	if ( defined $opts{coercion}	8✔
78	and !ref $opts{coercion}
79	and 1 eq $opts{coercion} ) {
80	delete $opts{coercion};	8✔
81	$opts{_build_coercion} = sub {
82	require Types::Standard;	8✔
83	my $c = shift;	8✔
84	my $t = $c->type_constraint;	8✔
85	$c->add_type_coercions(	8✔
86	Types::Standard::Str(),
87	$t->_stringy_coercion,
88	);
89	};	8✔
90	} #/ if ( defined $opts{coercion...})
91
92	return $proto->SUPER::new( %opts );	8✔
93	} #/ sub new
94
95	sub values {
96	$_[0]{values}
97	}	80✔
98
99	sub _lockdown {
100	my ( $self, $callback ) = @_;	8✔
101	$callback->( $self->{values} );	8✔
102	}
103
104	sub exportables {
105	my ( $self, $base_name ) = @_;	8✔
106	if ( not $self->is_anon ) {	8✔
107	$base_name \|\|= $self->name;	8✔
108	}
109
110	my $exportables = $self->SUPER::exportables( $base_name );	8✔
111
112	require Eval::TypeTiny;	8✔
113	require B;	8✔
114
115	for my $key ( keys %{ $self->values } ) {	8✔
116	my $value = $self->values->{$key};	32✔
117	push @$exportables, {	32✔
118	name => uc( sprintf '%s_%s', $base_name, $key ),
119	tags => [ 'constants' ],
120	code => Eval::TypeTiny::eval_closure(
121	source => sprintf( 'sub () { %d }', $value ),
122	environment => {},
123	),
124	};
125	}
126
127	my $weak = $self;	8✔
128	require Scalar::Util;	8✔
129	Scalar::Util::weaken( $weak );	8✔
130	push @$exportables, {
131	name => sprintf( '%s_to_Str', $base_name ),
132	tags => [ 'from' ],
133	code => sub { $weak->to_string( @_ ) },	8✔
134	};	8✔
135
136	return $exportables;	8✔
137	}
138
139	sub can_be_inlined {
140	!!1;	80✔
141	}
142
143	sub inline_check {
144	my ( $self, $var ) = @_;	72✔
145
146	return sprintf(
147	'( %s and not %s & ~%d )',
148	PositiveOrZeroInt->inline_check( $var ),
149	$var,
150	$self->{ALL},
151	);	72✔
152	}
153
154	sub _stringy_coercion {
155	my ( $self, $varname ) = @_;	16✔
156	$varname \|\|= '$_';	16✔
157	my %vals = %{ $self->values };	16✔
158	my $pfx = uc( "$self" );	16✔
159	my $pfxl = length $pfx;	16✔
160	my $hash = sprintf(
161	'( %s )',
162	join(
163	q{, },
164	map sprintf( '%s => %d', B::perlstring($_), $vals{$_} ),	16✔
165	sort keys %vals,
166	),
167	);
168	return qq{do { my \$bits = 0; my \%lookup = $hash; for my \$tok ( grep /\\w/, split /[\\s\|+]+/, uc( $varname ) ) { if ( substr( \$tok, 0, $pfxl) eq "$pfx" ) { \$tok = substr( \$tok, $pfxl ); \$tok =~ s/^_//; } if ( exists \$lookup{\$tok} ) { \$bits \|= \$lookup{\$tok}; next; } require Carp; Carp::carp("Unknown token: \$tok"); } \$bits; }};	16✔
169	}
170
171	sub from_string {
172	my ( $self, $str ) = @_;	8✔
173	$self->{from_string} \|\|= eval_closure(	8✔
174	environment => {},
175	source => sprintf( 'sub { my $STR = shift; %s }', $self->_stringy_coercion( '$STR' ) ),
176	);
177	$self->{from_string}->( $str );	8✔
178	}
179
180	sub to_string {
181	my ( $self, $int ) = @_;	24✔
182	is_PositiveOrZeroInt( $int ) or return;	24✔
183	my %values = %{ $self->values };	24✔
184	$self->{all_names} \|\|= [ sort { $values{$a} <=> $values{$b} } keys %values ];	24✔
185	$int += 0;	24✔
186	my @names;	24✔
187	for my $n ( @{ $self->{all_names} } ) {	24✔
188	push @names, $n if $int & $values{$n};	96✔
189	}
190	return join q{\|}, @names;	24✔
191	}
192
193	sub AUTOLOAD {
194	my $self = shift;	32✔
195	my ( $m ) = ( our $AUTOLOAD =~ /::(\w+)$/ );	32✔
196	return if $m eq 'DESTROY';	32✔
197	if ( ref $self and exists $self->{values}{$m} ) {	32✔
198	return 0 + $self->{values}{$m};	32✔
199	}
200	return $self->SUPER::AUTOLOAD( @_ );	×
201	}
202
203	sub can {
204	my ( $self, $m ) = ( shift, @_ );	8✔
205	if ( ref $self and exists $self->{values}{$m} ) {	8✔
206	return sub () { 0 + $self->{values}{$m} };	×
207	}
208	return $self->SUPER::can( @_ );	8✔
209	}
210
211	1;
212
213	__END__
214
215	=pod
216
217	=encoding utf-8
218
219	=head1 NAME
220
221	Type::Tiny::Bitfield - bitfield/bitflag type constraints
222
223	=head1 SYNOPSIS
224
225	Using Type::Tiny::Bitfield's export feature:
226
227	package LightSource {
228	use Moo;
229
230	use Type::Tiny::Bitfield LedSet => {
231	RED => 1,
232	GREEN => 2,
233	BLUE => 4,
234	};
235
236	has leds => ( is => 'ro', isa => LedSet, default => 0, coerce => 1 );
237
238	sub new_red {
239	my $class = shift;
240	return $class->new( leds => LEDSET_RED );
241	}
242
243	sub new_green {
244	my $class = shift;
245	return $class->new( leds => LEDSET_GREEN );
246	}
247
248	sub new_yellow {
249	my $class = shift;
250	return $class->new( leds => LEDSET_RED \| LEDSET_GREEN );
251	}
252	}
253
254	Using Type::Tiny::Bitfield's object-oriented interface:
255
256	package LightSource {
257	use Moo;
258	use Type::Tiny::Bitfield;
259
260	my $LedSet = Type::Tiny::Bitfield->new(
261	name => 'LedSet',
262	values => {
263	RED => 1,
264	GREEN => 2,
265	BLUE => 4,
266	},
267	coercion => 1,
268	);
269
270	has leds => ( is => 'ro', isa => $LedSet, default => 0, coerce => 1 );
271
272	sub new_red {
273	my $class = shift;
274	return $class->new( leds => $LedSet->RED );
275	}
276
277	sub new_green {
278	my $class = shift;
279	return $class->new( leds => $LedSet->GREEN );
280	}
281
282	sub new_yellow {
283	my $class = shift;
284	return $class->new( leds => $LedSet->coerce('red\|green') );
285	}
286	}
287
288	=head1 STATUS
289
290	This module is covered by the
291	L<Type-Tiny stability policy\|Type::Tiny::Manual::Policies/"STABILITY">.
292
293	=head1 DESCRIPTION
294
295	Bitfield type constraints.
296
297	This package inherits from L<Type::Tiny>; see that for most documentation.
298	Major differences are listed below:
299
300	=head2 Attributes
301
302	=over
303
304	=item C<values>
305
306	Hashref of bits allowed in the bitfield. Keys must be UPPER_SNAKE_CASE strings.
307	Values must be positive integers which are powers of two. The same number
308	cannot be used multiple times.
309
310	=item C<constraint>
311
312	Unlike Type::Tiny, you I<cannot> pass a constraint coderef to the constructor.
313	Instead rely on the default.
314
315	=item C<inlined>
316
317	Unlike Type::Tiny, you I<cannot> pass an inlining coderef to the constructor.
318	Instead rely on the default.
319
320	=item C<parent>
321
322	Parent is always B<Types::Common::Numeric::PositiveOrZeroInt>, and cannot be
323	passed to the constructor.
324
325	=item C<coercion>
326
327	If C<< coercion => 1 >> is passed to the constructor, the type will have an
328	automatic coercion from B<Str>. Types built by the C<import> method will
329	always have C<< coercion => 1 >>.
330
331	In the SYNOPSIS example, the coercion from B<Str> will accept strings like:
332
333	"RED"
334	"red"
335	"Red Green"
336	"Red+Blue"
337	"blue \| GREEN"
338	"LEDSET_RED + LeDsEt_green"
339
340	=back
341
342	=head2 Methods
343
344	This class uses C<AUTOLOAD> to allow the names of each bit in the bitfield
345	to be used as methods.
346
347	For example, in the synopsis, C<< LedSet->GREEN >> would return 2.
348
349	Other methods it provides:
350
351	=over
352
353	=item C<< from_string( $str ) >>
354
355	Provides the standard coercion from a string, even if this type constraint
356	doesn't have a coercion.
357
358	=item C<< to_string( $int ) >>
359
360	Does the reverse coercion.
361
362	=back
363
364	=head2 Exports
365
366	Type::Tiny::Bitfield can be used as an exporter.
367
368	use Type::Tiny::Bitfield LedSet => {
369	RED => 1,
370	GREEN => 2,
371	BLUE => 4,
372	};
373
374	This will export the following functions into your namespace:
375
376	=over
377
378	=item C<< LedSet >>
379
380	=item C<< is_LedSet( $value ) >>
381
382	=item C<< assert_LedSet( $value ) >>
383
384	=item C<< to_LedSet( $string ) >>
385
386	=item C<< LedSet_to_Str( $value ) >>
387
388	=item C<< LEDSET_RED >>
389
390	=item C<< LEDSET_GREEN >>
391
392	=item C<< LEDSET_BLUE >>
393
394	=back
395
396	Multiple bitfield types can be exported at once:
397
398	use Type::Tiny::Enum (
399	LedSet => { RED => 1, GREEN => 2, BLUE => 4 },
400	LedPattern => [ FLASHING => 1 ],
401	);
402
403	=head1 BUGS
404
405	Please report any bugs to
406	L<https://github.com/tobyink/p5-type-tiny/issues>.
407
408	=head1 SEE ALSO
409
410	L<Type::Tiny::Manual>.
411
412	L<Type::Tiny>.
413
414	=head1 AUTHOR
415
416	Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
417
418	=head1 COPYRIGHT AND LICENCE
419
420	This software is copyright (c) 2023 by Toby Inkster.
421
422	This is free software; you can redistribute it and/or modify it under
423	the same terms as the Perl 5 programming language system itself.
424
425	=head1 DISCLAIMER OF WARRANTIES
426
427	THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
428	WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
429	MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

tobyink / p5-type-tiny / 3c507f025

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous