X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FClass.pm;h=0686bd7df7340d92a9615fd94e1a9a2aa65f1022;hb=4edd0667cd0f156b04eda1a630033afb3fbab708;hp=3908891a7b1d3f39fdc0e2429f5f8d503c4e7dec;hpb=abfebb5208f2548ec481bd2db36d1505f77fb180;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index 3908891..0686bd7 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -11,7 +11,7 @@ use Class::MOP::Method::Wrapped; use Carp 'confess'; use Scalar::Util 'blessed', 'weaken'; -our $VERSION = '0.65'; +our $VERSION = '0.70_01'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -222,6 +222,14 @@ sub check_metaclass_compatability { no warnings 'uninitialized'; return unless $self->name =~ /^$ANON_CLASS_PREFIX/; + # Moose does a weird thing where it replaces the metaclass for + # class when fixing metaclass incompatibility. In that case, + # we don't want to clean out the namespace now. We can detect + # that because Moose will explicitly update the singleton + # cache in Class::MOP. + my $current_meta = Class::MOP::get_metaclass_by_name($self->name); + return if $current_meta ne $self; + my ($serial_id) = ($self->name =~ /^$ANON_CLASS_PREFIX(\d+)/); no strict 'refs'; foreach my $key (keys %{$ANON_CLASS_PREFIX . $serial_id}) { @@ -242,9 +250,6 @@ sub create { my (%options) = @args; my $package_name = $options{package}; - (defined $package_name && $package_name) - || confess "You must pass a package name"; - (ref $options{superclasses} eq 'ARRAY') || confess "You must pass an ARRAY ref of superclasses" if exists $options{superclasses}; @@ -257,16 +262,18 @@ sub create { || confess "You must pass an HASH ref of methods" if exists $options{methods}; - my $code = "package $package_name;"; - $code .= "\$$package_name\:\:VERSION = '" . $options{version} . "';" - if exists $options{version}; - $code .= "\$$package_name\:\:AUTHORITY = '" . $options{authority} . "';" - if exists $options{authority}; + $class->SUPER::create(%options); - eval $code; - confess "creation of $package_name failed : $@" if $@; - - my $meta = $class->initialize($package_name); + my (%initialize_options) = @args; + delete @initialize_options{qw( + package + superclasses + attributes + methods + version + authority + )}; + my $meta = $class->initialize( $package_name => %initialize_options ); # FIXME totally lame $meta->add_method('meta' => sub { @@ -492,6 +499,14 @@ sub superclasses { if (@_) { my @supers = @_; @{$self->get_package_symbol($var_spec)} = @supers; + + # NOTE: + # on 5.8 and below, we need to call + # a method to get Perl to detect + # a cycle in the class hierarchy + my $class = $self->name; + $class->isa($class); + # NOTE: # we need to check the metaclass # compatibility here so that we can @@ -1452,7 +1467,7 @@ for more information on the method metaclasses. Wrap a code ref (C<$attrs{body>) with C. -=item B +=item B This will take a C<$method_name> and CODE reference or meta method objectand install it into the class's package.