Commit | Line | Data |
5df54980 |
1 | package Moose::Meta::Method::Accessor::Native::Writer; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | our $VERSION = '1.13'; |
7 | $VERSION = eval $VERSION; |
8 | our $AUTHORITY = 'cpan:STEVAN'; |
9 | |
10 | use base 'Moose::Meta::Method::Accessor::Native'; |
11 | |
12 | sub _generate_method { |
13 | my $self = shift; |
14 | |
15 | my $inv = '$self'; |
16 | |
17 | my $slot_access = $self->_inline_get($inv); |
18 | |
19 | my $code = 'sub {'; |
20 | $code .= "\n" . $self->_inline_pre_body(@_); |
21 | |
22 | $code .= "\n" . 'my $self = shift;'; |
23 | |
24 | $code .= "\n" . $self->_inline_check_lazy($inv); |
25 | |
26 | $code .= "\n" . $self->_inline_curried_arguments; |
27 | |
28 | $code .= "\n" . $self->_inline_check_argument_count; |
29 | |
30 | $code .= "\n" . $self->_inline_process_arguments; |
31 | |
32 | $code .= "\n" . $self->_inline_check_arguments; |
33 | |
34 | my $new_value = $self->_new_value($slot_access); |
35 | my $potential_value = $self->_potential_value($slot_access); |
36 | |
37 | $code .= "\n" . $self->_inline_copy_value( \$potential_value ); |
38 | |
39 | $code .= "\n" |
40 | . $self->_inline_tc_code( |
41 | $new_value, |
42 | $potential_value |
43 | ); |
44 | |
45 | $code .= "\n" . $self->_inline_get_old_value_for_trigger($inv); |
46 | $code .= "\n" . $self->_capture_old_value($slot_access); |
47 | |
48 | $code .= "\n" |
49 | . $self->_inline_set_new_value( |
50 | $inv, |
51 | $potential_value |
52 | ); |
53 | |
54 | $code .= "\n" . $self->_inline_post_body(@_); |
55 | $code .= "\n" . $self->_inline_trigger( $inv, $slot_access, '@old' ); |
56 | |
57 | $code .= "\n" . $self->_return_value( $inv, '@old' ); |
58 | |
59 | $code .= "\n}"; |
60 | |
61 | return $code; |
62 | } |
63 | |
64 | sub _inline_process_arguments {q{}} |
65 | |
66 | sub _inline_check_arguments {q{}} |
67 | |
68 | sub _value_needs_copy {0} |
69 | |
70 | sub _inline_tc_code {die} |
71 | |
72 | sub _inline_check_coercion {die} |
73 | |
74 | sub _inline_check_constraint { |
75 | my $self = shift; |
76 | |
77 | return q{} unless $self->_constraint_must_be_checked; |
78 | |
79 | return $self->SUPER::_inline_check_constraint( $_[0] ); |
80 | } |
81 | |
82 | sub _constraint_must_be_checked {die} |
83 | |
84 | sub _capture_old_value { return q{} } |
85 | |
86 | sub _inline_set_new_value { |
87 | my $self = shift; |
88 | |
89 | return $self->SUPER::_inline_store(@_); |
90 | } |
91 | |
92 | sub _return_value { return q{} } |
93 | |
94 | 1; |