X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FAttribute.pm;h=df0fb3cec08000530dd746935b3da005052a3107;hb=93b4e576d3ac26a1676c45177161c6477ac2b35e;hp=2a47ecc8a1e22662b669448128a7a3fe9f6a0afb;hpb=343203eec945553800bc17abc3e650e40e363a8d;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm index 2a47ecc..df0fb3c 100644 --- a/lib/Class/MOP/Attribute.pm +++ b/lib/Class/MOP/Attribute.pm @@ -7,11 +7,11 @@ use warnings; use Carp 'confess'; use Scalar::Util 'blessed', 'reftype', 'weaken'; -our $VERSION = '0.02'; +our $VERSION = '0.07'; sub meta { require Class::MOP::Class; - Class::MOP::Class->initialize($_[0]) + Class::MOP::Class->initialize(blessed($_[0]) || $_[0]); } # NOTE: (meta-circularity) @@ -30,9 +30,8 @@ sub new { (defined $name && $name) || confess "You must provide a name for the attribute"; - (!exists $options{reader} && !exists $options{writer}) - || confess "You cannot declare an accessor and reader and/or writer functions" - if exists $options{accessor}; + $options{init_arg} = $name + if not exists $options{init_arg}; bless { name => $name, @@ -48,8 +47,41 @@ sub new { } => $class; } +# NOTE: +# this is a primative (and kludgy) clone operation +# for now, it will be repleace in the Class::MOP +# bootstrap with a proper one, however we know +# that this one will work fine for now. +sub clone { + my $self = shift; + my %options = @_; + (blessed($self)) + || confess "Can only clone an instance"; + return bless { %{$self}, %options } => blessed($self); +} + +sub initialize_instance_slot { + my ($self, $class, $instance, $params) = @_; + my $init_arg = $self->{init_arg}; + # try to fetch the init arg from the %params ... + my $val; + $val = $params->{$init_arg} if exists $params->{$init_arg}; + # if nothing was in the %params, we can use the + # attribute's default value (if it has one) + if (!defined $val && defined $self->{default}) { + $val = $self->default($instance); + } + $instance->{$self->name} = $val; +} + +# NOTE: +# the next bunch of methods will get bootstrapped +# away in the Class::MOP bootstrapping section + sub name { $_[0]->{name} } +sub associated_class { $_[0]->{associated_class} } + sub has_accessor { defined($_[0]->{accessor}) ? 1 : 0 } sub has_reader { defined($_[0]->{reader}) ? 1 : 0 } sub has_writer { defined($_[0]->{writer}) ? 1 : 0 } @@ -63,6 +95,9 @@ sub writer { $_[0]->{writer} } sub predicate { $_[0]->{predicate} } sub init_arg { $_[0]->{init_arg} } +# end bootstrapped away method section. +# (all methods below here are kept intact) + sub default { my $self = shift; if (reftype($self->{default}) && reftype($self->{default}) eq 'CODE') { @@ -77,8 +112,6 @@ sub default { # class association -sub associated_class { $_[0]->{associated_class} } - sub attach_to_class { my ($self, $class) = @_; (blessed($class) && $class->isa('Class::MOP::Class')) @@ -95,36 +128,35 @@ sub detach_from_class { sub generate_accessor_method { my ($self, $attr_name) = @_; - eval qq{sub { - \$_[0]->{'$attr_name'} = \$_[1] if scalar(\@_) == 2; - \$_[0]->{'$attr_name'}; - }}; + sub { + $_[0]->{$attr_name} = $_[1] if scalar(@_) == 2; + $_[0]->{$attr_name}; + }; } sub generate_reader_method { my ($self, $attr_name) = @_; - eval qq{sub { - \$_[0]->{'$attr_name'}; - }}; + sub { + confess "Cannot assign a value to a read-only accessor" if @_ > 1; + $_[0]->{$attr_name}; + }; } sub generate_writer_method { my ($self, $attr_name) = @_; - eval qq{sub { - \$_[0]->{'$attr_name'} = \$_[1]; - }}; + sub { $_[0]->{$attr_name} = $_[1] }; } sub generate_predicate_method { my ($self, $attr_name) = @_; - eval qq{sub { - defined \$_[0]->{'$attr_name'} ? 1 : 0; - }}; + sub { defined $_[0]->{$attr_name} ? 1 : 0 }; } sub process_accessors { my ($self, $type, $accessor) = @_; - if (reftype($accessor) && reftype($accessor) eq 'HASH') { + if (reftype($accessor)) { + (reftype($accessor) eq 'HASH') + || confess "bad accessor/reader/writer/predicate format, must be a HASH ref"; my ($name, $method) = each %{$accessor}; return ($name, Class::MOP::Attribute::Accessor->wrap($method)); } @@ -255,6 +287,9 @@ value of C<-foo>, then the following code will Just Work. MyClass->meta->construct_instance(-foo => "Hello There"); +In an init_arg is not assigned, it will automatically use the +value of C<$name>. + =item I The value of this key is the default value which @@ -352,6 +387,10 @@ defined, and false (C<0>) otherwise. =back +=item B + +=item B + =back =head2 Informational