File Coverage

blib/lib/Lexical/Accessor.pm
Criterion Covered Total %
statement 45 51 88.2
branch 21 32 65.6
condition 7 11 63.6
subroutine 12 13 92.3
pod 1 6 16.6
total 86 113 76.1


line stmt bran cond sub pod time code
1 7     7   1480680 use 5.008003;
  7         76  
2 7     7   40 use strict;
  7         12  
  7         164  
3 7     7   33 use warnings;
  7         21  
  7         224  
4 7     7   39 no warnings qw( void once uninitialized );
  7         13  
  7         355  
5              
6             package Lexical::Accessor;
7              
8 7     7   45 use Carp qw(croak);
  7         22  
  7         439  
9 7     7   2995 use Sub::Accessor::Small ();
  7         22  
  7         4262  
10              
11             our $AUTHORITY = 'cpan:TOBYINK';
12             our $VERSION = '0.012';
13             our @EXPORT = qw/ lexical_has /;
14             our @ISA = qw/ Sub::Accessor::Small /;
15              
16             sub _generate_lexical_has : method
17             {
18 7     7   939 my $me = shift;
19 7         39 my $code = $me->_generate_has(@_);
20 7         15 $code = Sub::Name::subname("$me\::lexical_has", $code)
21             if Sub::Accessor::Small::HAS_SUB_NAME;
22 7         35 return $code;
23             }
24              
25             sub lexical_has : method
26             {
27 0     0 1 0 my $has = $_[0]->can('has');
28 0         0 goto $has;
29             }
30            
31             sub inline_to_coderef : method
32             {
33 44     44 0 87 my $me = shift;
34 44         88 my ($method_type, $code) = @_;
35 44         150 my $coderef = $me->SUPER::inline_to_coderef(@_);
36             Sub::Accessor::Small::HAS_SUB_NAME && $me->{package} && defined($me->{slot})
37 44         16887 ? Sub::Name::subname("$me->{package}\::__LEXICAL__[$me->{slot}]", $coderef)
38             : $coderef
39             }
40              
41             sub accessor_kind : method
42             {
43 44     44 0 87 return 'lexical';
44             }
45              
46             sub canonicalize_is : method
47             {
48 22     22 0 45 my $me = shift;
49            
50 22 100       122 if ($me->{is} eq 'rw')
    100          
    100          
    100          
51             {
52             $me->{accessor} = \(my $tmp)
53 5 50       29 if !exists($me->{accessor});
54             }
55             elsif ($me->{is} eq 'ro')
56             {
57             $me->{reader} = \(my $tmp)
58 4 50       18 if !exists($me->{reader});
59             }
60             elsif ($me->{is} eq 'rwp')
61             {
62             $me->{reader} = \(my $tmp1)
63 4 50       33 if !exists($me->{reader});
64             $me->{writer} = \(my $tmp2)
65 4 50       19 if !exists($me->{writer});
66             }
67             elsif ($me->{is} eq 'lazy')
68             {
69             $me->{reader} = \(my $tmp)
70 4 50       19 if !exists($me->{reader});
71             $me->{lazy} = 1
72 4 50       22 if !exists($me->{lazy});
73             $me->{builder} = 1
74 4 50 33     36 unless $me->{builder} || $me->{default};
75             }
76             }
77              
78             sub canonicalize_opts : method
79             {
80 22     22 0 33 my $me = shift;
81 22         94 $me->SUPER::canonicalize_opts(@_);
82              
83 22 50       52 if (defined $me->{init_arg})
84             {
85 0         0 croak("Invalid init_arg=>defined; private attributes cannot be initialized in the constructor");
86             }
87            
88 22 50       48 if ($me->{required})
89             {
90 0         0 croak("Invalid required=>1; private attributes cannot be initialized in the constructor");
91             }
92            
93 22 50 66     71 if (defined $me->{lazy} and not $me->{lazy})
94             {
95 0         0 croak("Invalid lazy=>0; private attributes cannot be eager");
96             }
97             else
98             {
99 22 100 100     129 $me->{lazy} ||= 1 if $me->{default} || $me->{builder};
      66        
100             }
101            
102             # for my $type (qw/ reader writer accessor clearer predicate /)
103             # {
104             # if (defined($me->{$type}) and not ref($me->{$type}) eq q(SCALAR))
105             # {
106             # croak("Expected $type to be a scalar ref; not '$me->{$type}'");
107             # }
108             # }
109             }
110              
111             sub expand_handles
112             {
113 1     1 0 3 my $me = shift;
114            
115 1 50       5 if (ref($me->{handles}) eq q(ARRAY))
116             {
117 1         3 return @{$me->{handles}};
  1         5  
118             }
119            
120 0           croak "Expected delegations to be a reference to an array; got $me->{handles}";
121             }
122              
123             1;
124              
125             __END__
126              
127             =pod
128              
129             =encoding utf-8
130              
131             =for stopwords benchmarking
132              
133             =head1 NAME
134              
135             Lexical::Accessor - true private attributes for Moose/Moo/Mouse
136              
137             =head1 SYNOPSIS
138              
139             my $accessor = lexical_has identifier => (
140             is => 'rw',
141             isa => Int,
142             default => sub { 0 },
143             );
144            
145             # or...
146             lexical_has identifier => (
147             is => 'rw',
148             isa => Int,
149             default => sub { 0 },
150             accessor => \$accessor,
151             );
152            
153             # later...
154             say $self->$accessor; # says 0
155             $self->$accessor( 1 ); # setter
156             say $self->$accessor; # says 1
157              
158             =head1 DESCRIPTION
159              
160             Lexical::Accessor generates coderefs which can be used as methods to
161             access private attributes for objects.
162              
163             The private attributes are stored inside-out, and do not add any
164             accessors to the class' namespace, so are completely invisible to any
165             outside code, including any subclasses. This gives your attribute
166             complete privacy: subclasses can define a private (or even public)
167             attribute with the same name as your private one and they will not
168             interfere with each other.
169              
170             Private attributes cannot be initialized by L<Moose>/L<Moo>/L<Mouse>
171             constructors, but you can safely initialize them inside a C<BUILD> sub.
172              
173             =head2 Functions
174              
175             =over
176              
177             =item C<< lexical_has $name?, %options >>
178              
179             This module exports a function L<lexical_has> which acts much like
180             Moose's C<has> function, but sets up a private (lexical) attribute
181             instead of a public one.
182              
183             Because lexical attributes are stored inside-out, the C<$name> is
184             completely optional; however a name is recommended because it allows
185             better error messages to be generated.
186              
187             The L<lexical_has> function supports the following options:
188              
189             =over
190              
191             =item C<< is >>
192              
193             Moose/Mouse/Moo-style C<ro>, C<rw>, C<rwp> and C<lazy> values are
194             supported. These control what sort of coderef is returned by the
195             C<lexical_has> function itself.
196              
197             my $reader = lexical_has "foo" => (is => "ro");
198             my $accessor = lexical_has "foo" => (is => "rw");
199             my ($reader, $writer) = lexical_has "foo" => (is => "rwp");
200              
201             If generating more than one method it is probably clearer to pass in
202             scalar references to the C<reader>, C<writer>, etc methods, rather than
203             relying on the return value of the C<lexical_has> function.
204              
205             =item C<< reader >>, C<< writer >>, C<< accessor >>, C<< predicate >>,
206             C<< clearer >>
207              
208             These accept scalar references. The relevant coderefs will be plonked
209             into them:
210              
211             my ($get_foo, $set_foo);
212            
213             lexical_has foo => (
214             reader => \$get_foo,
215             writer => \$set_foo,
216             );
217              
218             They can also be method names as strings:
219              
220             my ($set_foo);
221            
222             lexical_has foo => (
223             reader => 'get_foo',
224             writer => \$set_foo,
225             );
226              
227             This allows you to provide a partly public API for an attribute.
228              
229             =item C<< default >>, C<< builder >>, C<< lazy >>
230              
231             Lazy defaults and builders are allowed. Eager (non-lazy) defaults and
232             builders are currently disallowed. (Use a C<BUILD> sub to set private
233             attribute values at object construction time.)
234              
235             The default may be either a non-reference value, or a coderef which
236             will be called as a method to return the value.
237              
238             Builders probably make less sense than defaults because they require
239             a method in the class' namespace. The builder may be a method name, or
240             the special value C<< '1' >> which will be interpreted as meaning the
241             attribute name prefixed by "_build_". If a coderef is provided, this is
242             automatically installed into the class' namespace with the "_build_"
243             prefix. (This last feature requires L<Sub::Name>.)
244              
245             =item C<< isa >>
246              
247             A type constraint for the attribute. L<Moo>-style coderefs are
248             accepted (including those generated by L<MooX::Types::MooseLike>),
249             as are L<Moose::Meta::TypeConstraint>/L<MooseX::Types> objects,
250             and L<Mouse::Meta::TypeConstraint>/L<MouseX::Types> objects, and
251             of course L<Type::Tiny> type constraints.
252              
253             String type constraints may also be accepted, but only if
254             L<Type::Utils> is installed. (String type constraints are reified
255             using C<dwim_type>.)
256              
257             =item C<< does >>
258              
259             As an alternative to C<isa>, you can provide a role name in the
260             C<does> option.
261              
262             =item C<< coerce >>
263              
264             A coderef or L<Type::Coercion> object is accepted.
265              
266             If the special value C<< '1' >> is provided, the type constraint object
267             is consulted to find the coercion. (This doesn't work for coderef type
268             constraints.)
269              
270             =item C<< trigger >>
271              
272             A method name or coderef to trigger when a new value is set.
273              
274             =item C<< auto_deref >>
275              
276             Boolean indicating whether to automatically dereference array and hash
277             values if called in list context.
278              
279             =item C<< init_arg >>
280              
281             Must be C<undef> if provided at all.
282              
283             =item C<< required >>
284              
285             Must be false if provided at all.
286              
287             =item C<< weak_ref >>
288              
289             Boolean. Makes the setter weaken any references it is called with.
290              
291             =item C<< handles >>
292              
293             Delegates methods. Has slightly different syntax to Moose's option of
294             the same name - is required to be an arrayref of pairs such that in
295             each pair, the first is a scalar ref or a string method name that will
296             be handled, and the second is a coderef or string method name that
297             will do the handling. (The second can be an arrayref in the case of
298             currying.)
299            
300             my ($get, $post);
301            
302             lexical_has ua => (
303             isa => 'HTTP::Tiny',
304             default => sub { 'HTTP::Tiny'->new },
305             handles => [
306             \$get => 'get',
307             \$post => 'post',
308             ],
309             );
310            
311             # later...
312             my $response = $self->$get('http://example.net/');
313              
314             Supports L<Sub::HandlesVia>:
315              
316             my $remove_task;
317             lexical_has tasks => (
318             isa => ArrayRef,
319             handles_via => 'Array',
320             handles => [
321             task_count => 'count',
322             add_task => 'push',
323             next_task => [ 'get', 0 ],
324             \$remove_task => 'unshift',
325             ],
326             );
327            
328             # later...
329             while ($self->task_count) {
330             my $task = $self->next_task;
331             my $success = $self->handle_task($task);
332             if ($success) {
333             $self->$remove_task;
334             }
335             }
336              
337             =item C<< initializer >>, C<< traits >>, C<< lazy_build >>
338              
339             Not currently implemented. Providing any of these options throws an
340             error.
341              
342             =item C<< documentation >>, C<< definition_context >>
343              
344             Don't do anything, but are allowed; effectively inline comments.
345              
346             =back
347              
348             =back
349              
350             =head2 Class Methods
351              
352             =over
353              
354             =item C<< lexical_has >>
355              
356             This function may also be called as a class method.
357              
358             =back
359              
360             =head2 Comparison (benchmarking, etc)
361              
362             Lexical::Accessor is almost three times faster than
363             L<MooX::PrivateAttributes>, and almost twenty time faster than
364             L<MooseX::Privacy>. I'd also argue that it's a more "correct"
365             implementation of private accessors as (short of performing impressive
366             L<PadWalker> manipulations), the accessors generated by this module
367             are completely invisible to subclasses, method dispatch, etc.
368              
369             Compared to the usual Moose convention of using a leading underscore
370             to indicate a private method (which is a very loose convention; it is
371             quite common for subclasses to override such methods!),
372             L<Lexical::Accessor> clearly offers much better method privacy. There
373             should be little performance hit from using lexical accessors compared
374             to normal L<Moose> accessors. (However they are nowhere near the speed
375             of the XS-powered accessors that L<Moo> I<sometimes> uses and L<Mouse>
376             I<usually> uses.)
377              
378             See also: C<< examples/benchmark.pl >> bundled with this release.
379              
380             =head1 BUGS
381              
382             Please report any bugs to
383             L<http://rt.cpan.org/Dist/Display.html?Queue=Lexical-Accessor>.
384              
385             =head1 SUPPORT
386              
387             B<< IRC: >> support is available through in the I<< #moops >> channel
388             on L<irc.perl.org|http://www.irc.perl.org/channels.html>.
389              
390             =head1 SEE ALSO
391              
392             L<MooX::PrivateAttributes>,
393             L<MooX::ProtectedAttributes>,
394             L<MooseX::Privacy>,
395             L<Sub::Private>,
396             L<Method::Lexical>,
397             etc...
398              
399             =head1 AUTHOR
400              
401             Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
402              
403             =head1 COPYRIGHT AND LICENCE
404              
405             This software is copyright (c) 2013-2014, 2017 by Toby Inkster.
406              
407             This is free software; you can redistribute it and/or modify it under
408             the same terms as the Perl 5 programming language system itself.
409              
410             =head1 DISCLAIMER OF WARRANTIES
411              
412             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
413             WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
414             MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
415