Commit | Line | Data |
ca5a9ec1 |
1 | package Mouse::Meta::Method::Accessor; |
2 | use strict; |
3 | use warnings; |
4 | use Carp (); |
5 | |
6 | # internal use only. do not call directly |
7 | sub generate_accessor_method_inline { |
8 | my ($class, $attribute) = @_; |
9 | |
10 | my $name = $attribute->name; |
11 | my $default = $attribute->default; |
12 | my $constraint = $attribute->type_constraint; |
13 | my $builder = $attribute->builder; |
14 | my $trigger = $attribute->trigger; |
15 | my $is_weak = $attribute->is_weak_ref; |
16 | my $should_deref = $attribute->should_auto_deref; |
17 | my $should_coerce = $attribute->should_coerce; |
18 | |
19 | my $compiled_type_constraint = $constraint ? $constraint->{_compiled_type_constraint} : undef; |
20 | |
21 | my $self = '$_[0]'; |
22 | my $key = $attribute->inlined_name; |
23 | |
24 | my $accessor = |
25 | '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" . |
26 | "sub {\n"; |
27 | if ($attribute->_is_metadata eq 'rw') { |
28 | $accessor .= |
29 | '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" . |
30 | 'if (@_ >= 2) {' . "\n"; |
31 | |
32 | my $value = '$_[1]'; |
33 | |
34 | if ($constraint) { |
35 | $accessor .= 'my $val = '; |
36 | if ($should_coerce) { |
37 | $accessor .= |
38 | "\n". |
39 | '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" . |
40 | 'Mouse::Util::TypeConstraints->typecast_constraints("'.$attribute->associated_class->name.'", $attribute->{type_constraint}, '.$value.');'; |
41 | } else { |
42 | $accessor .= $value.';'; |
43 | } |
44 | if ($compiled_type_constraint) { |
45 | $accessor .= |
46 | "\n". |
47 | '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" . |
48 | 'unless ($compiled_type_constraint->($val)) { |
49 | $attribute->verify_type_constraint_error($name, $val, $attribute->{type_constraint}); |
50 | }' . "\n"; |
51 | } else { |
52 | $accessor .= |
53 | "\n". |
54 | '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" . |
55 | 'unless ($constraint->check($val)) { |
56 | $attribute->verify_type_constraint_error($name, $val, $attribute->{type_constraint}); |
57 | }' . "\n"; |
58 | } |
59 | $value = '$val'; |
60 | } |
61 | |
62 | # if there's nothing left to do for the attribute we can return during |
63 | # this setter |
64 | $accessor .= 'return ' if !$is_weak && !$trigger && !$should_deref; |
65 | |
66 | $accessor .= $self.'->{'.$key.'} = '.$value.';' . "\n"; |
67 | |
68 | if ($is_weak) { |
69 | $accessor .= 'Scalar::Util::weaken('.$self.'->{'.$key.'}) if ref('.$self.'->{'.$key.'});' . "\n"; |
70 | } |
71 | |
72 | if ($trigger) { |
73 | $accessor .= '$trigger->('.$self.', '.$value.');' . "\n"; |
74 | } |
75 | |
76 | $accessor .= "}\n"; |
77 | } |
78 | else { |
79 | $accessor .= 'Carp::confess("Cannot assign a value to a read-only accessor") if scalar(@_) >= 2;' . "\n"; |
80 | } |
81 | |
82 | if ($attribute->is_lazy) { |
83 | $accessor .= $self.'->{'.$key.'} = '; |
84 | |
85 | $accessor .= $attribute->has_builder |
86 | ? $self.'->$builder' |
87 | : ref($default) eq 'CODE' |
88 | ? '$default->('.$self.')' |
89 | : '$default'; |
90 | $accessor .= ' if !exists '.$self.'->{'.$key.'};' . "\n"; |
91 | } |
92 | |
93 | if ($should_deref) { |
1ae8a0d7 |
94 | if (ref($constraint) && $constraint->name eq 'ArrayRef') { |
ca5a9ec1 |
95 | $accessor .= 'if (wantarray) { |
96 | return @{ '.$self.'->{'.$key.'} || [] }; |
97 | }'; |
98 | } |
99 | else { |
100 | $accessor .= 'if (wantarray) { |
101 | return %{ '.$self.'->{'.$key.'} || {} }; |
102 | }'; |
103 | } |
104 | } |
105 | |
106 | $accessor .= 'return '.$self.'->{'.$key.'}; |
107 | }'; |
108 | |
109 | my $sub = eval $accessor; |
110 | Carp::confess($@) if $@; |
111 | return $sub; |
112 | } |
113 | |
114 | 1; |