84cadb5fa

Committed 23 Dec 2025 10:42PM UTC coverage: 80.431% (-7.2%) from 87.607%

Build # 84cadb5fa

Build Type

push

github

Committed by

Commit Message

Run Details

485 of 603 relevant lines covered (80.43%)

8.05 hits per line

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

96.55

/lib/Marlin/Struct.pm

use 5.008008;
use strict;
use warnings;
use utf8;

package Marlin::Struct;

our $AUTHORITY = 'cpan:TOBYINK';
our $VERSION   = '0.011002';

use Marlin ();

my $uniq_id = 0;

sub import {
        my $me = shift;
        my $caller = caller;
        
        my %defs;
        
        while ( @_ ) {
                my ( $name, $definition ) = splice @_, 0, 2;
                my $class_name = sprintf '%s::__ANON__::_%06d', $me, ++$uniq_id;
                
                my $marlin = Marlin->new(
                        '-caller' => [ $caller ],
                        '-this'   => [ $class_name ],
                        @$definition,
                );
                $defs{$name} = $marlin;
                @{ $marlin->parents } = map {
                        $defs{$_->[0]} ? [ $defs{$_->[0]}->this ] : $_
                } @{ $marlin->parents };
                $marlin->{short_name} = $name;
                $marlin->{is_struct}  = !!1;
                $marlin->store_meta;
                $marlin->do_setup;
                
                Type::Tiny::_install_overloads(
                        $marlin->this,
                        q(@{})   => sub { $marlin->to_arrayref( @_ ) },
                        q("")    => sub { $marlin->to_string( @_ ) },
                        q(bool)  => sub { !!1 },
                );
                
                my $type = $marlin->make_type_constraint( $name );
                my @exportables = @{ $type->exportables };
                for my $e ( @exportables ) {
                        Eval::TypeTiny::set_subname( $me . '::' . $e->{name}, $e->{code} );
                        $marlin->lexport( $e->{name}, $e->{code} );
                }
        }
}

1;

__END__

=pod

=encoding utf-8

=head1 NAME

Marlin::Struct - quickly create struct-like classes

