lib/Mouse/Meta/Method/Accessor.pm

   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) {
  94         my $type_constraint = $attribute->{type_constraint};
  95         if (ref($type_constraint) && $type_constraint->name eq 'ArrayRef') {
  96             $accessor .= 'if (wantarray) {
  97                 return @{ '.$self.'->{'.$key.'} || [] };
  98             }';
  99         }
 100         else {
 101             $accessor .= 'if (wantarray) {
 102                 return %{ '.$self.'->{'.$key.'} || {} };
 103             }';
 104         }
 105     }
 106
 107     $accessor .= 'return '.$self.'->{'.$key.'};
 108     }';
 109
 110     my $sub = eval $accessor;
 111     Carp::confess($@) if $@;
 112     return $sub;
 113 }
 114
 115 1;