File Coverage

blib/lib/Object/Pad/ClassAttr/Struct.pm
Criterion Covered Total %
statement 28 29 96.5
branch 3 4 75.0
condition n/a
subroutine 8 9 88.8
pod n/a
total 39 42 92.8


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, 2021-2023 -- leonerd@leonerd.org.uk
5              
6             package Object::Pad::ClassAttr::Struct 0.06;
7              
8 4     4   753425 use v5.14;
  4         39  
9 4     4   24 use warnings;
  4         8  
  4         105  
10              
11 4     4   21 use Carp;
  4         7  
  4         253  
12              
13 4     4   806 use Object::Pad 0.76 ':experimental(mop)';
  4         11861  
  4         285  
14              
15             require XSLoader;
16             XSLoader::load( __PACKAGE__, our $VERSION );
17              
18             =head1 NAME
19              
20             C - declare an C class to be struct-like
21              
22             =head1 SYNOPSIS
23              
24             use Object::Pad;
25             use Object::Pad::ClassAttr::Struct;
26              
27             class Colour :Struct {
28             # These get :param :mutator automatically
29             field $red = 0;
30             field $green = 0;
31             field $blue = 0;
32              
33             # Additional methods are still permitted
34             method lightness {
35             return ($red + $green + $blue) / 3;
36             }
37             }
38              
39             my $cyan = Colour->new( green => 1, blue => 1 );
40              
41             # A positional constructor is created automatically
42             my $white = Colour->new_values(1, 1, 1);
43              
44             =head1 DESCRIPTION
45              
46             This module provides a third-party class attribute for L-based
47             classes, which applies some attributes automatically to every field added to
48             the class, as a convenient shortcut for making structure-like classes.
49              
50             =head1 CLASS ATTRIBUTES
51              
52             =head2 :Struct
53              
54             class Name :Struct ... { ... }
55              
56             Automatically applies the C<:param> and C<:mutator> attributes to every field
57             defined on the class, meaning the constructor will accept parameters for each
58             field to initialise the value, and each field will have an lvalue mutator
59             method.
60              
61             In addition, the class itself gains the C<:strict(params)> attribute, meaning
62             the constructor will check parameter names and throw an exception for
63             unrecognised names.
64              
65             I a positional constructor class method called
66             C is also provided into the class, which takes a value for every
67             field positionally, in declared order.
68              
69             $obj = ClassName->new_values($v1, $v2, $v3, ...);
70              
71             This positional constructor must receive as many positional arguments as there
72             are fields in total in the class; even the optional ones. All arguments are
73             required here.
74              
75             I the following options are permitted inside the attribute
76             value parentheses:
77              
78             =head3 :Struct(readonly)
79              
80             Instances of this class do not permit fields to be modified after
81             construction. The accessor is created using the C<:reader> field attribute
82             rather than C<:mutator>.
83              
84             =cut
85              
86             sub import
87             {
88 3     3   316 $^H{"Object::Pad::ClassAttr::Struct/Struct"}++;
89             }
90              
91             sub unimport
92             {
93 0     0   0 delete $^H{"Object::Pad::ClassAttr::Struct/Struct"};
94             }
95              
96             sub _post_seal
97             {
98 3     3   1521 my ( $class ) = @_;
99 3         19 my $classmeta = Object::Pad::MOP::Class->for_class( $class );
100              
101             # Select just the barename of each scalar field
102 3 50       98 my @fieldnames = map { $_->name =~ m/^[\$](.*)$/ ? $1 : () } $classmeta->fields;
  9         72  
103             # Put them back on again
104 3         27 my $varnames = join ", ", map { "\$$_" } @fieldnames;
  9         29  
105              
106 4     4   1617 no strict 'refs';
  4         11  
  4         789  
107 3         6407 *{"${class}::new_values"} = sub {
108 2     2   7853 my $class = shift;
109 2 100       258 @_ == @fieldnames or
110             croak "Usage: $class\->new_values($varnames)";
111 1         3 my %args;
112 1         5 @args{@fieldnames} = @_;
113 1         18 return $class->new( %args );
114 3         15 };
115             }
116              
117             =head1 AUTHOR
118              
119             Paul Evans
120              
121             =cut
122              
123             0x55AA;