Revision history for Perl extension Class-MOP.
+0.35
+
+ * Class::MOP
+ - non-generated accessors are no longer
+ copied, but instead are aliased from
+ the originals
+ - added Class::MOP::Method (and its subclasses)
+ to the bootstrap
+ - adjusted tests for this
+
+ * Class::MOP::Method
+ *** API CHANGE ***
+ - methods are no longer blessed CODE refs
+ but are actual objects which can be CODE-ified
+ - adjusted tests to compensate
+
+ * Class::MOP::Class
+ - changed how methods are dealt with to
+ encapsulate most of the work into the
+ &get_method_map method
+ - made several adjustments for the change
+ in Class::MOP::Method
+ - &add_attribute now checks if you are adding
+ a duplicate name, and properly removes the
+ old one before installing the new one
+ - added tests for this
+
+ * Class::MOP::Class::Immutable
+ - added caching of &get_method_map
+ - fixed issue with &get_package_symbol
+ - cleaned up the methods that die (patch by David Wheeler)
+
+ * Class::MOP::Package
+ - added filtering capabilities to
+ &list_all_package_symbols
+
0.34 Sat. Aug. 26, 2006
* Class::MOP::Class
- added the %:methods attribute, which like
use Class::MOP::Class::Immutable;
-our $VERSION = '0.34';
+our $VERSION = '0.35';
our $AUTHORITY = 'cpan:STEVAN';
{
our $VERSION = '0.12';
our $AUTHORITY = 'cpan:STEVAN';
+use base 'Class::MOP::Object';
+
sub meta {
require Class::MOP::Class;
Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
use Sub::Name 'subname';
use B 'svref_2object';
-our $VERSION = '0.19';
+our $VERSION = '0.20';
our $AUTHORITY = 'cpan:STEVAN';
use base 'Class::MOP::Module';
# make sure it is derived from the correct type though
($attribute->isa('Class::MOP::Attribute'))
|| confess "Your attribute must be an instance of Class::MOP::Attribute (or a subclass)";
+
+ # first we attach our new attribute
+ # because it might need certain information
+ # about the class which it is attached to
$attribute->attach_to_class($self);
+
+ # then we remove attributes of a conflicting
+ # name here so that we can properly detach
+ # the old attr object, and remove any
+ # accessors it would have generated
+ $self->remove_attribute($attribute->name)
+ if $self->has_attribute($attribute->name);
+
+ # then onto installing the new accessors
$attribute->install_accessors();
$self->get_attribute_map->{$attribute->name} = $attribute;
}
(defined $attribute_name && $attribute_name)
|| confess "You must define an attribute name";
return $self->get_attribute_map->{$attribute_name}
- if $self->has_attribute($attribute_name);
- return;
+ # NOTE:
+ # this will return undef anyway, so no need ...
+ # if $self->has_attribute($attribute_name);
+ #return;
}
sub remove_attribute {
use Carp 'confess';
use Scalar::Util 'blessed', 'looks_like_number';
-our $VERSION = '0.02';
+our $VERSION = '0.03';
our $AUTHORITY = 'cpan:STEVAN';
use base 'Class::MOP::Class';
# methods which can *not* be called
-
-sub add_method { confess 'Cannot call method "add_method" on an immutable instance' }
-sub alias_method { confess 'Cannot call method "alias_method" on an immutable instance' }
-sub remove_method { confess 'Cannot call method "remove_method" on an immutable instance' }
-
-sub add_attribute { confess 'Cannot call method "add_attribute" on an immutable instance' }
-sub remove_attribute { confess 'Cannot call method "remove_attribute" on an immutable instance' }
-
-sub add_package_symbol { confess 'Cannot call method "add_package_symbol" on an immutable instance' }
-sub remove_package_symbol { confess 'Cannot call method "remove_package_symbol" on an immutable instance' }
+for my $meth (qw(
+ add_method
+ alias_method
+ remove_method
+ add_attribute
+ remove_attribute
+ add_package_symbol
+ remove_package_symbol
+)) {
+ no strict 'refs';
+ *{$meth} = sub {
+ confess "Cannot call method '$meth' on an immutable instance";
+ };
+}
sub get_package_symbol {
my ($self, $variable) = @_;
use Scalar::Util 'reftype', 'blessed';
use B 'svref_2object';
-our $VERSION = '0.03';
+our $VERSION = '0.04';
our $AUTHORITY = 'cpan:STEVAN';
+use base 'Class::MOP::Object';
+
# NOTE:
# if poked in the right way,
# they should act like CODE refs.
sub body { (shift)->{body} }
+# TODO - add associated_class
+
# informational
# NOTE:
use Scalar::Util 'blessed';
use Carp 'confess';
-our $VERSION = '0.04';
+our $VERSION = '0.05';
our $AUTHORITY = 'cpan:STEVAN';
use base 'Class::MOP::Object';
Class::MOP::Object
Class::MOP::Package
/ ],
-
\ No newline at end of file
+ '... got all the metaclass names');
+
+is_deeply(
+ [ map { $_->meta->identifier } sort { $a cmp $b } Class::MOP::get_all_metaclass_names() ],
+ [
+ "Class::MOP::Attribute-" . $Class::MOP::Attribute::VERSION . "-cpan:STEVAN",
+ "Class::MOP::Attribute::Accessor-" . $Class::MOP::Attribute::Accessor::VERSION . "-cpan:STEVAN",
+ "Class::MOP::Class-" . $Class::MOP::Class::VERSION . "-cpan:STEVAN",
+ "Class::MOP::Instance-" . $Class::MOP::Instance::VERSION . "-cpan:STEVAN",
+ "Class::MOP::Method-" . $Class::MOP::Method::VERSION . "-cpan:STEVAN",
+ "Class::MOP::Method::Wrapped-" . $Class::MOP::Method::Wrapped::VERSION . "-cpan:STEVAN",
+ "Class::MOP::Module-" . $Class::MOP::Module::VERSION . "-cpan:STEVAN",
+ "Class::MOP::Object-" . $Class::MOP::Object::VERSION . "-cpan:STEVAN",
+ "Class::MOP::Package-" . $Class::MOP::Package::VERSION . "-cpan:STEVAN",
+ ],
+ '... got all the metaclass identifiers');
+
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 17;
+
+BEGIN {
+ use_ok('Class::MOP');
+}
+
+=pod
+
+This tests that when an attribute of the same name
+is added to a class, that it will remove the old
+one first.
+
+=cut
+
+{
+ package Foo;
+ use metaclass;
+
+ Foo->meta->add_attribute('bar' =>
+ reader => 'get_bar',
+ writer => 'set_bar',
+ );
+
+ ::can_ok('Foo', 'get_bar');
+ ::can_ok('Foo', 'set_bar');
+ ::ok(Foo->meta->has_attribute('bar'), '... Foo has the attribute bar');
+
+ my $bar_attr = Foo->meta->get_attribute('bar');
+
+ ::is($bar_attr->reader, 'get_bar', '... the bar attribute has the reader get_bar');
+ ::is($bar_attr->writer, 'set_bar', '... the bar attribute has the writer set_bar');
+ ::is($bar_attr->associated_class, Foo->meta, '... and the bar attribute is associated with Foo->meta');
+
+ Foo->meta->add_attribute('bar' =>
+ reader => 'assign_bar'
+ );
+
+ ::ok(!Foo->can('get_bar'), '... Foo no longer has the get_bar method');
+ ::ok(!Foo->can('set_bar'), '... Foo no longer has the set_bar method');
+ ::can_ok('Foo', 'assign_bar');
+ ::ok(Foo->meta->has_attribute('bar'), '... Foo still has the attribute bar');
+
+ my $bar_attr2 = Foo->meta->get_attribute('bar');
+
+ ::isnt($bar_attr, $bar_attr2, '... this is a new bar attribute');
+ ::isnt($bar_attr->associated_class, Foo->meta, '... and the old bar attribute is no longer associated with Foo->meta');
+
+ ::is($bar_attr2->associated_class, Foo->meta, '... and the new bar attribute *is* associated with Foo->meta');
+
+ ::isnt($bar_attr2->reader, 'get_bar', '... the bar attribute no longer has the reader get_bar');
+ ::isnt($bar_attr2->reader, 'set_bar', '... the bar attribute no longer has the reader set_bar');
+ ::is($bar_attr2->reader, 'assign_bar', '... the bar attribute now has the reader assign_bar');
+}
+
projects / gitmo/Class-MOP.git / commitdiff