lib/Class/MOP/Method/Attribute.pm

   1
   2 package Class::MOP::Method::Attribute;
   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::Generated';
  15
  16 sub new {
  17     my $class   = shift;
  18     my %options = @_;
  19
  20     (exists $options{attribute})
  21         || confess "You must supply an attribute to construct with";
  22
  23     (blessed($options{attribute}) && $options{attribute}->isa('Class::MOP::Attribute'))
  24         || confess "You must supply an attribute which is a 'Class::MOP::Attribute' instance";
  25
  26     ($options{package_name} && $options{name})
  27         || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT";
  28
  29     my $self = $class->_new(\%options);
  30
  31     # we don't want this creating
  32     # a cycle in the code, if not
  33     # needed
  34     weaken($self->{'attribute'});
  35
  36     return $self;
  37 }
  38
  39 sub _new {
  40     my $class = shift;
  41     my $options = @_ == 1 ? $_[0] : {@_};
  42
  43     $options->{is_inline} ||= 0;
  44
  45     return bless $options, $class;
  46 }
  47
  48 ## accessors
  49
  50 sub associated_attribute { (shift)->{'attribute'}     }
  51 sub accessor_type        { (shift)->{'accessor_type'} }
  52
  53 ## factory
  54
  55 sub initialize_body {
  56     Carp::cluck('The initialize_body method has been made private.'
  57         . " The public version is deprecated and will be removed in a future release.\n");
  58     shift->_initialize_body;
  59 }
  60
  61 1;
  62
  63 # XXX - UPDATE DOCS
  64 __END__
  65
  66 =pod
  67
  68 =head1 NAME
  69
  70 Class::MOP::Method::Attribute - Method Meta Object for accessors
  71
  72 =head1 SYNOPSIS
  73
  74     use Class::MOP::Method::Accessor;
  75
  76     my $reader = Class::MOP::Method::Accessor->new(
  77         attribute     => $attribute,
  78         is_inline     => 1,
  79         accessor_type => 'reader',
  80     );
  81
  82     $reader->body->execute($instance); # call the reader method
  83
  84 =head1 DESCRIPTION
  85
  86 This is a subclass of <Class::MOP::Method> which is used by
  87 C<Class::MOP::Attribute> to generate accessor code. It handles
  88 generation of readers, writers, predicates and clearers. For each type
  89 of method, it can either create a subroutine reference, or actually
  90 inline code by generating a string and C<eval>'ing it.
  91
  92 =head1 METHODS
  93
  94 =over 4
  95
  96 =item B<< Class::MOP::Method::Accessor->new(%options) >>
  97
  98 This returns a new C<Class::MOP::Method::Accessor> based on the
  99 C<%options> provided.
 100
 101 =over 4
 102
 103 =item * attribute
 104
 105 This is the C<Class::MOP::Attribute> for which accessors are being
 106 generated. This option is required.
 107
 108 =item * accessor_type
 109
 110 This is a string which should be one of "reader", "writer",
 111 "accessor", "predicate", or "clearer". This is the type of method
 112 being generated. This option is required.
 113
 114 =item * is_inline
 115
 116 This indicates whether or not the accessor should be inlined. This
 117 defaults to false.
 118
 119 =item * name
 120
 121 The method name (without a package name). This is required.
 122
 123 =item * package_name
 124
 125 The package name for the method. This is required.
 126
 127 =back
 128
 129 =item B<< $metamethod->accessor_type >>
 130
 131 Returns the accessor type which was passed to C<new>.
 132
 133 =item B<< $metamethod->is_inline >>
 134
 135 Returns a boolean indicating whether or not the accessor is inlined.
 136
 137 =item B<< $metamethod->associated_attribute >>
 138
 139 This returns the L<Class::MOP::Attribute> object which was passed to
 140 C<new>.
 141
 142 =item B<< $metamethod->body >>
 143
 144 The method itself is I<generated> when the accessor object is
 145 constructed.
 146
 147 =back
 148
 149 =head1 AUTHORS
 150
 151 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 152
 153 =head1 COPYRIGHT AND LICENSE
 154
 155 Copyright 2006-2009 by Infinity Interactive, Inc.
 156
 157 L<http://www.iinteractive.com>
 158
 159 This library is free software; you can redistribute it and/or modify
 160 it under the same terms as Perl itself.
 161
 162 =cut
 163