lib/Class/MOP/Method/Reader.pm

   1
   2 package Class::MOP::Method::Reader;
   3
   4 use strict;
   5 use warnings;
   6
   7 use Carp         'confess';
   8 use Scalar::Util 'blessed', 'weaken';
   9
  10 our $VERSION   = '0.88';
  11 $VERSION = eval $VERSION;
  12 our $AUTHORITY = 'cpan:STEVAN';
  13
  14 use base 'Class::MOP::Method::Attribute';
  15
  16 sub associated_attribute { (shift)->{'attribute'}     }
  17
  18 ## factory
  19
  20 sub _initialize_body {
  21     my $self = shift;
  22
  23     my $method_name = join "_" => (
  24         '_generate',
  25         'method',
  26         ($self->is_inline ? 'inline' : ())
  27     );
  28
  29     $self->{'body'} = $self->$method_name();
  30 }
  31
  32 ## generators
  33
  34 sub generate_method {
  35     Carp::cluck('The generate_reader_method method has been made private.'
  36         . " The public version is deprecated and will be removed in a future release.\n");
  37     shift->_generate_method;
  38 }
  39
  40 sub _generate_method {
  41     my $attr = (shift)->associated_attribute;
  42     return sub {
  43         confess "Cannot assign a value to a read-only accessor" if @_ > 1;
  44         $attr->get_value($_[0]);
  45     };
  46 }
  47
  48 ## Inline methods
  49
  50 sub generate_method_inline {
  51     Carp::cluck('The generate_reader_method_inline method has been made private.'
  52         . " The public version is deprecated and will be removed in a future release.\n");
  53     shift->_generate_method_inline;
  54 }
  55
  56 sub _generate_method_inline {
  57     my $self          = shift;
  58     my $attr          = $self->associated_attribute;
  59     my $attr_name     = $attr->name;
  60     my $meta_instance = $attr->associated_class->instance_metaclass;
  61
  62      my ( $code, $e ) = $self->_eval_closure(
  63          {},
  64         'sub {'
  65         . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;'
  66         . $meta_instance->inline_get_slot_value('$_[0]', $attr_name)
  67         . '}'
  68     );
  69     confess "Could not generate inline reader because : $e" if $e;
  70
  71     return $code;
  72 }
  73
  74 1;
  75
  76 # XXX - UPDATE DOCS
  77 __END__
  78
  79
  80 =pod
  81
  82 =head1 NAME
  83
  84 Class::MOP::Method::Reader - Method Meta Object for accessors
  85
  86 =head1 SYNOPSIS
  87
  88     use Class::MOP::Method::Reader;
  89
  90     my $reader = Class::MOP::Method::Reader->new(
  91         attribute     => $attribute,
  92         is_inline     => 1,
  93     );
  94
  95     $reader->body->execute($instance); # call the reader method
  96
  97 =head1 DESCRIPTION
  98
  99 This is a subclass of <Class::MOP::Method> which is used by
 100 C<Class::MOP::Attribute> to generate accessor code. It handles
 101 generation of readers, writers, predicates and clearers. For each type
 102 of method, it can either create a subroutine reference, or actually
 103 inline code by generating a string and C<eval>'ing it.
 104
 105 =head1 METHODS
 106
 107 =over 4
 108
 109 =item B<< Class::MOP::Method::Accessor->new(%options) >>
 110
 111 This returns a new C<Class::MOP::Method::Accessor> based on the
 112 C<%options> provided.
 113
 114 =over 4
 115
 116 =item * attribute
 117
 118 This is the C<Class::MOP::Attribute> for which accessors are being
 119 generated. This option is required.
 120
 121 =item * accessor_type
 122
 123 This is a string which should be one of "reader", "writer",
 124 "accessor", "predicate", or "clearer". This is the type of method
 125 being generated. This option is required.
 126
 127 =item * is_inline
 128
 129 This indicates whether or not the accessor should be inlined. This
 130 defaults to false.
 131
 132 =item * name
 133
 134 The method name (without a package name). This is required.
 135
 136 =item * package_name
 137
 138 The package name for the method. This is required.
 139
 140 =back
 141
 142 =item B<< $metamethod->accessor_type >>
 143
 144 Returns the accessor type which was passed to C<new>.
 145
 146 =item B<< $metamethod->is_inline >>
 147
 148 Returns a boolean indicating whether or not the accessor is inlined.
 149
 150 =item B<< $metamethod->associated_attribute >>
 151
 152 This returns the L<Class::MOP::Attribute> object which was passed to
 153 C<new>.
 154
 155 =item B<< $metamethod->body >>
 156
 157 The method itself is I<generated> when the accessor object is
 158 constructed.
 159
 160 =back
 161
 162 =head1 AUTHORS
 163
 164 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 165
 166 =head1 COPYRIGHT AND LICENSE
 167
 168 Copyright 2006-2009 by Infinity Interactive, Inc.
 169
 170 L<http://www.iinteractive.com>
 171
 172 This library is free software; you can redistribute it and/or modify
 173 it under the same terms as Perl itself.
 174
 175 =cut
 176