File Coverage

blib/lib/Sub/Accessor/Small.pm
Criterion Covered Total %
statement 190 270 70.3
branch 74 158 46.8
condition 21 98 21.4
subroutine 45 53 84.9
pod 0 35 0.0
total 330 614 53.7


line stmt bran cond sub pod time code
1 8     8   66919 use 5.008003;
  8         42  
2 8     8   41 use strict;
  8         14  
  8         176  
3 8     8   40 use warnings;
  8         15  
  8         274  
4 8     8   55 no warnings qw( void once uninitialized );
  8         15  
  8         416  
5              
6             package Sub::Accessor::Small;
7              
8 8     8   57 use Carp qw( carp croak );
  8         23  
  8         482  
9 8     8   1461 use Eval::TypeTiny qw();
  8         5803  
  8         175  
10 8     8   1440 use Exporter::Tiny qw();
  8         10244  
  8         245  
11 8     8   51 use Scalar::Util qw( blessed reftype );
  8         23  
  8         1310  
12              
13             BEGIN {
14 8         1452 *HAS_SUB_UTIL = eval { require Sub::Util }
15             ? sub(){1}
16 8 50   8   38 : sub(){0};
17             *HAS_SUB_NAME = !HAS_SUB_UTIL() && eval { require Sub::Name }
18             ? sub(){1}
19 8 50 33     1638 : sub(){0};
20             };
21              
22             BEGIN {
23             *fieldhash =
24             eval { require Hash::FieldHash; \&Hash::FieldHash::fieldhash } ||
25             eval { require Hash::Util::FieldHash; \&Hash::Util::FieldHash::fieldhash } ||
26 8   33 8   28 do { require Hash::Util::FieldHash::Compat; \&Hash::Util::FieldHash::Compat::fieldhash } ;;
27             };
28              
29             our $AUTHORITY = 'cpan:TOBYINK';
30             our $VERSION = '0.012';
31             our @ISA = qw/ Exporter::Tiny /;
32              
33             fieldhash( our %FIELDS );
34              
35             sub _generate_has : method
36             {
37 8     8   181 my $me = shift;
38 8         20 my (undef, undef, $export_opts) = @_;
39            
40             my $code = sub
41             {
42 24     24   3442 my $attr = $me->new_from_has($export_opts, @_);
        24      
43 24         79 $attr->install_accessors;
44 8         37 };
45            
46 8         72 HAS_SUB_UTIL ? ($code = Sub::Util::set_subname("$me\::has", $code)) :
47             HAS_SUB_NAME ? ($code = Sub::Name::subname("$me\::has", $code)) :
48             ();
49 8         29 return $code;
50             }
51              
52             {
53             my $uniq = 0;
54             sub new_from_has : method
55             {
56 24     24 0 53 my $me = shift;
57 24 50       79 my $export_opts = ref($_[0]) eq 'HASH' ? shift(@_) : {};
58 24 50       144 my ($name, %opts) = (@_%2) ? @_ : (undef, @_);
59            
60 24         43 my $package;
61             $package = $export_opts->{into}
62 24 50 33     147 if defined($export_opts->{into}) && !ref($export_opts->{into});
63            
64 24 50       140 $me->new(
65             slot => $name,
66             id => $uniq++,
67             _export => $export_opts,
68             ($package ? (package => $package) : ()),
69             %opts,
70             );
71             }
72             }
73              
74             sub has : method
75             {
76 0     0 0 0 my $me = shift;
77 0         0 my $attr = $me->new_from_has(@_);
78 0         0 $attr->install_accessors;
79             }
80              
81             sub new : method
82             {
83 24     24 0 43 my $me = shift;
84 24         164 my (%opts) = @_;
85 24         58 my $self = bless(\%opts, $me);
86 24         95 $self->canonicalize_opts;
87 24         81 return $self;
88             }
89              
90             sub install_accessors : method
91             {
92 24     24 0 36 my $me = shift;
93            
94 24         51 for my $type (qw( accessor reader writer predicate clearer ))
95             {
96 120 100       466 next unless defined $me->{$type};
97 44         224 $me->install_coderef($me->{$type}, $me->$type);
98             }
99            
100 24 100       78 if (defined $me->{handles}) {
101 1         2 my $shv_data;
102 1 50 33     6 if ($me->{traits} or $me->{handles_via}) {
103 1         3 my $orig_handles = $me->{handles};
104 1         7 require Sub::HandlesVia::Toolkit::Plain;
105             $shv_data = 'Sub::HandlesVia::Toolkit::Plain'->clean_spec(
106             $me->{package},
107             $me->{slot},
108 1         22 +{%$me},
109             );
110 1 50       59 if ($shv_data) {
111             my $callbacks = 'Sub::HandlesVia::Toolkit::Plain'->make_callbacks(
112             $me->{package},
113 1         6 [ $me->reader, $me->writer ],
114             );
115 1         68 require Sub::HandlesVia::Handler;
116 1         4 $me->{handles} = $orig_handles;
117 1         4 my @pairs = $me->expand_handles;
118 1         4 while (@pairs) {
119 2         24 my ($target, $method) = splice(@pairs, 0, 2);
120 2         15 my $handler = 'Sub::HandlesVia::Handler'->lookup($method, $shv_data->{handles_via});
121             $me->install_coderef(
122             $target,
123             $handler->coderef(
124             %$callbacks,
125             target => $me->{package},
126 2 100       8780 method_name => ref($target) ? '__ANON__' : $target,
127             ),
128             );
129             }
130             }
131             }
132            
133 1 50       33 if (!$shv_data) {
134 0         0 my @pairs = $me->expand_handles;
135 0         0 while (@pairs) {
136 0         0 my ($target, $method) = splice(@pairs, 0, 2);
137 0         0 $me->install_coderef($target, $me->handles($method));
138             }
139             }
140             }
141            
142             my @return = map $$_,
143             $me->{is} eq 'ro' ? ($me->{reader}) :
144             $me->{is} eq 'rw' ? ($me->{accessor}) :
145             $me->{is} eq 'rwp' ? ($me->{reader}, $me->{writer}) :
146 24 100       167 $me->{is} eq 'lazy' ? ($me->{reader}) :
    100          
    100          
    100          
147             ();
148 24 100       3069 wantarray ? @return : $return[0];
149             }
150              
151             sub install_coderef
152             {
153 46     46 0 2691 my $me = shift;
154 46         118 my ($target, $coderef) = @_;
155            
156 46 50       123 return unless defined $target;
157            
158 46 100 66     158 if (!ref $target and $target =~ /\A[^\W0-9]\w+\z/)
159             {
160 3         12 my $name = "$me->{package}\::$target";
161 3         29 HAS_SUB_UTIL ? ($coderef = Sub::Util::set_subname($name, $coderef)) :
162             HAS_SUB_NAME ? ($coderef = Sub::Name::subname($name, $coderef)) :
163             ();
164 8     8   77 no strict qw(refs);
  8         16  
  8         23253  
165 3         15 *$name = $coderef;
166 3         13 return;
167             }
168            
169 43 50 33     208 if (ref($target) eq q(SCALAR) and not defined $$target)
170             {
171 43         72 $$target = $coderef;
172 43         115 return;
173             }
174            
175 0 0 0     0 if (!ref($target) and $target eq 1)
176             {
177 0         0 return;
178             }
179            
180 0         0 croak "Expected installation target to be a reference to an undefined scalar; got $target";
181             }
182              
183             sub expand_handles
184             {
185 0     0 0 0 my $me = shift;
186            
187 0 0       0 if (ref($me->{handles}) eq q(ARRAY))
    0          
188             {
189 0         0 return map ($_=>$_), @{$me->{handles}};
  0         0  
190             }
191             elsif (ref($me->{handles}) eq q(HASH))
192             {
193 0         0 return %{$me->{handles}};
  0         0  
194             }
195            
196 0         0 croak "Expected delegations to be a reference to an array or hash; got $me->{handles}";
197             }
198              
199             {
200             my %one = (
201             accessor => [qw/ %s %s /],
202             reader => [qw/ get_%s _get%s /],
203             writer => [qw/ set_%s _set%s /],
204             predicate => [qw/ has_%s _has%s /],
205             clearer => [qw/ clear_%s _clear%s /],
206             trigger => [qw/ _trigger_%s _trigger_%s /],
207             builder => [qw/ _builder_%s _builder_%s /],
208             );
209            
210             sub canonicalize_1 : method
211             {
212 24     24 0 36 my $me = shift;
213            
214 24 50       88 my $is_private = ($me->{slot} =~ /\A_/) ? 1 : 0;
215            
216 24         87 for my $type (keys %one)
217             {
218 168 100       318 next if !exists($me->{$type});
219 48 100       163 next if ref($me->{$type});
220 2 50       6 next if $me->{$type} ne 1;
221            
222             croak("Cannot interpret $type=>1 because attribute has no name defined")
223 0 0       0 if !defined $me->{slot};
224            
225 0         0 $me->{$type} = sprintf($one{$type}[$is_private], $me->{slot});
226             }
227             }
228            
229             sub canonicalize_builder : method
230             {
231 24     24 0 40 my $me = shift;
232 24         41 my $name = $me->{slot};
233            
234 24 50       61 if (ref $me->{builder} eq 'CODE')
235             {
236             HAS_SUB_UTIL or
237             HAS_SUB_NAME or
238 0         0 do { require Sub::Util };
239            
240 0         0 my $code = $me->{builder};
241             defined($name) && defined($me->{package})
242 0 0 0     0 or croak("Invalid builder; expected method name as string");
243            
244 0 0       0 my $is_private = ($name =~ /\A_/) ? 1 : 0;
245            
246 0         0 my $subname = sprintf($one{builder}[$is_private], $name);
247 0         0 my $fq_subname = "$me->{package}\::$name";
248             $me->_exporter_install_sub(
249             $subname,
250             {},
251             $me->{_export},
252 0         0 Sub::Name::subname($fq_subname, $code),
253             );
254             }
255             }
256             }
257              
258             sub canonicalize_is : method
259             {
260 2     2 0 5 my $me = shift;
261 2         4 my $name = $me->{slot};
262            
263 2 50       11 if ($me->{is} eq 'rw')
    50          
    50          
    50          
264             {
265             $me->{accessor} = $name
266 0 0 0     0 if !exists($me->{accessor}) and defined $name;
267             }
268             elsif ($me->{is} eq 'ro')
269             {
270             $me->{reader} = $name
271 0 0 0     0 if !exists($me->{reader}) and defined $name;
272             }
273             elsif ($me->{is} eq 'rwp')
274             {
275             $me->{reader} = $name
276 0 0 0     0 if !exists($me->{reader}) and defined $name;
277             $me->{writer} = "_set_$name"
278 0 0 0     0 if !exists($me->{writer}) and defined $name;
279             }
280             elsif ($me->{is} eq 'lazy')
281             {
282             $me->{reader} = $name
283 0 0 0     0 if !exists($me->{reader}) and defined $name;
284             $me->{lazy} = 1
285 0 0       0 if !exists($me->{lazy});
286             $me->{builder} = 1
287 0 0 0     0 unless $me->{builder} || $me->{default};
288             }
289             }
290              
291             sub canonicalize_default : method
292             {
293 24     24 0 37 my $me = shift;
294 24 100       64 return unless exists $me->{default};
295            
296 5 50       25 unless (ref $me->{default})
297             {
298 0         0 my $value = $me->{default};
299 0     0   0 $me->{default} = sub { $value };
  0         0  
300             }
301            
302             croak("Invalid default; expected a CODE ref")
303 5 50       24 unless ref $me->{default} eq 'CODE';
304             }
305              
306             sub canonicalize_isa : method
307             {
308 24     24 0 40 my $me = shift;
309            
310 24 50       58 if (my $does = $me->{does})
311             {
312 0 0 0 0   0 $me->{isa} ||= sub { blessed($_[0]) && $_[0]->DOES($does) };
  0         0  
313             }
314            
315 24 50 66     88 if (defined $me->{isa} and not ref $me->{isa})
316             {
317 0         0 my $type_name = $me->{isa};
318 0 0       0 eval { require Type::Utils }
  0         0  
319             or croak("Missing requirement; type constraint strings require Type::Utils");
320            
321             $me->{isa} = $me->{package}
322             ? Type::Utils::dwim_type($type_name, for => $me->{package})
323 0 0       0 : Type::Utils::dwim_type($type_name);
324             }
325             }
326              
327             sub canonicalize_trigger : method
328             {
329 24     24 0 35 my $me = shift;
330            
331 24 50 66     90 if (defined $me->{trigger} and not ref $me->{trigger})
332             {
333 0         0 my $method_name = $me->{trigger};
334 0     0   0 $me->{trigger} = sub { my $self = shift; $self->$method_name(@_) };
  0         0  
  0         0  
335             }
336             }
337              
338             sub canonicalize_opts : method
339             {
340 24     24 0 43 my $me = shift;
341            
342 24 50       94 croak("Initializers are not supported") if $me->{initializer};
343 24 50       66 croak("Traits are not supported") if $me->{traits};
344 24 50       66 croak("The lazy_build option is not supported") if $me->{lazy_build};
345            
346 24         86 $me->canonicalize_1;
347 24         108 $me->canonicalize_is;
348 24         106 $me->canonicalize_isa;
349 24         86 $me->canonicalize_default;
350 24         68 $me->canonicalize_builder;
351 24         59 $me->canonicalize_trigger;
352             }
353              
354             sub accessor_kind : method
355             {
356 2     2 0 5 return 'small';
357             }
358              
359             sub inline_to_coderef : method
360             {
361 46     46 0 71 my $me = shift;
362 46         86 my ($method_type, $code) = @_;
363              
364 46         101 my $kind = $me->accessor_kind;
365 46         124 my $src = sprintf(q[sub { %s }], $code);
366             my $desc = defined($me->{slot})
367             ? sprintf('%s %s for %s', $kind, $method_type, $me->{slot})
368 46 50       194 : sprintf('%s %s', $kind, $method_type);
369             # warn "#### $desc\n$src\n";
370            
371             return Eval::TypeTiny::eval_closure(
372             source => $src,
373             environment => $me->{inline_environment},
374 46         250 description => $desc,
375             );
376             }
377              
378             sub clearer : method
379             {
380 4     4 0 12 my $me = shift;
381            
382 4         24 $me->inline_to_coderef(
383             clearer => $me->inline_clearer,
384             );
385             }
386              
387             sub inline_clearer : method
388             {
389 4     4 0 8 my $me = shift;
390            
391 4         13 sprintf(
392             q[ delete(%s) ],
393             $me->inline_access,
394             );
395             }
396              
397             sub inline_access : method
398             {
399 88     88 0 163 my $me = shift;
400            
401             sprintf(
402             q[ $Sub::Accessor::Small::FIELDS{$_[0]}{%d} ],
403             $me->{id},
404 88         447 );
405             }
406              
407             sub inline_access_w : method
408             {
409 26     26 0 71 my $me = shift;
410 26         48 my ($expr) = @_;
411            
412 26         57 sprintf(
413             q[ %s = %s ],
414             $me->inline_access,
415             $expr,
416             );
417             }
418              
419             sub predicate : method
420             {
421 4     4 0 12 my $me = shift;
422            
423 4         21 $me->inline_to_coderef(
424             predicate => $me->inline_predicate,
425             );
426             }
427              
428             sub inline_predicate : method
429             {
430 9     9 0 17 my $me = shift;
431            
432 9         20 sprintf(
433             q[ exists(%s) ],
434             $me->inline_access,
435             );
436             }
437              
438             sub handles : method
439             {
440 0     0 0 0 my $me = shift;
441 0         0 my ($method) = @_;
442            
443 0         0 $me->inline_to_coderef(
444             'delegated method' => $me->inline_handles,
445             );
446             }
447              
448             my $handler_uniq = 0;
449             sub inline_handles : method
450             {
451 0     0 0 0 my $me = shift;
452 0         0 my ($method) = @_;
453            
454 0         0 my $get = $me->inline_access;
455            
456 0         0 my $varname = sprintf('$handler_%d', ++$handler_uniq);
457 0         0 $me->{inline_environment}{$varname} = \($method);
458            
459 0         0 my $death = 'Scalar::Util::blessed($h) or Carp::croak("Expected blessed object to delegate to; got $h")';
460            
461 0 0       0 if (ref $method eq 'ARRAY')
462             {
463 0         0 return sprintf(
464             q[ %s; my $h = %s; %s; shift; my ($m, @a) = @%s; $h->$m(@a, @_) ],
465             $me->inline_default,
466             $get,
467             $death,
468             $varname,
469             );
470             }
471             else
472             {
473 0         0 return sprintf(
474             q[ %s; my $h = %s; %s; shift; $h->%s(@_) ],
475             $me->inline_default,
476             $get,
477             $death,
478             $varname,
479             );
480             }
481             }
482              
483             sub inline_get : method
484             {
485 29     29 0 81 my $me = shift;
486            
487 29         58 my $get = $me->inline_access;
488            
489 29 50       101 if ($me->{auto_deref})
490             {
491 0         0 $get = sprintf(
492             q[ do { my $x = %s; wantarray ? (ref($x) eq 'ARRAY' ? @$x : ref($x) eq 'HASH' ? %$x : $x ) : $x } ],
493             $get,
494             );
495             }
496            
497 29         226 return $get;
498             }
499              
500             sub inline_default : method
501             {
502 22     22 0 35 my $me = shift;
503            
504 22 100       54 if ($me->{lazy})
505             {
506 5         15 my $get = $me->inline_access;
507            
508 5 50       20 if ($me->{default})
    0          
509             {
510 5         22 $me->{inline_environment}{'$default'} = \($me->{default});
511            
512 5         20 return sprintf(
513             q[ %s unless %s; ],
514             $me->inline_access_w( q[$default->($_[0])] ),
515             $me->inline_predicate,
516             );
517             }
518             elsif (defined $me->{builder})
519             {
520             return sprintf(
521             q[ %s unless %s; ],
522 0         0 $me->inline_access_w( q($_[0]->) . $me->{builder} ),
523             $me->inline_predicate,
524             );
525             }
526             }
527            
528 17         109 return '';
529             }
530              
531             sub reader : method
532             {
533 17     17 0 29 my $me = shift;
534            
535 17         40 $me->inline_to_coderef(
536             reader => $me->inline_reader,
537             );
538             }
539              
540             sub inline_reader : method
541             {
542 22     22 0 55 my $me = shift;
543            
544 22         63 join('',
545             $me->inline_default,
546             $me->inline_get,
547             );
548             }
549              
550             sub writer : method
551             {
552 9     9 0 22 my $me = shift;
553            
554 9         37 $me->inline_to_coderef(
555             writer => $me->inline_writer,
556             );
557             }
558              
559             sub inline_writer : method
560             {
561 9     9 0 17 my $me = shift;
562            
563 9         24 my $get = $me->inline_access;
564 9         29 my $coerce = $me->inline_type_coercion('$_[1]');
565            
566 9 100       964 if ($coerce eq '$_[1]') # i.e. no coercion
567             {
568 5 50 33     34 if (!$me->{trigger} and !$me->{weak_ref})
569             {
570 5         19 return $me->inline_access_w(
571             $me->inline_type_assertion('$_[1]'),
572             );
573             }
574            
575 0         0 return sprintf(
576             '%s; %s; %s; %s; %s',
577             $me->inline_type_assertion('$_[1]'),
578             $me->inline_trigger('$_[1]', $get),
579             $me->inline_access_w('$_[1]'),
580             $me->inline_weaken,
581             $me->inline_get,
582             );
583             }
584            
585             sprintf(
586 4         16 'my $val = %s; %s; %s; %s; %s; $val',
587             $coerce,
588             $me->inline_type_assertion('$val'),
589             $me->inline_trigger('$val', $get),
590             $me->inline_access_w('$val'),
591             $me->inline_weaken,
592             );
593             }
594              
595             sub accessor : method
596             {
597 12     12 0 23 my $me = shift;
598            
599 12         43 $me->inline_to_coderef(
600             accessor => $me->inline_accessor,
601             );
602             }
603              
604             sub inline_accessor : method
605             {
606 12     12 0 22 my $me = shift;
607              
608 12         59 my $get = $me->inline_access;
609 12         54 my $coerce = $me->inline_type_coercion('$_[1]');
610            
611 12 100       1205 if ($coerce eq '$_[1]') # i.e. no coercion
612             {
613 8 50 66     59 if (!$me->{lazy} and !$me->{trigger} and !$me->{weak_ref})
      33        
614             {
615 7         41 return sprintf(
616             '(@_ > 1) ? (%s) : %s',
617             $me->inline_access_w( $me->inline_type_assertion('$_[1]') ),
618             $me->inline_get,
619             );
620             }
621            
622 1         6 return sprintf(
623             'if (@_ > 1) { %s; %s; %s; %s }; %s',
624             $me->inline_type_assertion('$_[1]'),
625             $me->inline_trigger('$_[1]', $get),
626             $me->inline_access_w('$_[1]'),
627             $me->inline_weaken,
628             $me->inline_reader,
629             );
630             }
631            
632             sprintf(
633 4         44 'if (@_ > 1) { my $val = %s; %s; %s; %s; %s }; %s',
634             $coerce,
635             $me->inline_type_assertion('$val'),
636             $me->inline_trigger('$val', $get),
637             $me->inline_access_w('$val'),
638             $me->inline_weaken,
639             $me->inline_reader,
640             );
641             }
642              
643             sub inline_type_coercion : method
644             {
645 21     21 0 38 my $me = shift;
646 21         58 my ($var) = @_;
647            
648 21 100       73 my $coercion = $me->{coerce} or return $var;
649            
650 8 50       24 unless (ref $coercion)
651             {
652 8         16 my $type = $me->{isa};
653            
654 8 50 33     58 if (blessed($type) and $type->can('coercion'))
    0 0        
655             {
656 8         103 $coercion = $type->coercion;
657             }
658             elsif (blessed($type) and $type->can('coerce'))
659             {
660 0     0   0 $coercion = sub { $type->coerce(@_) };
  0         0  
661             }
662             else
663             {
664 0         0 croak("Invalid coerce; type constraint cannot be probed for coercion");
665             }
666            
667 8 50       90 unless (ref $coercion)
668             {
669 0         0 carp("Invalid coerce; type constraint has no coercion");
670 0         0 return $var;
671             }
672             }
673            
674 8 50 33     44 if ( blessed($coercion)
      33        
      33        
675             and $coercion->can('can_be_inlined')
676             and $coercion->can_be_inlined
677             and $coercion->can('inline_coercion') )
678             {
679 8         1025 return $coercion->inline_coercion($var);
680             }
681            
682             # Otherwise need to close over $coerce
683 0         0 $me->{inline_environment}{'$coercion'} = \$coercion;
684            
685 0 0 0     0 if ( blessed($coercion)
686             and $coercion->can('coerce') )
687             {
688 0         0 return sprintf('$coercion->coerce(%s)', $var);
689             }
690            
691 0         0 return sprintf('$coercion->(%s)', $var);
692             }
693              
694             sub inline_type_assertion : method
695             {
696 21     21 0 38 my $me = shift;
697 21         42 my ($var) = @_;
698            
699 21 100       134 my $type = $me->{isa} or return $var;
700            
701 10 50 33     125 if ( blessed($type)
      33        
702             and $type->isa('Type::Tiny')
703             and $type->can_be_inlined )
704             {
705 10         403 my $ass = $type->inline_assert($var);
706 10 50       1277 if ($ass =~ /\Ado \{(.+)\};\z/sm)
707             {
708 10         116 return "do { $1 }"; # i.e. drop trailing ";"
709             }
710             # otherwise protect expression from trailing ";"
711 0         0 return "do { $ass }"
712             }
713            
714             # Otherwise need to close over $type
715 0         0 $me->{inline_environment}{'$type'} = \$type;
716            
717             # non-Type::Tiny but still supports inlining
718 0 0 0     0 if ( blessed($type)
      0        
719             and $type->can('can_be_inlined')
720             and $type->can_be_inlined )
721             {
722 0   0     0 my $inliner = $type->can('inline_check') || $type->can('_inline_check');
723 0 0       0 if ($inliner)
724             {
725 0         0 return sprintf('do { %s } ? %s : Carp::croak($type->get_message(%s))', $type->$inliner($var), $var, $var);
726             }
727             }
728            
729 0 0 0     0 if ( blessed($type)
      0        
730             and $type->can('check')
731             and $type->can('get_message') )
732             {
733 0         0 return sprintf('$type->check(%s) ? %s : Carp::croak($type->get_message(%s))', $var, $var, $var);
734             }
735            
736 0         0 return sprintf('$type->(%s) ? %s : Carp::croak("Value %s failed type constraint check")', $var, $var, $var);
737             }
738              
739             sub inline_weaken : method
740             {
741 9     9 0 41 my $me = shift;
742            
743 9 50       97 return '' unless $me->{weak_ref};
744            
745 0         0 sprintf(
746             q[ Scalar::Util::weaken(%s) if ref(%s) ],
747             $me->inline_access,
748             $me->inline_access,
749             );
750             }
751              
752             sub inline_trigger : method
753             {
754 9     9 0 34 my $me = shift;
755 9         25 my ($new, $old) = @_;
756            
757 9 100       35 my $trigger = $me->{trigger} or return '';
758            
759 8         23 $me->{inline_environment}{'$trigger'} = \$trigger;
760 8         52 return sprintf('$trigger->($_[0], %s, %s)', $new, $old);
761             }
762              
763             1;
764              
765             __END__
766              
767             =pod
768              
769             =encoding utf-8
770              
771             =for stopwords benchmarking
772              
773             =head1 NAME
774              
775             Sub::Accessor::Small - base class used by Lexical::Accessor
776              
777             =head1 DESCRIPTION
778              
779             Not documented yet.
780              
781             =head1 BUGS
782              
783             Please report any bugs to
784             L<http://rt.cpan.org/Dist/Display.html?Queue=Lexical-Accessor>.
785              
786             =head1 SUPPORT
787              
788             Using this module directly is currently unsupported.
789              
790             =head1 SEE ALSO
791              
792             L<Lexical::Accessor>.
793              
794             =head1 AUTHOR
795              
796             Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
797              
798             =head1 COPYRIGHT AND LICENCE
799              
800             This software is copyright (c) 2013-2014, 2017 by Toby Inkster.
801              
802             This is free software; you can redistribute it and/or modify it under
803             the same terms as the Perl 5 programming language system itself.
804              
805             =head1 DISCLAIMER OF WARRANTIES
806              
807             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
808             WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
809             MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
810