=head1 SYNOPSIS

  use v5.20.0;
  use Types::Common 'Num';
  
  use Marlin::Struct
    Point    => [ 'x!' => Num, 'y!' => Num ],
    Point3D  => [ 'z!' => Num, -parent => \'Point' ];
  
  my $point   = Point->new( x => 1, y => 2 );
  my $point3d = Point3D[ 1, 2, 3 ];
  
  is_Point( $point3d ) or die;
  assert_Point( $point3d );
  
  use Marlin::Struct
    Rectangle => [ 'corner1!' => Point, 'corner2! => Point ]; 

=head1 DESCRIPTION

This module quickly creates "anonymous-like" classes and gives you a lexical
function to construct instances.

The C<< use Marlin::Struct >> line accepts a list of key-value pairs. Each
key should be the name you want to use for the class. This is B<not> a Perl
package name, but an UpperCamelCase string which will only be available
lexically. The value should be a L<Marlin> definition of the class.

Taking C<Point> from the L</SYNOPSIS> as an example, Marlin::Struct will
export (lexically if your Perl version is 5.12+) the following subs for you:

=over

=item C<Point>

The C<< Point >> sub has many purposes.

Called with no parameters, it returns a L<type constraint object|Type::Tiny>
which can be used in C<isa> constraints, in C<signature_for> signatures, or
be tied to variables:

  use Marlin::Struct Point => [ 'x!', 'y!' ];
  use Marlin::Struct Rectangle => [
    'corner1!' => { isa => Point, coerce => true }
    'corner2!' => { isa => Point, coerce => true }
  ];
  
  tie( my $c, Point );
  $c = [ 1, 2 ];
  printf( "Coordinates: %f, %f.\n", $c->x, $c->y );
  
  signature_for draw_point => (
    positional => [
      Point,
      Str, { default => 'black' },
    ],
  );
  
  sub draw_point ( $point, $colour ) {
    ...;
  }

It can alternatively be given a hashref to create a new object of that class:

  my $c = Point { x => 1, y => 2 };

Note that it must be a hashref, not a hash/list.

  my $c = Point( x => 1, y => 2 );  # NOT THIS!

Or you can pass it an arrayref to create an object instead. If passing an
arrayref, then any required attributes can be given positionally, using
the order they were declared in.

  # These should all work!
  my $c = Point[ x => 1, y => 2 ];
  my $c = Point[ 1, y => 2 ];
  my $c = Point[ 1, 2 ];

Lastly, you can call a few useful methods on it:

  # The underlying Perl package your objects are blessed into.
  # While this will be stable in a single process, it may vary from
  # one run of your program to another. It will be something like
  # "Marlin::Struct::__ANON__::_000123". You should never really
  # have to care exactly what string this returns!
  #
  my $real_class = Point->class;
  
  # An alternative way to construct a Point object.
  #
  my $c = Point->new( x => 1, y => 2 );
  
  # Point() returns a Type::Tiny object, so you can call any methods
  # defined in Type::Tiny on it.
  #
  if ( Point->check( $c ) ) {
    print "The value of \$c is a valid Point object!\n";
  }

=item C<< is_Point >>

A quick check to see if a value is a valid Point.

  if ( is_Point $c ) {
    ...;
  }

=item C<< assert_Point >>

Like C<is_Point>, but instead of returning a boolean, throws an exception if
the given value fails the check.

=item C<< to_Point >>

Can be passed a hashref or arrayref to convert it to a Point.

  # Simple case
  my $c = to_Point( { x => 1, y => 2 } );
  
  # Like Point[1, 2]
  my $c = to_Point( [ 1, 2 ] );
  
  # Can also be given an existing Point object, and just passes it through,
  # not really doing anything.
  my $c = to_Point( Point[1, 2] );
  
  # If passed something that cannot be converted into a Point object, just
  # passes it through, not really doing anything!
  my $c = to_Point( \*STDIN );
  
  # If you need to ensure that to_Point was successful...
  assert_Point my $c = to_Point( \*STDIN );

=back

Marlin::Struct is mostly suitable for defining helper classes that your
main public classes use internally which don't need any proper methods,
just a constructor and accessors. Classes defined using Marlin::Struct
will have stringification and arrayrefification defined for you, which is
mostly pretty sensible.

  use Marlin::Struct
    Point       => [ 'x!' => Num, 'y!' => Num ],
    ColourPoint => [ -isa => \'Point', colour => { default => 'red' } ];
  
  my $point1 = Point[1, 2];
  say "$point1";  # ==> Point[1, 2]
  
  my $point2 = ColourPoint[1, 2];
  say "$point2";  # ==> ColourPoint[1, 2, colour => "red"]

Stringification and arrayrefification will skip any attributes that have their
storage set to "PRIVATE".

=head1 BUGS

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

=head1 SEE ALSO

L<Marlin>.

=head1 AUTHOR

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

=head1 COPYRIGHT AND LICENCE

This software is copyright (c) 2025 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	use 5.008008;	1✔
2	use strict;	1✔
3	use warnings;	1✔
4	use utf8;	1✔
5
6	package Marlin::Struct;
7
8	our $AUTHORITY = 'cpan:TOBYINK';
9	our $VERSION = '0.011002';
10
11	use Marlin ();	1✔
12
13	my $uniq_id = 0;
14
15	sub import {
16	my $me = shift;	1✔
17	my $caller = caller;	1✔
18
19	my %defs;	1✔
20
21	while ( @_ ) {	1✔
22	my ( $name, $definition ) = splice @_, 0, 2;	2✔
23	my $class_name = sprintf '%s::__ANON__::_%06d', $me, ++$uniq_id;	2✔
24
25	my $marlin = Marlin->new(	2✔
26	'-caller' => [ $caller ],
27	'-this' => [ $class_name ],
28	@$definition,
29	);
30	$defs{$name} = $marlin;	2✔
31	@{ $marlin->parents } = map {	2✔
32	$defs{$_->[0]} ? [ $defs{$_->[0]}->this ] : $_	1✔
33	} @{ $marlin->parents };	2✔
34	$marlin->{short_name} = $name;	2✔
35	$marlin->{is_struct} = !!1;	2✔
36	$marlin->store_meta;	2✔
37	$marlin->do_setup;	2✔
38
39	Type::Tiny::_install_overloads(
40	$marlin->this,
41	q(@{}) => sub { $marlin->to_arrayref( @_ ) },	1✔
42	q("") => sub { $marlin->to_string( @_ ) },	1✔
43	q(bool) => sub { !!1 },	×
44	);	2✔
45
46	my $type = $marlin->make_type_constraint( $name );	2✔
47	my @exportables = @{ $type->exportables };	2✔
48	for my $e ( @exportables ) {	2✔
49	Eval::TypeTiny::set_subname( $me . '::' . $e->{name}, $e->{code} );	8✔
50	$marlin->lexport( $e->{name}, $e->{code} );	8✔
51	}
52	}
53	}
54
55	1;
56
57	__END__
58
59	=pod
60
61	=encoding utf-8
62
63	=head1 NAME
64
65	Marlin::Struct - quickly create struct-like classes
66
67	=head1 SYNOPSIS
68
69	use v5.20.0;
70	use Types::Common 'Num';
71
72	use Marlin::Struct
73	Point => [ 'x!' => Num, 'y!' => Num ],
74	Point3D => [ 'z!' => Num, -parent => \'Point' ];
75
76	my $point = Point->new( x => 1, y => 2 );
77	my $point3d = Point3D[ 1, 2, 3 ];
78
79	is_Point( $point3d ) or die;
80	assert_Point( $point3d );
81
82	use Marlin::Struct
83	Rectangle => [ 'corner1!' => Point, 'corner2! => Point ];
84
85	=head1 DESCRIPTION
86
87	This module quickly creates "anonymous-like" classes and gives you a lexical
88	function to construct instances.
89
90	The C<< use Marlin::Struct >> line accepts a list of key-value pairs. Each
91	key should be the name you want to use for the class. This is B<not> a Perl
92	package name, but an UpperCamelCase string which will only be available
93	lexically. The value should be a L<Marlin> definition of the class.
94
95	Taking C<Point> from the L</SYNOPSIS> as an example, Marlin::Struct will
96	export (lexically if your Perl version is 5.12+) the following subs for you:
97
98	=over
99
100	=item C<Point>
101
102	The C<< Point >> sub has many purposes.
103
104	Called with no parameters, it returns a L<type constraint object\|Type::Tiny>
105	which can be used in C<isa> constraints, in C<signature_for> signatures, or
106	be tied to variables:
107
108	use Marlin::Struct Point => [ 'x!', 'y!' ];
109	use Marlin::Struct Rectangle => [
110	'corner1!' => { isa => Point, coerce => true }
111	'corner2!' => { isa => Point, coerce => true }
112	];
113
114	tie( my $c, Point );
115	$c = [ 1, 2 ];
116	printf( "Coordinates: %f, %f.\n", $c->x, $c->y );
117
118	signature_for draw_point => (
119	positional => [
120	Point,
121	Str, { default => 'black' },
122	],
123	);
124
125	sub draw_point ( $point, $colour ) {
126	...;
127	}
128
129	It can alternatively be given a hashref to create a new object of that class:
130
131	my $c = Point { x => 1, y => 2 };
132
133	Note that it must be a hashref, not a hash/list.
134
135	my $c = Point( x => 1, y => 2 ); # NOT THIS!
136
137	Or you can pass it an arrayref to create an object instead. If passing an
138	arrayref, then any required attributes can be given positionally, using
139	the order they were declared in.
140
141	# These should all work!
142	my $c = Point[ x => 1, y => 2 ];
143	my $c = Point[ 1, y => 2 ];
144	my $c = Point[ 1, 2 ];
145
146	Lastly, you can call a few useful methods on it:
147
148	# The underlying Perl package your objects are blessed into.
149	# While this will be stable in a single process, it may vary from
150	# one run of your program to another. It will be something like
151	# "Marlin::Struct::__ANON__::_000123". You should never really
152	# have to care exactly what string this returns!
153	#
154	my $real_class = Point->class;
155
156	# An alternative way to construct a Point object.
157	#
158	my $c = Point->new( x => 1, y => 2 );
159
160	# Point() returns a Type::Tiny object, so you can call any methods
161	# defined in Type::Tiny on it.
162	#
163	if ( Point->check( $c ) ) {
164	print "The value of \$c is a valid Point object!\n";
165	}
166
167	=item C<< is_Point >>
168
169	A quick check to see if a value is a valid Point.
170
171	if ( is_Point $c ) {
172	...;
173	}
174
175	=item C<< assert_Point >>
176
177	Like C<is_Point>, but instead of returning a boolean, throws an exception if
178	the given value fails the check.
179
180	=item C<< to_Point >>
181
182	Can be passed a hashref or arrayref to convert it to a Point.
183
184	# Simple case
185	my $c = to_Point( { x => 1, y => 2 } );
186
187	# Like Point[1, 2]
188	my $c = to_Point( [ 1, 2 ] );
189
190	# Can also be given an existing Point object, and just passes it through,
191	# not really doing anything.
192	my $c = to_Point( Point[1, 2] );
193
194	# If passed something that cannot be converted into a Point object, just
195	# passes it through, not really doing anything!
196	my $c = to_Point( \*STDIN );
197
198	# If you need to ensure that to_Point was successful...
199	assert_Point my $c = to_Point( \*STDIN );
200
201	=back
202
203	Marlin::Struct is mostly suitable for defining helper classes that your
204	main public classes use internally which don't need any proper methods,
205	just a constructor and accessors. Classes defined using Marlin::Struct
206	will have stringification and arrayrefification defined for you, which is
207	mostly pretty sensible.
208
209	use Marlin::Struct
210	Point => [ 'x!' => Num, 'y!' => Num ],
211	ColourPoint => [ -isa => \'Point', colour => { default => 'red' } ];
212
213	my $point1 = Point[1, 2];
214	say "$point1"; # ==> Point[1, 2]
215
216	my $point2 = ColourPoint[1, 2];
217	say "$point2"; # ==> ColourPoint[1, 2, colour => "red"]
218
219	Stringification and arrayrefification will skip any attributes that have their
220	storage set to "PRIVATE".
221
222	=head1 BUGS
223
224	Please report any bugs to
225	L<https://github.com/tobyink/p5-marlin/issues>.
226
227	=head1 SEE ALSO
228
229	L<Marlin>.
230
231	=head1 AUTHOR
232
233	Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
234
235	=head1 COPYRIGHT AND LICENCE
236
237	This software is copyright (c) 2025 by Toby Inkster.
238
239	This is free software; you can redistribute it and/or modify it under
240	the same terms as the Perl 5 programming language system itself.
241
242	=head1 DISCLAIMER OF WARRANTIES
243
244	THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
245	WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
246	MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

tobyink / p5-marlin / 84cadb5fa

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