Merge 'trunk' into 'pluggable_errors'
Yuval Kogman [Thu, 26 Jun 2008 09:56:27 +0000 (09:56 +0000)]
r83419@syeeda (orig r4746):  stevan | 2008-06-23 23:54:19 +0400
fixing the POD stuff
r83422@syeeda (orig r4749):  sartak | 2008-06-24 09:03:53 +0400
 r63155@onn:  sartak | 2008-06-24 02:03:33 -0400
 Add support for meta_attr->does("ShortAlias")

r83423@syeeda (orig r4750):  sartak | 2008-06-24 09:04:46 +0400
 r63157@onn:  sartak | 2008-06-24 02:04:34 -0400
 Fix another typo

r83424@syeeda (orig r4751):  sartak | 2008-06-24 09:07:37 +0400
 r63159@onn:  sartak | 2008-06-24 02:05:54 -0400
 Test that "no Moose::Role" doesn't explode, qualify the namespace of Moose::_get_caller

r83425@syeeda (orig r4752):  sartak | 2008-06-24 09:08:36 +0400
 r63160@onn:  sartak | 2008-06-24 02:07:28 -0400
 Test that the sugar from Moose::Role is unimported correctly

r83430@syeeda (orig r4757):  autarch | 2008-06-26 10:04:30 +0400
I feel silly thanking myself.

r83441@syeeda (orig r4763):  nothingmuch | 2008-06-26 12:47:08 +0400
update FAQ on constructor stuff

1  2 
lib/Moose/Meta/Attribute.pm

@@@ -50,23 -51,19 +50,28 @@@ __PACKAGE__->meta->add_attribute('trait
      predicate => 'has_applied_traits',
  ));
  
- # NOTE:
  # we need to have a ->does method in here to 
  # more easily support traits, and the introspection 
- # of those traits. So in order to do this we 
- # just alias Moose::Object's version of it.
- # - SL
- *does = \&Moose::Object::does;
+ # of those traits. We extend the does check to look
+ # for metatrait aliases.
+ sub does {
+     my ($self, $role_name) = @_;
+     my $name = eval {
+         Moose::Util::resolve_metatrait_alias(Attribute => $role_name)
+     };
+     return 0 if !defined($name); # failed to load class
+     return Moose::Object::does($self, $name);
+ }
  
 +sub throw_error {
 +    my $self = shift;
 +    my $class = ( ref $self && $self->associated_class ) || "Moose::Meta::Class";
 +    unshift @_, "message" if @_ % 2 == 1;
 +    unshift @_, attr => $self if ref $self;
 +    unshift @_, $class;
 +    goto $class->can("throw_error"); # to avoid incrementing depth by 1
 +}
 +
  sub new {
      my ($class, $name, %options) = @_;
      $class->_process_options($name, \%options) unless $options{__hack_no_process_options}; # used from clone()... YECHKKK FIXME ICKY YUCK GROSS
@@@ -216,17 -213,15 +221,15 @@@ sub _process_options 
  
      if (exists $options->{is}) {
  
- =pod
- is => ro, writer => _foo    # turns into (reader => foo, writer => _foo) as before
- is => rw, writer => _foo    # turns into (reader => foo, writer => _foo)
- is => rw, accessor => _foo  # turns into (accessor => _foo)
- is => ro, accessor => _foo  # error, accesor is rw
- =cut        
+         ### -------------------------
+         ## is => ro, writer => _foo    # turns into (reader => foo, writer => _foo) as before
+         ## is => rw, writer => _foo    # turns into (reader => foo, writer => _foo)
+         ## is => rw, accessor => _foo  # turns into (accessor => _foo)
+         ## is => ro, accessor => _foo  # error, accesor is rw
+         ### -------------------------
          
          if ($options->{is} eq 'ro') {
 -            confess "Cannot define an accessor name on a read-only attribute, accessors are read/write"
 +            $class->throw_error("Cannot define an accessor name on a read-only attribute, accessors are read/write", data => $options)
                  if exists $options->{accessor};
              $options->{reader} ||= $name;
          }