Revision history for Perl extension Class-MOP.
+0.81
+ * Makefile.PL
+ - Make sure to preserve any compiler flags already defined in
+ Config.pm. Patch by Vincent Pit. RT #44739.
+
+0.80 Wed, April 1, 2009
+ * Class::MOP::*
+ - Call user_class->meta in fewer places, with the eventual goal
+ of allowing the user to rename or exclude ->meta
+ altogether. Instead uses Class::MOP::class_of. (Sartak)
+
+ * Class::MOP
+ - New class_of function that should be used to retrieve a
+ metaclass. This is unlike get_metaclass_by_name in that it
+ accepts instances, not just class names. (Sartak)
+
+ * Class::MOP
+ - load_first_existing_class didn't actually load the first
+ existing class; instead, it loaded the first existing and
+ compiling class. It now throws an error if a class exists (in
+ @INC) but fails to compile. (hdp)
+
+ * Class::MOP
+ * Class::MOP::Class
+ - we had some semi-buggy code that purported to provide a
+ HAS_ISAREV based on whether mro had get_isarev (due to an
+ oversight, it always returned 1). Since mro and MRO::Compat
+ have always had get_isarev, HAS_ISAREV was pointless. This
+ insight simplified the subclasses method by deleting the
+ pure-perl fallback. HAS_ISAREV is now deprecated. (Sartak)
+
+0.79 Fri, March 29, 2009
+ * No changes from 0.78_02.
+
0.78_02 Thu, March 26, 2009
* Class::MOP::Class
* Class::MOP::Immutable
all_from 'lib/Class/MOP.pm';
license 'perl';
-my $ccflags = ' -I.';
+require Config;
+my $ccflags = ( $Config::Config{ccflags} || '' ) . ' -I.';
$ccflags .= ' -Wall' if -d '.svn' || -d '.git' || $ENV{MAINTAINER_MODE};
requires 'Carp';
-Class::MOP version 0.78_02
+Class::MOP version 0.80
===========================
See the individual module documentation for more information
use Carp 'confess';
use Devel::GlobalDestruction qw( in_global_destruction );
-use Scalar::Util 'weaken', 'reftype';
+use Scalar::Util 'weaken', 'reftype', 'blessed';
use Sub::Name qw( subname );
use Class::MOP::Class;
? sub () { 0 }
: sub () { 1 };
- *HAVE_ISAREV = defined(&mro::get_isarev)
- ? sub () { 1 }
- : sub () { 1 };
+ sub HAVE_ISAREV () {
+ warn "Class::MOP::HAVE_ISAREV is deprecated and will be removed in a future release. It has always returned 1 anyway.";
+ return 1;
+ }
# this is either part of core or set up appropriately by MRO::Compat
*check_package_cache_flag = \&mro::get_pkg_gen;
}
-our $VERSION = '0.78_02';
+our $VERSION = '0.80';
our $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
sub does_metaclass_exist { exists $METAS{$_[0]} && defined $METAS{$_[0]} }
sub remove_metaclass_by_name { $METAS{$_[0]} = undef }
+ # This handles instances as well as class names
+ sub class_of {
+ my $class = blessed($_[0]) || $_[0];
+ return $METAS{$class};
+ }
+
# NOTE:
# We only cache metaclasses, meaning instances of
# Class::MOP::Class. We do not cache instance of
# because I don't yet see a good reason to do so.
}
+sub _class_to_pmfile {
+ my $class = shift;
+
+ my $file = $class . '.pm';
+ $file =~ s{::}{/}g;
+
+ return $file;
+}
+
sub load_first_existing_class {
my @classes = @_
or return;
my $found;
my %exceptions;
for my $class (@classes) {
+ my $pmfile = _class_to_pmfile($class);
my $e = _try_load_one_class($class);
if ($e) {
$exceptions{$class} = $e;
+ last if $e !~ /^Can't locate \Q$pmfile\E in \@INC/;
}
else {
$found = $class;
"Could not load class (%s) because : %s", $_,
$exceptions{$_}
)
+ }
+ grep {
+ exists $exceptions{$_}
} @classes
);
}
return if is_class_loaded($class);
- my $file = $class . '.pm';
- $file =~ s{::}{/}g;
+ my $file = _class_to_pmfile($class);
return do {
local $@;
allows us to take advantage of new 5.10 features and stay backwards
compatible.
-=item I<Class::MOP::HAVE_ISAREV>
-
-Whether or not the L<mro> pragma provides C<get_isarev>, a much faster
-way to get all the subclasses of a certain class.
-
=back
=head2 Utility functions
This will load the specified C<$class_name>. This function can be used
in place of tricks like C<eval "use $module"> or using C<require>
-unconditionally.
+unconditionally. This will return the metaclass of C<$class_name>.
=item B<Class::MOP::is_class_loaded($class_name)>
elements of the MOP to determine where a given C<$code> reference is
from.
+=item B<Class::MOP::class_of($instance_or_class_name)>
+
+This will return the metaclass of the given instance or class name.
+Even if the class lacks a metaclass, no metaclass will be initialized
+and C<undef> will be returned.
+
=item B<Class::MOP::check_package_cache_flag($pkg)>
B<NOTE: DO NOT USE THIS FUNCTION, IT IS FOR INTERNAL USE ONLY!>
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '0.78_02';
+our $VERSION = '0.80';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '0.78_02';
+our $VERSION = '0.80';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
: ref($super_meta);
($self->isa($super_meta_type))
- || confess $self->name . "->meta => (" . (ref($self)) . ")" .
- " is not compatible with the " .
- $superclass_name . "->meta => (" . ($super_meta_type) . ")";
+ || confess "Class::MOP::class_of(" . $self->name . ") => ("
+ . (ref($self)) . ")" . " is not compatible with the " .
+ "Class::MOP::class_of(".$superclass_name . ") => ("
+ . ($super_meta_type) . ")";
# NOTE:
# we also need to check that instance metaclasses
# are compatibile in the same the class.
($self->instance_metaclass->isa($super_meta->instance_metaclass))
- || confess $self->name . "->meta->instance_metaclass => (" . ($self->instance_metaclass) . ")" .
+ || confess "Class::MOP::class_of(" . $self->name . ")->instance_metaclass => (" . ($self->instance_metaclass) . ")" .
" is not compatible with the " .
- $superclass_name . "->meta->instance_metaclass => (" . ($super_meta->instance_metaclass) . ")";
+ "Class::MOP::class_of(" . $superclass_name . ")->instance_metaclass => (" . ($super_meta->instance_metaclass) . ")";
}
}
sub rebless_instance {
my ($self, $instance, %params) = @_;
- my $old_metaclass;
- if ($instance->can('meta')) {
- ($instance->meta->isa('Class::MOP::Class'))
- || confess 'Cannot rebless instance if ->meta is not an instance of Class::MOP::Class';
- $old_metaclass = $instance->meta;
- }
- else {
- $old_metaclass = $self->initialize(blessed($instance));
- }
+ my $old_metaclass = Class::MOP::class_of($instance);
- $old_metaclass->rebless_instance_away($instance, $self, %params);
+ my $old_class = $old_metaclass ? $old_metaclass->name : blessed($instance);
+ $self->name->isa($old_class)
+ || confess "You may rebless only into a subclass of ($old_class), of which (". $self->name .") isn't.";
- my $meta_instance = $self->get_meta_instance();
+ $old_metaclass->rebless_instance_away($instance, $self, %params)
+ if $old_metaclass;
- $self->name->isa($old_metaclass->name)
- || confess "You may rebless only into a subclass of (". $old_metaclass->name ."), of which (". $self->name .") isn't.";
+ my $meta_instance = $self->get_meta_instance();
# rebless!
# we use $_[1] here because of t/306_rebless_overload.t regressions on 5.8.8
sub subclasses {
my $self = shift;
-
my $super_class = $self->name;
- if ( Class::MOP::HAVE_ISAREV() ) {
- return @{ $super_class->mro::get_isarev() };
- } else {
- my @derived_classes;
-
- my $find_derived_classes;
- $find_derived_classes = sub {
- my ($outer_class) = @_;
-
- my $symbol_table_hashref = do { no strict 'refs'; \%{"${outer_class}::"} };
-
- SYMBOL:
- for my $symbol ( keys %$symbol_table_hashref ) {
- next SYMBOL if $symbol !~ /\A (\w+):: \z/x;
- my $inner_class = $1;
-
- next SYMBOL if $inner_class eq 'SUPER'; # skip '*::SUPER'
-
- my $class =
- $outer_class
- ? "${outer_class}::$inner_class"
- : $inner_class;
-
- if ( $class->isa($super_class) and $class ne $super_class ) {
- push @derived_classes, $class;
- }
-
- next SYMBOL if $class eq 'main'; # skip 'main::*'
-
- $find_derived_classes->($class);
- }
- };
-
- my $root_class = q{};
- $find_derived_classes->($root_class);
-
- undef $find_derived_classes;
-
- @derived_classes = sort { $a->isa($b) ? 1 : $b->isa($a) ? -1 : 0 } @derived_classes;
-
- return @derived_classes;
- }
+ return @{ $super_class->mro::get_isarev() };
}
use Carp 'confess';
use Scalar::Util 'blessed';
-our $VERSION = '0.78_02';
+our $VERSION = '0.80';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
# that has been made immutable and for that we need
# to dig a bit ...
if ($self->isa('Class::MOP::Class')) {
- return $self->{'___original_class'}->meta;
+ return Class::MOP::class_of($self->{'___original_class'});
}
else {
return $self;
my $self = shift;
my $metaclass = $self->metaclass;
- my $meta = $metaclass->meta;
+ my $meta = Class::MOP::class_of($metaclass);
return {
%DEFAULT_METHODS,
sub _make_read_only_methods {
my $self = shift;
- my $metameta = $self->metaclass->meta;
+ my $metameta = Class::MOP::class_of($self->metaclass);
my %methods;
foreach my $read_only_method ( @{ $self->options->{read_only} } ) {
my %methods;
- my $metameta = $self->metaclass->meta;
+ my $metameta = Class::MOP::class_of($self->metaclass);
my $memoized_methods = $self->options->{memoize};
foreach my $method_name ( keys %{$memoized_methods} ) {
my $wrapped_methods = $self->options->{wrapped};
- my $metameta = $self->metaclass->meta;
+ my $metameta = Class::MOP::class_of($self->metaclass);
foreach my $method_name ( keys %{$wrapped_methods} ) {
my $method = $metameta->find_method_by_name($method_name);
use Scalar::Util 'weaken', 'blessed';
-our $VERSION = '0.78_02';
+our $VERSION = '0.80';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Carp 'confess';
use Scalar::Util 'weaken';
-our $VERSION = '0.78_02';
+our $VERSION = '0.80';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken';
-our $VERSION = '0.78_02';
+our $VERSION = '0.80';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Carp 'confess';
use Scalar::Util 'blessed', 'weaken', 'looks_like_number';
-our $VERSION = '0.78_02';
+our $VERSION = '0.80';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Carp 'confess';
-our $VERSION = '0.78_02';
+our $VERSION = '0.80';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Carp 'confess';
use Scalar::Util 'blessed';
-our $VERSION = '0.78_02';
+our $VERSION = '0.80';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Carp 'confess';
use Scalar::Util 'blessed';
-our $VERSION = '0.78_02';
+our $VERSION = '0.80';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Scalar::Util 'blessed';
-our $VERSION = '0.78_02';
+our $VERSION = '0.80';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
}
sub _new {
- shift->meta->new_object(@_);
+ Class::MOP::class_of(shift)->new_object(@_);
}
# RANT:
use Scalar::Util 'blessed';
use Carp 'confess';
-our $VERSION = '0.78_02';
+our $VERSION = '0.80';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use Carp 'confess';
use Scalar::Util 'blessed';
-our $VERSION = '0.78_02';
+our $VERSION = '0.80';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';
use strict;
use warnings;
-use Test::More tests => 33;
+use Test::More tests => 34;
use Test::Exception;
require Class::MOP;
qr/Missing right curly/;
throws_ok {
+ delete $INC{'SyntaxError.pm'};
+ Class::MOP::load_first_existing_class(
+ 'FakeClassOhNo', 'SyntaxError', 'Class'
+ );
+}
+qr/Missing right curly/,
+ 'load_first_existing_class does not pass over an existing (bad) module';
+
+throws_ok {
Class::MOP::load_class('This::Does::Not::Exist');
}
qr/Could not load class \(This::Does::Not::Exist\) because :/,
plan tests => scalar @modules;
my %trustme = (
+ 'Class::MOP' => ['HAVE_ISAREV'],
'Class::MOP::Attribute' => ['process_accessors'],
'Class::MOP::Class' => [
# deprecated
'update_package_cache_flag',
'wrap_method_body',
+ # doc'd with rebless_instance
+ 'rebless_instance_away',
],
'Class::MOP::Instance' => [
prechecking
prepends
rebless
+reblessing
runtime
sigil
sigils
projects / gitmo/Class-MOP.git / commitdiff