lib/Class/MOP/Attribute.pm

   1
   2 package Class::MOP::Attribute;
   3
   4 use strict;
   5 use warnings;
   6
   7 use Class::MOP::Method::Accessor;
   8
   9 use Carp         'confess';
  10 use Scalar::Util 'blessed', 'weaken';
  11
  12 our $VERSION   = '0.78';
  13 $VERSION = eval $VERSION;
  14 our $AUTHORITY = 'cpan:STEVAN';
  15
  16 use base 'Class::MOP::Object';
  17
  18 # NOTE: (meta-circularity)
  19 # This method will be replaced in the
  20 # boostrap section of Class::MOP, by
  21 # a new version which uses the
  22 # &Class::MOP::Class::construct_instance
  23 # method to build an attribute meta-object
  24 # which itself is described with attribute
  25 # meta-objects.
  26 #     - Ain't meta-circularity grand? :)
  27 sub new {
  28     my ( $class, @args ) = @_;
  29
  30     unshift @args, "name" if @args % 2 == 1;
  31     my %options = @args;
  32
  33     my $name = $options{name};
  34
  35     (defined $name && $name)
  36         || confess "You must provide a name for the attribute";
  37
  38     $options{init_arg} = $name
  39         if not exists $options{init_arg};
  40     if(exists $options{builder}){
  41         confess("builder must be a defined scalar value which is a method name")
  42             if ref $options{builder} || !(defined $options{builder});
  43         confess("Setting both default and builder is not allowed.")
  44             if exists $options{default};
  45     } else {
  46         (is_default_a_coderef(\%options))
  47             || confess("References are not allowed as default values, you must ".
  48                        "wrap the default of '$name' in a CODE reference (ex: sub { [] } and not [])")
  49                 if exists $options{default} && ref $options{default};
  50     }
  51     if( $options{required} and not( defined($options{builder}) || defined($options{init_arg}) || exists $options{default} ) ) {
  52         confess("A required attribute must have either 'init_arg', 'builder', or 'default'");
  53     }
  54
  55     $class->_new(\%options);
  56 }
  57
  58 sub _new {
  59     my $class = shift;
  60     my $options = @_ == 1 ? $_[0] : {@_};
  61
  62     bless {
  63         'name'               => $options->{name},
  64         'accessor'           => $options->{accessor},
  65         'reader'             => $options->{reader},
  66         'writer'             => $options->{writer},
  67         'predicate'          => $options->{predicate},
  68         'clearer'            => $options->{clearer},
  69         'builder'            => $options->{builder},
  70         'init_arg'           => $options->{init_arg},
  71         'default'            => $options->{default},
  72         'initializer'        => $options->{initializer},
  73         'definition_context' => $options->{definition_context},
  74         # keep a weakened link to the
  75         # class we are associated with
  76         'associated_class' => undef,
  77         # and a list of the methods
  78         # associated with this attr
  79         'associated_methods' => [],
  80     }, $class;
  81 }
  82
  83 # NOTE:
  84 # this is a primative (and kludgy) clone operation
  85 # for now, it will be replaced in the Class::MOP
  86 # bootstrap with a proper one, however we know
  87 # that this one will work fine for now.
  88 sub clone {
  89     my $self    = shift;
  90     my %options = @_;
  91     (blessed($self))
  92         || confess "Can only clone an instance";
  93     return bless { %{$self}, %options } => ref($self);
  94 }
  95
  96 sub initialize_instance_slot {
  97     my ($self, $meta_instance, $instance, $params) = @_;
  98     my $init_arg = $self->{'init_arg'};
  99
 100     # try to fetch the init arg from the %params ...
 101
 102     # if nothing was in the %params, we can use the
 103     # attribute's default value (if it has one)
 104     if(defined $init_arg and exists $params->{$init_arg}){
 105         $self->_set_initial_slot_value(
 106             $meta_instance,
 107             $instance,
 108             $params->{$init_arg},
 109         );
 110     }
 111     elsif (defined $self->{'default'}) {
 112         $self->_set_initial_slot_value(
 113             $meta_instance,
 114             $instance,
 115             $self->default($instance),
 116         );
 117     }
 118     elsif (defined( my $builder = $self->{'builder'})) {
 119         if ($builder = $instance->can($builder)) {
 120             $self->_set_initial_slot_value(
 121                 $meta_instance,
 122                 $instance,
 123                 $instance->$builder,
 124             );
 125         }
 126         else {
 127             confess(ref($instance)." does not support builder method '". $self->{'builder'} ."' for attribute '" . $self->name . "'");
 128         }
 129     }
 130 }
 131
 132 sub _set_initial_slot_value {
 133     my ($self, $meta_instance, $instance, $value) = @_;
 134
 135     my $slot_name = $self->name;
 136
 137     return $meta_instance->set_slot_value($instance, $slot_name, $value)
 138         unless $self->has_initializer;
 139
 140     my $callback = sub {
 141         $meta_instance->set_slot_value($instance, $slot_name, $_[0]);
 142     };
 143
 144     my $initializer = $self->initializer;
 145
 146     # most things will just want to set a value, so make it first arg
 147     $instance->$initializer($value, $callback, $self);
 148 }
 149
 150 # NOTE:
 151 # the next bunch of methods will get bootstrapped
 152 # away in the Class::MOP bootstrapping section
 153
 154 sub associated_class   { $_[0]->{'associated_class'}   }
 155 sub associated_methods { $_[0]->{'associated_methods'} }
 156
 157 sub has_accessor    { defined($_[0]->{'accessor'}) }
 158 sub has_reader      { defined($_[0]->{'reader'}) }
 159 sub has_writer      { defined($_[0]->{'writer'}) }
 160 sub has_predicate   { defined($_[0]->{'predicate'}) }
 161 sub has_clearer     { defined($_[0]->{'clearer'}) }
 162 sub has_builder     { defined($_[0]->{'builder'}) }
 163 sub has_init_arg    { defined($_[0]->{'init_arg'}) }
 164 sub has_default     { defined($_[0]->{'default'}) }
 165 sub has_initializer { defined($_[0]->{'initializer'}) }
 166
 167 sub accessor           { $_[0]->{'accessor'}    }
 168 sub reader             { $_[0]->{'reader'}      }
 169 sub writer             { $_[0]->{'writer'}      }
 170 sub predicate          { $_[0]->{'predicate'}   }
 171 sub clearer            { $_[0]->{'clearer'}     }
 172 sub builder            { $_[0]->{'builder'}     }
 173 sub init_arg           { $_[0]->{'init_arg'}    }
 174 sub initializer        { $_[0]->{'initializer'} }
 175 sub definition_context { $_[0]->{'definition_context'} }
 176
 177 # end bootstrapped away method section.
 178 # (all methods below here are kept intact)
 179
 180 sub has_read_method  { $_[0]->has_reader || $_[0]->has_accessor }
 181 sub has_write_method { $_[0]->has_writer || $_[0]->has_accessor }
 182
 183 sub get_read_method  {
 184     my $self   = shift;
 185     my $reader = $self->reader || $self->accessor;
 186     # normal case ...
 187     return $reader unless ref $reader;
 188     # the HASH ref case
 189     my ($name) = %$reader;
 190     return $name;
 191 }
 192
 193 sub get_write_method {
 194     my $self   = shift;
 195     my $writer = $self->writer || $self->accessor;
 196     # normal case ...
 197     return $writer unless ref $writer;
 198     # the HASH ref case
 199     my ($name) = %$writer;
 200     return $name;
 201 }
 202
 203 sub get_read_method_ref {
 204     my $self = shift;
 205     if ((my $reader = $self->get_read_method) && $self->associated_class) {
 206         return $self->associated_class->get_method($reader);
 207     }
 208     else {
 209         my $code = sub { $self->get_value(@_) };
 210         if (my $class = $self->associated_class) {
 211             return $class->method_metaclass->wrap(
 212                 $code,
 213                 package_name => $class->name,
 214                 name         => '__ANON__'
 215             );
 216         }
 217         else {
 218             return $code;
 219         }
 220     }
 221 }
 222
 223 sub get_write_method_ref {
 224     my $self = shift;
 225     if ((my $writer = $self->get_write_method) && $self->associated_class) {
 226         return $self->associated_class->get_method($writer);
 227     }
 228     else {
 229         my $code = sub { $self->set_value(@_) };
 230         if (my $class = $self->associated_class) {
 231             return $class->method_metaclass->wrap(
 232                 $code,
 233                 package_name => $class->name,
 234                 name         => '__ANON__'
 235             );
 236         }
 237         else {
 238             return $code;
 239         }
 240     }
 241 }
 242
 243 sub is_default_a_coderef {
 244     ('CODE' eq ref($_[0]->{'default'}))
 245 }
 246
 247 sub default {
 248     my ($self, $instance) = @_;
 249     if (defined $instance && $self->is_default_a_coderef) {
 250         # if the default is a CODE ref, then
 251         # we pass in the instance and default
 252         # can return a value based on that
 253         # instance. Somewhat crude, but works.
 254         return $self->{'default'}->($instance);
 255     }
 256     $self->{'default'};
 257 }
 258
 259 # slots
 260
 261 sub slots { (shift)->name }
 262
 263 # class association
 264
 265 sub attach_to_class {
 266     my ($self, $class) = @_;
 267     (blessed($class) && $class->isa('Class::MOP::Class'))
 268         || confess "You must pass a Class::MOP::Class instance (or a subclass)";
 269     weaken($self->{'associated_class'} = $class);
 270 }
 271
 272 sub detach_from_class {
 273     my $self = shift;
 274     $self->{'associated_class'} = undef;
 275 }
 276
 277 # method association
 278
 279 sub associate_method {
 280     my ($self, $method) = @_;
 281     push @{$self->{'associated_methods'}} => $method;
 282 }
 283
 284 ## Slot management
 285
 286 sub set_initial_value {
 287     my ($self, $instance, $value) = @_;
 288     $self->_set_initial_slot_value(
 289         Class::MOP::Class->initialize(ref($instance))->get_meta_instance,
 290         $instance,
 291         $value
 292     );
 293 }
 294
 295 sub set_value {
 296     my ($self, $instance, $value) = @_;
 297
 298     Class::MOP::Class->initialize(ref($instance))
 299                      ->get_meta_instance
 300                      ->set_slot_value($instance, $self->name, $value);
 301 }
 302
 303 sub get_value {
 304     my ($self, $instance) = @_;
 305
 306     Class::MOP::Class->initialize(ref($instance))
 307                      ->get_meta_instance
 308                      ->get_slot_value($instance, $self->name);
 309 }
 310
 311 sub has_value {
 312     my ($self, $instance) = @_;
 313
 314     Class::MOP::Class->initialize(ref($instance))
 315                      ->get_meta_instance
 316                      ->is_slot_initialized($instance, $self->name);
 317 }
 318
 319 sub clear_value {
 320     my ($self, $instance) = @_;
 321
 322     Class::MOP::Class->initialize(ref($instance))
 323                      ->get_meta_instance
 324                      ->deinitialize_slot($instance, $self->name);
 325 }
 326
 327 ## load em up ...
 328
 329 sub accessor_metaclass { 'Class::MOP::Method::Accessor' }
 330
 331 sub process_accessors {
 332     warn "The process_accessors method has been made private and this public alias will be removed in a future release.";
 333     goto &_process_accessors;
 334 }
 335
 336 sub _process_accessors {
 337     my ($self, $type, $accessor, $generate_as_inline_methods) = @_;
 338
 339     my $method_ctx;
 340
 341     if ( my $ctx = $self->definition_context ) {
 342         $method_ctx = { %$ctx };
 343     }
 344
 345     if (ref($accessor)) {
 346         (ref($accessor) eq 'HASH')
 347             || confess "bad accessor/reader/writer/predicate/clearer format, must be a HASH ref";
 348         my ($name, $method) = %{$accessor};
 349         $method = $self->accessor_metaclass->wrap(
 350             $method,
 351             package_name => $self->associated_class->name,
 352             name         => $name,
 353             definition_context => $method_ctx,
 354         );
 355         $self->associate_method($method);
 356         return ($name, $method);
 357     }
 358     else {
 359         my $inline_me = ($generate_as_inline_methods && $self->associated_class->instance_metaclass->is_inlinable);
 360         my $method;
 361         eval {
 362             if ( $method_ctx ) {
 363                 my $desc = "accessor $accessor";
 364                 if ( $accessor ne $self->name ) {
 365                     $desc .= " of attribute " . $self->name;
 366                 }
 367
 368                 $method_ctx->{description} = $desc;
 369             }
 370
 371             $method = $self->accessor_metaclass->new(
 372                 attribute     => $self,
 373                 is_inline     => $inline_me,
 374                 accessor_type => $type,
 375                 package_name  => $self->associated_class->name,
 376                 name          => $accessor,
 377                 definition_context => $method_ctx,
 378             );
 379         };
 380         confess "Could not create the '$type' method for " . $self->name . " because : $@" if $@;
 381         $self->associate_method($method);
 382         return ($accessor, $method);
 383     }
 384 }
 385
 386 sub install_accessors {
 387     my $self   = shift;
 388     my $inline = shift;
 389     my $class  = $self->associated_class;
 390
 391     $class->add_method(
 392         $self->_process_accessors('accessor' => $self->accessor(), $inline)
 393     ) if $self->has_accessor();
 394
 395     $class->add_method(
 396         $self->_process_accessors('reader' => $self->reader(), $inline)
 397     ) if $self->has_reader();
 398
 399     $class->add_method(
 400         $self->_process_accessors('writer' => $self->writer(), $inline)
 401     ) if $self->has_writer();
 402
 403     $class->add_method(
 404         $self->_process_accessors('predicate' => $self->predicate(), $inline)
 405     ) if $self->has_predicate();
 406
 407     $class->add_method(
 408         $self->_process_accessors('clearer' => $self->clearer(), $inline)
 409     ) if $self->has_clearer();
 410
 411     return;
 412 }
 413
 414 {
 415     my $_remove_accessor = sub {
 416         my ($accessor, $class) = @_;
 417         if (ref($accessor) && ref($accessor) eq 'HASH') {
 418             ($accessor) = keys %{$accessor};
 419         }
 420         my $method = $class->get_method($accessor);
 421         $class->remove_method($accessor)
 422             if (ref($method) && $method->isa('Class::MOP::Method::Accessor'));
 423     };
 424
 425     sub remove_accessors {
 426         my $self = shift;
 427         # TODO:
 428         # we really need to make sure to remove from the
 429         # associates methods here as well. But this is
 430         # such a slimly used method, I am not worried
 431         # about it right now.
 432         $_remove_accessor->($self->accessor(),  $self->associated_class()) if $self->has_accessor();
 433         $_remove_accessor->($self->reader(),    $self->associated_class()) if $self->has_reader();
 434         $_remove_accessor->($self->writer(),    $self->associated_class()) if $self->has_writer();
 435         $_remove_accessor->($self->predicate(), $self->associated_class()) if $self->has_predicate();
 436         $_remove_accessor->($self->clearer(),   $self->associated_class()) if $self->has_clearer();
 437         return;
 438     }
 439
 440 }
 441
 442 1;
 443
 444 __END__
 445
 446 =pod
 447
 448 =head1 NAME
 449
 450 Class::MOP::Attribute - Attribute Meta Object
 451
 452 =head1 SYNOPSIS
 453
 454   Class::MOP::Attribute->new(
 455       foo => (
 456           accessor  => 'foo',           # dual purpose get/set accessor
 457           predicate => 'has_foo',       # predicate check for defined-ness
 458           init_arg  => '-foo',          # class->new will look for a -foo key
 459           default   => 'BAR IS BAZ!'    # if no -foo key is provided, use this
 460       )
 461   );
 462
 463   Class::MOP::Attribute->new(
 464       bar => (
 465           reader    => 'bar',           # getter
 466           writer    => 'set_bar',       # setter
 467           predicate => 'has_bar',       # predicate check for defined-ness
 468           init_arg  => ':bar',          # class->new will look for a :bar key
 469                                         # no default value means it is undef
 470       )
 471   );
 472
 473 =head1 DESCRIPTION
 474
 475 The Attribute Protocol is almost entirely an invention of
 476 C<Class::MOP>. Perl 5 does not have a consistent notion of
 477 attributes. There are so many ways in which this is done, and very few
 478 (if any) are easily discoverable by this module.
 479
 480 With that said, this module attempts to inject some order into this
 481 chaos, by introducing a consistent API which can be used to create
 482 object attributes.
 483
 484 =head1 METHODS
 485
 486 =head2 Creation
 487
 488 =over 4
 489
 490 =item B<< Class::MOP::Attribute->new($name, ?%options) >>
 491
 492 An attribute must (at the very least), have a C<$name>. All other
 493 C<%options> are added as key-value pairs.
 494
 495 =over 8
 496
 497 =item I<init_arg>
 498
 499 This is a string value representing the expected key in an
 500 initialization hash. For instance, if we have an C<init_arg> value of
 501 C<-foo>, then the following code will Just Work.
 502
 503   MyClass->meta->construct_instance( -foo => 'Hello There' );
 504
 505 If an init_arg is not assigned, it will automatically use the
 506 attribute's name. If C<init_arg> is explicitly set to C<undef>, the
 507 attribute cannot be specified during initialization.
 508
 509 =item I<builder>
 510
 511 This provides the name of a method that will be called to initialize
 512 the attribute. This method will be called on the object after it is
 513 constructed. It is expected to return a valid value for the attribute.
 514
 515 =item I<default>
 516
 517 This can be used to provide an explicit default for initializing the
 518 attribute. If the default you provide is a subroutine reference, then
 519 this reference will be called I<as a method> on the object.
 520
 521 If the value is a simple scalar (string or number), then it can be
 522 just passed as is. However, if you wish to initialize it with a HASH
 523 or ARRAY ref, then you need to wrap that inside a subroutine
 524 reference:
 525
 526   Class::MOP::Attribute->new(
 527       'foo' => (
 528           default => sub { [] },
 529       )
 530   );
 531
 532   # or ...
 533
 534   Class::MOP::Attribute->new(
 535       'foo' => (
 536           default => sub { {} },
 537       )
 538   );
 539
 540 If you wish to initialize an attribute with a subroutine reference
 541 itself, then you need to wrap that in a subroutine as well:
 542
 543   Class::MOP::Attribute->new(
 544       'foo' => (
 545           default => sub {
 546               sub { print "Hello World" }
 547           },
 548       )
 549   );
 550
 551 And lastly, if the value of your attribute is dependent upon some
 552 other aspect of the instance structure, then you can take advantage of
 553 the fact that when the C<default> value is called as a method:
 554
 555   Class::MOP::Attribute->new(
 556       'object_identity' => (
 557           default => sub { Scalar::Util::refaddr( $_[0] ) },
 558       )
 559   );
 560
 561 Note that there is no guarantee that attributes are initialized in any
 562 particular order, so you cannot rely on the value of some other
 563 attribute when generating the default.
 564
 565 =item I<initializer>
 566
 567 This option can be either a method name or a subroutine
 568 reference. This method will be called when setting the attribute's
 569 value in the constructor. Unlike C<default> and C<builder>, the
 570 initializer is only called when a value is provided to the
 571 constructor. The initializer allows you to munge this value during
 572 object construction.
 573
 574 The initializer is called as a method with three arguments. The first
 575 is the value that was passed to the constructor. The second is a
 576 subroutine reference that can be called to actually set the
 577 attribute's value, and the last is the associated
 578 C<Class::MOP::Attribute> object.
 579
 580 This contrived example shows an initializer that sets the attribute to
 581 twice the given value.
 582
 583   Class::MOP::Attribute->new(
 584       'doubled' => (
 585           initializer => sub {
 586               my ( $instance, $value, $set ) = @_;
 587               $set->( $value * 2 );
 588           },
 589       )
 590   );
 591
 592 Since an initializer can be a method name, you can easily make
 593 attribute initialization use the writer:
 594
 595   Class::MOP::Attribute->new(
 596       'some_attr' => (
 597           writer      => 'some_attr',
 598           initializer => 'some_attr',
 599       )
 600   );
 601
 602 Your writer will need to examine C<@_> and determine under which
 603 context it is being called.
 604
 605 =back
 606
 607 The C<accessor>, C<reader>, C<writer>, C<predicate> and C<clearer>
 608 options all accept the same parameters. You can provide the name of
 609 the method, in which case an appropriate default method will be
 610 generated for you. Or instead you can also provide hash reference
 611 containing exactly one key (the method name) and one value. The value
 612 should be a subroutine reference, which will be installed as the
 613 method itself.
 614
 615 =over 4
 616
 617 =item I<accessor>
 618
 619 An C<accessor> is a standard Perl-style read/write accessor. It will
 620 return the value of the attribute, and if a value is passed as an
 621 argument, it will assign that value to the attribute.
 622
 623 Note that C<undef> is a legitimate value, so this will work:
 624
 625   $object->set_something(undef);
 626
 627 =item I<reader>
 628
 629 This is a basic read-only accessor. It returns the value of the
 630 attribute.
 631
 632 =item I<writer>
 633
 634 This is a basic write accessor, it accepts a single argument, and
 635 assigns that value to the attribute.
 636
 637 Note that C<undef> is a legitimate value, so this will work:
 638
 639   $object->set_something(undef);
 640
 641 =item I<predicate>
 642
 643 The predicate method returns a boolean indicating whether or not the
 644 attribute has been explicitly set.
 645
 646 Note that the predicate returns true even if the attribute was set to
 647 a false value (C<0> or C<undef>).
 648
 649 =item I<clearer>
 650
 651 This method will uninitialize the attribute. After an attribute is
 652 cleared, its C<predicate> will return false.
 653
 654 =item I<definition_context>
 655
 656 Mostly, this exists as a hook for the benefit of Moose.
 657
 658 This option should be a hash reference containing several keys which
 659 will be used when inlining the attribute's accessors. The keys should
 660 include C<line>, the line number where the attribute was created, and
 661 either C<file> or C<description>.
 662
 663 This information will ultimately be used when eval'ing inlined
 664 accessor code so that error messages report a useful line and file
 665 name.
 666
 667 =back
 668
 669 =item B<< $attr->clone(%options) >>
 670
 671 This clones the attribute. Any options you provide will override the
 672 settings of the original attribute. You can change the name of the new
 673 attribute by passing a C<name> key in C<%options>.
 674
 675 =back
 676
 677 =head2 Informational
 678
 679 These are all basic read-only accessors for the values passed into
 680 the constructor.
 681
 682 =over 4
 683
 684 =item B<< $attr->name >>
 685
 686 =item B<< $attr->accessor >>
 687
 688 =item B<< $attr->reader >>
 689
 690 =item B<< $attr->writer >>
 691
 692 =item B<< $attr->predicate >>
 693
 694 =item B<< $attr->clearer >>
 695
 696 The C<accessor>, C<reader>, C<writer>, C<predicate>, and C<clearer>
 697 methods all return exactly what was passed to the constructor, so it
 698 can be either a string containing a method name, or a hash reference.
 699
 700 =item B<< $attr->initializer >>
 701
 702 Returns the initializer as passed to the constructor, so this may be
 703 either a method name or a subroutine reference.
 704
 705 =item B<< $attr->init_arg >>
 706
 707 =item B<< $attr->is_default_a_coderef >>
 708
 709 =item B<< $attr->default($instance) >>
 710
 711 The C<$instance> argument is optional. If you don't pass it, the
 712 return value for this method is exactly what was passed to the
 713 constructor, either a simple scalar or a subroutine reference.
 714
 715 If you I<do> pass an C<$instance> and the default is a subroutine
 716 reference, then the reference is called as a method on the
 717 C<$instance> and the generated value is returned.
 718
 719 =item B<< $attr->slots >>
 720
 721 Return a list of slots required by the attribute. This is usually just
 722 one, the name of the attribute.
 723
 724 A slot is the name of the hash key used to store the attribute in an
 725 object instance.
 726
 727 =item B<< $attr->get_read_method >>
 728
 729 =item B<< $attr->get_write_method >>
 730
 731 Returns the name of a method suitable for reading or writing the value
 732 of the attribute in the associated class.
 733
 734 If an attribute is read- or write-only, then these methods can return
 735 C<undef> as appropriate.
 736
 737 =item B<< $attr->has_read_method >>
 738
 739 =item B<< $attr->has_write_method >>
 740
 741 This returns a boolean indicating whether the attribute has a I<named>
 742 read or write method.
 743
 744 =item B<< $attr->get_read_method_ref >>
 745
 746 =item B<< $attr->get_write_method_ref >>
 747
 748 Returns the subroutine reference of a method suitable for reading or
 749 writing the attribute's value in the associated class. These methods
 750 always return a subroutine reference, regardless of whether or not the
 751 attribute is read- or write-only.
 752
 753 =back
 754
 755 =head2 Informational predicates
 756
 757 These are all basic predicate methods for the values passed into C<new>.
 758
 759 =over 4
 760
 761 =item B<< $attr->has_accessor >>
 762
 763 =item B<< $attr->has_reader >>
 764
 765 =item B<< $attr->has_writer >>
 766
 767 =item B<< $attr->has_predicate >>
 768
 769 =item B<< $attr->has_clearer >>
 770
 771 =item B<< $attr->has_initializer >>
 772
 773 =item B<< $attr->has_init_arg >>
 774
 775 This will be I<false> if the C<init_arg> was set to C<undef>.
 776
 777 =item B<< $attr->has_default >>
 778
 779 This will be I<false> if the C<default> was set to C<undef>, since
 780 C<undef> is the default C<default> anyway.
 781
 782 =item B<< $attr->has_builder >>
 783
 784 =back
 785
 786 =head2 Value management
 787
 788 These methods are basically "back doors" to the instance, and can be
 789 used to bypass the regular accessors, but still stay within the MOP.
 790
 791 These methods are not for general use, and should only be used if you
 792 really know what you are doing.
 793
 794 =over 4
 795
 796 =item B<< $attr->initialize_instance_slot($meta_instance, $instance, $params) >>
 797
 798 This method is used internally to initialize the attribute's slot in
 799 the object C<$instance>.
 800
 801 The C<$params> is a hash reference of the values passed to the object
 802 constructor.
 803
 804 It's unlikely that you'll need to call this method yourself.
 805
 806 =item B<< $attr->set_value($instance, $value) >>
 807
 808 Sets the value without going through the accessor. Note that this
 809 works even with read-only attributes.
 810
 811 =item B<< $attr->set_initial_value($instance, $value) >>
 812
 813 Sets the value without going through the accessor. This method is only
 814 called when the instance is first being initialized.
 815
 816 =item B<< $attr->get_value($instance) >>
 817
 818 Returns the value without going through the accessor. Note that this
 819 works even with write-only accessors.
 820
 821 =item B<< $attr->has_value($instance) >>
 822
 823 Return a boolean indicating whether the attribute has been set in
 824 C<$instance>. This how the default C<predicate> method works.
 825
 826 =item B<< $attr->clear_value($instance) >>
 827
 828 This will clear the attribute's value in C<$instance>. This is what
 829 the default C<clearer> calls.
 830
 831 Note that this works even if the attribute does not have any
 832 associated read, write or clear methods.
 833
 834 =back
 835
 836 =head2 Class association
 837
 838 These methods allow you to manage the attributes association with
 839 the class that contains it. These methods should not be used
 840 lightly, nor are they very magical, they are mostly used internally
 841 and by metaclass instances.
 842
 843 =over 4
 844
 845 =item B<< $attr->associated_class >>
 846
 847 This returns the C<Class::MOP::Class> with which this attribute is
 848 associated, if any.
 849
 850 =item B<< $attr->attach_to_class($metaclass) >>
 851
 852 This method stores a weakened reference to the C<$metaclass> object
 853 internally.
 854
 855 This method does not remove the attribute from its old class,
 856 nor does it create any accessors in the new class.
 857
 858 It is probably best to use the L<Class::MOP::Class> C<add_attribute>
 859 method instead.
 860
 861 =item B<< $attr->detach_from_class >>
 862
 863 This method removes the associate metaclass object from the attribute
 864 it has one.
 865
 866 This method does not remove the attribute itself from the class, or
 867 remove its accessors.
 868
 869 It is probably best to use the L<Class::MOP::Class>
 870 C<remove_attribute> method instead.
 871
 872 =back
 873
 874 =head2 Attribute Accessor generation
 875
 876 =over 4
 877
 878 =item B<< $attr->accessor_metaclass >>
 879
 880 Accessor methods are generated using an accessor metaclass. By
 881 default, this is L<Class::MOP::Method::Accessor>. This method returns
 882 the name of the accessor metaclass that this attribute uses.
 883
 884 =item B<< $attr->associate_method($method) >>
 885
 886 This associates a L<Class::MOP::Method> object with the
 887 attribute. Typically, this is called internally when an attribute
 888 generates its accessors.
 889
 890 =item B<< $attr->associated_methods >>
 891
 892 This returns the list of methods which have been associated with the
 893 attribute.
 894
 895 =item B<< $attr->install_accessors >>
 896
 897 This method generates and installs code the attributes various
 898 accessors. It is typically called from the L<Class::MOP::Class>
 899 C<add_attribute> method.
 900
 901 =item B<< $attr->remove_accessors >>
 902
 903 This method removes all of the accessors associated with the
 904 attribute.
 905
 906 This does not currently remove methods from the list returned by
 907 C<associated_methods>.
 908
 909 =back
 910
 911 =head2 Introspection
 912
 913 =over 4
 914
 915 =item B<< $attr->meta >>
 916
 917 This will return a L<Class::MOP::Class> instance for this class.
 918
 919 It should also be noted that L<Class::MOP> will actually bootstrap
 920 this module by installing a number of attribute meta-objects into its
 921 metaclass.
 922
 923 =back
 924
 925 =head1 AUTHORS
 926
 927 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 928
 929 =head1 COPYRIGHT AND LICENSE
 930
 931 Copyright 2006-2009 by Infinity Interactive, Inc.
 932
 933 L<http://www.iinteractive.com>
 934
 935 This library is free software; you can redistribute it and/or modify
 936 it under the same terms as Perl itself.
 937
 938 =cut
 939
 940