Commit | Line | Data |
e7724627 |
1 | package Moose::Meta::Method::Accessor::Native::String::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 qw( |
11 | Moose::Meta::Method::Accessor::Native::String |
12 | Moose::Meta::Method::Accessor::Native::Writer |
13 | ); |
14 | |
15 | sub _new_value {'$_[0]'} |
16 | |
17 | sub _inline_copy_value { |
18 | my ( $self, $potential_ref ) = @_; |
19 | |
20 | return q{} unless $self->_value_needs_copy; |
21 | |
22 | my $code = "my \$potential = ${$potential_ref};"; |
23 | |
24 | ${$potential_ref} = '$potential'; |
25 | |
26 | return $code; |
27 | } |
28 | |
29 | sub _value_needs_copy { |
30 | my $self = shift; |
31 | |
32 | return $self->_constraint_must_be_checked; |
33 | } |
34 | |
35 | sub _inline_tc_code { |
36 | my ( $self, $new_value, $potential_value ) = @_; |
37 | |
38 | return q{} unless $self->_constraint_must_be_checked; |
39 | |
40 | return $self->_inline_check_coercion($potential_value) . "\n" |
41 | . $self->_inline_check_constraint($potential_value); |
42 | } |
43 | |
44 | sub _constraint_must_be_checked { |
45 | my $self = shift; |
46 | |
47 | my $attr = $self->associated_attribute; |
48 | |
49 | return $attr->has_type_constraint |
50 | && ( $attr->type_constraint->name ne 'Str' |
51 | || ( $attr->should_coerce && $attr->type_constraint->has_coercion ) ); |
52 | } |
53 | |
54 | sub _inline_check_coercion { |
55 | my ( $self, $value ) = @_; |
56 | |
57 | my $attr = $self->associated_attribute; |
58 | |
59 | return '' |
60 | unless $attr->should_coerce && $attr->type_constraint->has_coercion; |
61 | |
62 | # We want to break the aliasing in @_ in case the coercion tries to make a |
63 | # destructive change to an array member. |
64 | return '@_ = @{ $attr->type_constraint->coerce($value) };'; |
65 | } |
66 | |
67 | 1; |