Index: t/reopen_package.t =================================================================== --- t/reopen_package.t (revision 0) +++ t/reopen_package.t (revision 0) @@ -0,0 +1,32 @@ +use Test::More tests => 9; +use Test::Exception; + +# 1 +BEGIN { require_ok("MooseX::Adopt::Class::Accessor::Fast"); } + +use Class::MOP; +use Class::Accessor::Fast; +@My::Class::ISA = 'Class::Accessor::Fast'; +my $meta = Class::MOP::get_metaclass_by_name('My::Class') + || Class::MOP::Class->initialize('My::Class'); +$meta->make_immutable; + +my @warnings; +$SIG{__WARN__} = sub { push(@warnings, shift) }; + +# 2-4 +lives_ok { My::Class->mk_accessors('foo') } 'mk_accessors on immutable'; +lives_ok { My::Class->mk_ro_accessors('quux') } 'mk_ro_accessors on immutable'; +lives_ok { My::Class->mk_wo_accessors('flibble') } 'mk_wo_accessors on immutable'; + +# 5-7 +lives_ok { My::Class->make_accessor('bar') } 'mk_accessor on immutable'; +lives_ok { My::Class->make_ro_accessor('gong') } 'mk_ro_accessor on immutable'; +lives_ok { My::Class->make_wo_accessor('wibble') } 'mk_wo_accessor on immutable'; + +# 8 +lives_ok { My::Class->follow_best_practice } 'follow_best_practice on immutable'; + +# 9 +is( scalar(@warnings), 7, '7 warnings' ); + Index: lib/MooseX/Emulate/Class/Accessor/Fast.pm =================================================================== --- lib/MooseX/Emulate/Class/Accessor/Fast.pm (revision 7132) +++ lib/MooseX/Emulate/Class/Accessor/Fast.pm (working copy) @@ -3,6 +3,7 @@ use Moose::Role; use Class::MOP (); use Scalar::Util (); +use Carp (); our $VERSION = '0.00600'; @@ -75,6 +76,19 @@ || Moose::Meta::Class->initialize($class); }; +my $reopen_package_if_needed = sub { + my $self = shift; + my $meta = $locate_metaclass->($self); + my $immutable = $meta->is_immutable; + if ($immutable) { + $meta->make_mutable; + my $class = Scalar::Util::blessed($self) || $self; + Carp::cluck("Class $class was immutable, but needs to be re-opened!"); + return sub { $meta->make_immutable; }; + } + return sub {}; +}; + sub BUILD { my $self = shift; my %args; @@ -102,6 +116,7 @@ sub mk_accessors{ my $self = shift; my $meta = $locate_metaclass->($self); + my $reclose = $reopen_package_if_needed->($self); for my $attr_name (@_){ my $reader = $self->accessor_name_for($attr_name); my $writer = $self->mutator_name_for( $attr_name); @@ -122,6 +137,7 @@ $meta->add_attribute($attr_name, @opts); } } + $reclose->(); } =head2 mk_ro_accessors @field_names @@ -133,6 +149,7 @@ sub mk_ro_accessors{ my $self = shift; my $meta = $locate_metaclass->($self); + my $reclose = $reopen_package_if_needed->($self); for my $attr_name (@_){ my $reader = $self->accessor_name_for($attr_name); my @opts = ($meta->has_method($reader) ? () : (reader => $reader) ); @@ -142,6 +159,7 @@ unless $meta->has_method("_${attr_name}_accessor"); } } + $reclose->(); } =head2 mk_ro_accessors @field_names @@ -154,6 +172,7 @@ sub mk_wo_accessors{ my $self = shift; my $meta = $locate_metaclass->($self); + my $reclose = $reopen_package_if_needed->($self); for my $attr_name (@_){ my $writer = $self->mutator_name_for($attr_name); my @opts = ($meta->has_method($writer) ? () : (writer => $writer) ); @@ -163,6 +182,7 @@ unless $meta->has_method("_${attr_name}_accessor"); } } + $reclose->(); } =head2 follow_best_practices @@ -175,11 +195,13 @@ sub follow_best_practice{ my $self = shift; my $meta = $locate_metaclass->($self); + my $reclose = $reopen_package_if_needed->($self); $meta->remove_method('mutator_name_for'); $meta->remove_method('accessor_name_for'); $meta->add_method('mutator_name_for', sub{ return "set_".$_[1] }); $meta->add_method('accessor_name_for', sub{ return "get_".$_[1] }); + $reclose->(); } =head2 mutator_name_for @@ -236,30 +258,39 @@ sub make_accessor { my($class, $field) = @_; my $meta = $locate_metaclass->($class); + my $reclose = $reopen_package_if_needed->($class); my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field); my $reader = $attr->get_read_method_ref; my $writer = $attr->get_write_method_ref; - return sub { + my $accessor = sub { my $self = shift; return $reader->($self) unless @_; return $writer->($self,(@_ > 1 ? [@_] : @_)); - } + }; + $reclose->(); + return $accessor; } sub make_ro_accessor { my($class, $field) = @_; my $meta = $locate_metaclass->($class); + my $reclose = $reopen_package_if_needed->($class); my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field); - return $attr->get_read_method_ref; + my $method_ref = $attr->get_read_method_ref; + $reclose->(); + return $method_ref; } sub make_wo_accessor { my($class, $field) = @_; my $meta = $locate_metaclass->($class); + my $reclose = $reopen_package_if_needed->($class); my $attr = $meta->find_attribute_by_name($field) || $meta->add_attribute($field); - return $attr->get_write_method_ref; + my $method_ref = $attr->get_write_method_ref; + $reclose->(); + return $method_ref; } 1;