s/simply/simple/
[gitmo/Moose.git] / lib / Moose / Meta / Method / Accessor / Native.pm
1 package Moose::Meta::Method::Accessor::Native;
2
3 use strict;
4 use warnings;
5
6 use Carp qw( confess );
7 use Scalar::Util qw( blessed weaken );
8
9 our $VERSION = '1.16';
10 $VERSION = eval $VERSION;
11 our $AUTHORITY = 'cpan:STEVAN';
12
13 use Moose::Role;
14
15 around new => sub {
16     my $orig = shift;
17     my $class   = shift;
18     my %options = @_;
19
20     exists $options{curried_arguments}
21         || ( $options{curried_arguments} = [] );
22
23     ( $options{curried_arguments}
24             && ( 'ARRAY' eq ref $options{curried_arguments} ) )
25         || confess
26         'You must supply a curried_arguments which is an ARRAY reference';
27
28     $options{definition_context} = $options{attribute}->definition_context;
29
30     $options{accessor_type} = 'native';
31
32     return $class->$orig(%options);
33 };
34
35 around _new => sub {
36     shift;
37     my $class = shift;
38     my $options = @_ == 1 ? $_[0] : {@_};
39
40     return bless $options, $class;
41 };
42
43 sub root_types { (shift)->{'root_types'} }
44
45 sub _initialize_body {
46     my $self = shift;
47
48     $self->{'body'} = $self->_eval_code( $self->_generate_method );
49
50     return;
51 }
52
53 sub _inline_curried_arguments {
54     my $self = shift;
55
56     return q{} unless @{ $self->curried_arguments };
57
58     return 'unshift @_, @curried;'
59 }
60
61 sub _inline_check_argument_count {
62     my $self = shift;
63
64     my $code = q{};
65
66     if ( my $min = $self->_minimum_arguments ) {
67         my $err_msg = sprintf(
68             q{"Cannot call %s without at least %s argument%s"},
69             $self->delegate_to_method,
70             $min,
71             ( $min == 1 ? q{} : 's' )
72         );
73
74         $code
75             .= "\n"
76             . $self->_inline_throw_error($err_msg)
77             . " unless \@_ >= $min;";
78     }
79
80     if ( defined( my $max = $self->_maximum_arguments ) ) {
81         my $err_msg = sprintf(
82             q{"Cannot call %s with %s argument%s"},
83             $self->delegate_to_method,
84             ( $max ? "more than $max" : 'any' ),
85             ( $max == 1 ? q{} : 's' )
86         );
87
88         $code
89             .= "\n"
90             . $self->_inline_throw_error($err_msg)
91             . " if \@_ > $max;";
92     }
93
94     return $code;
95 }
96
97 sub _minimum_arguments { 0 }
98 sub _maximum_arguments { undef }
99
100 override _inline_get => sub {
101     my ( $self, $instance ) = @_;
102
103     return $self->_slot_access_can_be_inlined
104         ? super()
105         : "${instance}->\$reader";
106 };
107
108 override _inline_store => sub {
109     my ( $self, $instance, $value ) = @_;
110
111     return $self->_slot_access_can_be_inlined
112         ? super()
113         : "${instance}->\$writer($value)";
114 };
115
116 override _eval_environment => sub {
117     my $self = shift;
118
119     my $env = super();
120
121     $env->{'@curried'} = $self->curried_arguments;
122
123     return $env if $self->_slot_access_can_be_inlined;
124
125     my $reader = $self->associated_attribute->get_read_method_ref;
126     $reader = $reader->body if blessed $reader;
127
128     $env->{'$reader'} = \$reader;
129
130     my $writer = $self->associated_attribute->get_write_method_ref;
131     $writer = $writer->body if blessed $writer;
132
133     $env->{'$writer'} = \$writer;
134
135     return $env;
136 };
137
138 sub _slot_access_can_be_inlined {
139     my $self = shift;
140
141     return $self->is_inline && $self->_instance_is_inlinable;
142 }
143
144 no Moose::Role;
145
146 1;