File Coverage

blib/lib/Object/Pad/ClassAttr/Struct.pm
Criterion Covered Total %
statement 28 28 100.0
branch 3 4 75.0
condition n/a
subroutine 8 8 100.0
pod n/a
total 39 40 97.5


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-2022 -- leonerd@leonerd.org.uk
5              
6             package Object::Pad::ClassAttr::Struct 0.05;
7              
8 4     4   244854 use v5.14;
  4         53  
9 4     4   22 use warnings;
  4         8  
  4         104  
10              
11 4     4   19 use Carp;
  4         8  
  4         262  
12              
13 4     4   650 use Object::Pad 0.76 ':experimental(mop)';
  4         10841  
  4         22  
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             has $red = 0;
30             has $green = 0;
31             has $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 4     4   342 $^H{"Object::Pad::ClassAttr::Struct/Struct"}++;
89             }
90              
91             sub _post_seal
92             {
93 3     3   1392 my ( $class ) = @_;
94 3         13 my $classmeta = Object::Pad::MOP::Class->for_class( $class );
95              
96             # Select just the barename of each scalar field
97 3 50       95 my @fieldnames = map { $_->name =~ m/^[\$](.*)$/ ? $1 : () } $classmeta->fields;
  9         73  
98             # Put them back on again
99 3         28 my $varnames = join ", ", map { "\$$_" } @fieldnames;
  9         27  
100              
101 4     4   1449 no strict 'refs';
  4         11  
  4         790  
102 3         5095 *{"${class}::new_values"} = sub {
103 2     2   2005 my $class = shift;
104 2 100       203 @_ == @fieldnames or
105             croak "Usage: $class\->new_values($varnames)";
106 1         2 my %args;
107 1         6 @args{@fieldnames} = @_;
108 1         18 return $class->new( %args );
109 3         15 };
110             }
111              
112             =head1 AUTHOR
113              
114             Paul Evans
115              
116             =cut
117              
118             0x55AA;