lib/Moose/Meta/Method/Accessor.pm

   1
   2 package Moose::Meta::Method::Accessor;
   3
   4 use strict;
   5 use warnings;
   6
   7 use Try::Tiny;
   8
   9 our $VERSION   = '1.19';
  10 $VERSION = eval $VERSION;
  11 our $AUTHORITY = 'cpan:STEVAN';
  12
  13 use base 'Moose::Meta::Method',
  14          'Class::MOP::Method::Accessor';
  15
  16 sub _error_thrower {
  17     my $self = shift;
  18     return $self->associated_attribute
  19         if ref($self) && defined($self->associated_attribute);
  20     return $self->SUPER::_error_thrower;
  21 }
  22
  23 sub _compile_code {
  24     my $self = shift;
  25     my @args = @_;
  26     try {
  27         $self->SUPER::_compile_code(@args);
  28     }
  29     catch {
  30         $self->throw_error(
  31             'Could not create writer for '
  32           . "'" . $self->associated_attribute->name . "' "
  33           . 'because ' . $_,
  34             error => $_,
  35         );
  36     };
  37 }
  38
  39 sub _eval_environment {
  40     my $self = shift;
  41
  42     my $attr                = $self->associated_attribute;
  43     my $type_constraint_obj = $attr->type_constraint;
  44
  45     return {
  46         '$attr'                => \$attr,
  47         '$meta'                => \$self,
  48         '$type_constraint_obj' => \$type_constraint_obj,
  49         '$type_constraint'     => \(
  50               $type_constraint_obj
  51                   ? $type_constraint_obj->_compiled_type_constraint
  52                   : undef
  53         ),
  54     };
  55 }
  56
  57 sub _instance_is_inlinable {
  58     my $self = shift;
  59     return $self->associated_attribute->associated_class->instance_metaclass->is_inlinable;
  60 }
  61
  62 sub _generate_reader_method {
  63     my $self = shift;
  64     $self->_instance_is_inlinable ? $self->_generate_reader_method_inline(@_)
  65                                   : $self->SUPER::_generate_reader_method(@_);
  66 }
  67
  68 sub _generate_writer_method {
  69     my $self = shift;
  70     $self->_instance_is_inlinable ? $self->_generate_writer_method_inline(@_)
  71                                   : $self->SUPER::_generate_writer_method(@_);
  72 }
  73
  74 sub _generate_accessor_method {
  75     my $self = shift;
  76     $self->_instance_is_inlinable ? $self->_generate_accessor_method_inline(@_)
  77                                   : $self->SUPER::_generate_accessor_method(@_);
  78 }
  79
  80 sub _generate_predicate_method {
  81     my $self = shift;
  82     $self->_instance_is_inlinable ? $self->_generate_predicate_method_inline(@_)
  83                                   : $self->SUPER::_generate_predicate_method(@_);
  84 }
  85
  86 sub _generate_clearer_method {
  87     my $self = shift;
  88     $self->_instance_is_inlinable ? $self->_generate_clearer_method_inline(@_)
  89                                   : $self->SUPER::_generate_clearer_method(@_);
  90 }
  91
  92 sub _writer_value_needs_copy {
  93     shift->associated_attribute->_writer_value_needs_copy(@_);
  94 }
  95
  96 sub _inline_tc_code {
  97     shift->associated_attribute->_inline_tc_code(@_);
  98 }
  99
 100 sub _inline_check_constraint {
 101     shift->associated_attribute->_inline_check_constraint(@_);
 102 }
 103
 104 sub _inline_check_lazy {
 105     shift->associated_attribute->_inline_check_lazy(@_);
 106 }
 107
 108 sub _inline_store_value {
 109     shift->associated_attribute->_inline_instance_set(@_) . ';';
 110 }
 111
 112 sub _inline_get_old_value_for_trigger {
 113     shift->associated_attribute->_inline_get_old_value_for_trigger(@_);
 114 }
 115
 116 sub _inline_trigger {
 117     shift->associated_attribute->_inline_trigger(@_);
 118 }
 119
 120 sub _get_value {
 121     shift->associated_attribute->_inline_instance_get(@_);
 122 }
 123
 124 sub _has_value {
 125     shift->associated_attribute->_inline_instance_has(@_);
 126 }
 127
 128 1;
 129
 130 __END__
 131
 132 =pod
 133
 134 =head1 NAME
 135
 136 Moose::Meta::Method::Accessor - A Moose Method metaclass for accessors
 137
 138 =head1 DESCRIPTION
 139
 140 This class is a subclass of L<Class::MOP::Method::Accessor> that
 141 provides additional Moose-specific functionality, all of which is
 142 private.
 143
 144 To understand this class, you should read the the
 145 L<Class::MOP::Method::Accessor> documentation.
 146
 147 =head1 BUGS
 148
 149 See L<Moose/BUGS> for details on reporting bugs.
 150
 151 =head1 AUTHOR
 152
 153 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 154
 155 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
 156
 157 =head1 COPYRIGHT AND LICENSE
 158
 159 Copyright 2006-2010 by Infinity Interactive, Inc.
 160
 161 L<http://www.iinteractive.com>
 162
 163 This library is free software; you can redistribute it and/or modify
 164 it under the same terms as Perl itself.
 165
 166 =cut