use MRO::Compat;
use Carp 'confess';
+use Class::Load 0.07 ();
use Scalar::Util 'weaken', 'isweak', 'reftype', 'blessed';
use Data::OptList;
use Try::Tiny;
*check_package_cache_flag = \&mro::get_pkg_gen;
}
-our $AUTHORITY = 'cpan:STEVAN';
-
XSLoader::load(
'Moose',
- $Moose::{VERSION} ? $Moose::{VERSION} : ()
+ $Class::MOP::{VERSION} ? ${ $Class::MOP::{VERSION} } : ()
);
{
# 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_class {
+ goto &Class::Load::load_class;
}
sub load_first_existing_class {
- my $classes = Data::OptList::mkopt(\@_)
- or return;
-
- foreach my $class (@{ $classes }) {
- my $name = $class->[0];
- unless ( _is_valid_class_name($name) ) {
- my $display = defined($name) ? $name : 'undef';
- confess "Invalid class name ($display)";
- }
- }
-
- my $found;
- my %exceptions;
-
- for my $class (@{ $classes }) {
- my ($name, $options) = @{ $class };
-
- if ($options) {
- return $name if is_class_loaded($name, $options);
- if (is_class_loaded($name)) {
- # we already know it's loaded and too old, but we call
- # ->VERSION anyway to generate the exception for us
- $name->VERSION($options->{-version});
- }
- }
- else {
- return $name if is_class_loaded($name);
- }
-
- my $file = _class_to_pmfile($name);
- return $name if try {
- local $SIG{__DIE__};
- require $file;
- $name->VERSION($options->{-version})
- if defined $options->{-version};
- return 1;
- }
- catch {
- unless (/^Can't locate \Q$file\E in \@INC/) {
- confess "Couldn't load class ($name) because: $_";
- }
-
- return;
- };
- }
-
- if ( @{ $classes } > 1 ) {
- my @list = map { $_->[0] } @{ $classes };
- confess "Can't locate any of @list in \@INC (\@INC contains: @INC).";
- } else {
- confess "Can't locate " . _class_to_pmfile($classes->[0]->[0]) . " in \@INC (\@INC contains: @INC).";
- }
+ goto &Class::Load::load_first_existing_class;
}
-sub load_class {
- load_first_existing_class($_[0], ref $_[1] ? $_[1] : ());
-
- # This is done to avoid breaking code which checked the return value. Said
- # code is dumb. The return value was _always_ true, since it dies on
- # failure!
- return 1;
+sub is_class_loaded {
+ goto &Class::Load::is_class_loaded;
}
-sub _is_valid_class_name {
- my $class = shift;
-
- return 0 if ref($class);
- return 0 unless defined($class);
- return 0 unless length($class);
-
- return 1 if $class =~ /^\w+(?:::\w+)*$/;
+sub _definition_context {
+ my %context;
+ @context{qw(package file line)} = caller(1);
- return 0;
+ return (
+ definition_context => \%context,
+ );
}
## ----------------------------------------------------------------------------
# rather than re-produce it here
'_method_map' => \&Class::MOP::Mixin::HasMethods::_method_map
},
- default => sub { {} }
+ default => sub { {} },
+ _definition_context(),
))
);
'method_metaclass' => \&Class::MOP::Mixin::HasMethods::method_metaclass
},
default => 'Class::MOP::Method',
+ _definition_context(),
))
);
'wrapped_method_metaclass' => \&Class::MOP::Mixin::HasMethods::wrapped_method_metaclass
},
default => 'Class::MOP::Method::Wrapped',
+ _definition_context(),
))
);
# rather than re-produce it here
'_attribute_map' => \&Class::MOP::Mixin::HasAttributes::_attribute_map
},
- default => sub { {} }
+ default => sub { {} },
+ _definition_context(),
))
);
'attribute_metaclass' => \&Class::MOP::Mixin::HasAttributes::attribute_metaclass
},
default => 'Class::MOP::Attribute',
+ _definition_context(),
))
);
# rather than re-produce it here
'name' => \&Class::MOP::Package::name
},
+ _definition_context(),
))
);
'namespace' => \&Class::MOP::Package::namespace
},
init_arg => undef,
- default => sub { \undef }
+ default => sub { \undef },
+ _definition_context(),
))
);
'version' => \&Class::MOP::Module::version
},
init_arg => undef,
- default => sub { \undef }
+ default => sub { \undef },
+ _definition_context(),
))
);
'authority' => \&Class::MOP::Module::authority
},
init_arg => undef,
- default => sub { \undef }
+ default => sub { \undef },
+ _definition_context(),
))
);
'superclasses' => \&Class::MOP::Class::superclasses
},
init_arg => undef,
- default => sub { \undef }
+ default => sub { \undef },
+ _definition_context(),
))
);
'instance_metaclass' => \&Class::MOP::Class::instance_metaclass
},
default => 'Class::MOP::Instance',
+ _definition_context(),
))
);
'immutable_trait' => \&Class::MOP::Class::immutable_trait
},
default => "Class::MOP::Class::Immutable::Trait",
+ _definition_context(),
))
);
'constructor_name' => \&Class::MOP::Class::constructor_name,
},
default => "new",
+ _definition_context(),
))
);
'constructor_class' => \&Class::MOP::Class::constructor_class,
},
default => "Class::MOP::Method::Constructor",
+ _definition_context(),
))
);
reader => {
'destructor_class' => \&Class::MOP::Class::destructor_class,
},
+ _definition_context(),
))
);
# we just alias the original method
# rather than re-produce it here
'name' => \&Class::MOP::Mixin::AttributeCore::name
- }
+ },
+ _definition_context(),
))
);
Class::MOP::Attribute->new('accessor' => (
reader => { 'accessor' => \&Class::MOP::Mixin::AttributeCore::accessor },
predicate => { 'has_accessor' => \&Class::MOP::Mixin::AttributeCore::has_accessor },
+ _definition_context(),
))
);
Class::MOP::Attribute->new('reader' => (
reader => { 'reader' => \&Class::MOP::Mixin::AttributeCore::reader },
predicate => { 'has_reader' => \&Class::MOP::Mixin::AttributeCore::has_reader },
+ _definition_context(),
))
);
Class::MOP::Attribute->new('initializer' => (
reader => { 'initializer' => \&Class::MOP::Mixin::AttributeCore::initializer },
predicate => { 'has_initializer' => \&Class::MOP::Mixin::AttributeCore::has_initializer },
+ _definition_context(),
))
);
Class::MOP::Mixin::AttributeCore->meta->add_attribute(
Class::MOP::Attribute->new('definition_context' => (
reader => { 'definition_context' => \&Class::MOP::Mixin::AttributeCore::definition_context },
+ _definition_context(),
))
);
Class::MOP::Attribute->new('writer' => (
reader => { 'writer' => \&Class::MOP::Mixin::AttributeCore::writer },
predicate => { 'has_writer' => \&Class::MOP::Mixin::AttributeCore::has_writer },
+ _definition_context(),
))
);
Class::MOP::Attribute->new('predicate' => (
reader => { 'predicate' => \&Class::MOP::Mixin::AttributeCore::predicate },
predicate => { 'has_predicate' => \&Class::MOP::Mixin::AttributeCore::has_predicate },
+ _definition_context(),
))
);
Class::MOP::Attribute->new('clearer' => (
reader => { 'clearer' => \&Class::MOP::Mixin::AttributeCore::clearer },
predicate => { 'has_clearer' => \&Class::MOP::Mixin::AttributeCore::has_clearer },
+ _definition_context(),
))
);
Class::MOP::Attribute->new('builder' => (
reader => { 'builder' => \&Class::MOP::Mixin::AttributeCore::builder },
predicate => { 'has_builder' => \&Class::MOP::Mixin::AttributeCore::has_builder },
+ _definition_context(),
))
);
Class::MOP::Attribute->new('init_arg' => (
reader => { 'init_arg' => \&Class::MOP::Mixin::AttributeCore::init_arg },
predicate => { 'has_init_arg' => \&Class::MOP::Mixin::AttributeCore::has_init_arg },
+ _definition_context(),
))
);
Class::MOP::Attribute->new('default' => (
# default has a custom 'reader' method ...
predicate => { 'has_default' => \&Class::MOP::Mixin::AttributeCore::has_default },
+ _definition_context(),
))
);
reader => { 'insertion_order' => \&Class::MOP::Mixin::AttributeCore::insertion_order },
writer => { '_set_insertion_order' => \&Class::MOP::Mixin::AttributeCore::_set_insertion_order },
predicate => { 'has_insertion_order' => \&Class::MOP::Mixin::AttributeCore::has_insertion_order },
+ _definition_context(),
))
);
# we just alias the original method
# rather than re-produce it here
'associated_class' => \&Class::MOP::Attribute::associated_class
- }
+ },
+ _definition_context(),
))
);
Class::MOP::Attribute->meta->add_attribute(
Class::MOP::Attribute->new('associated_methods' => (
reader => { 'associated_methods' => \&Class::MOP::Attribute::associated_methods },
- default => sub { [] }
+ default => sub { [] },
+ _definition_context(),
))
);
Class::MOP::Method->meta->add_attribute(
Class::MOP::Attribute->new('body' => (
reader => { 'body' => \&Class::MOP::Method::body },
+ _definition_context(),
))
);
Class::MOP::Method->meta->add_attribute(
Class::MOP::Attribute->new('associated_metaclass' => (
reader => { 'associated_metaclass' => \&Class::MOP::Method::associated_metaclass },
+ _definition_context(),
))
);
Class::MOP::Method->meta->add_attribute(
Class::MOP::Attribute->new('package_name' => (
reader => { 'package_name' => \&Class::MOP::Method::package_name },
+ _definition_context(),
))
);
Class::MOP::Method->meta->add_attribute(
Class::MOP::Attribute->new('name' => (
reader => { 'name' => \&Class::MOP::Method::name },
+ _definition_context(),
))
);
Class::MOP::Attribute->new('original_method' => (
reader => { 'original_method' => \&Class::MOP::Method::original_method },
writer => { '_set_original_method' => \&Class::MOP::Method::_set_original_method },
+ _definition_context(),
))
);
# practices of attributes, but we put
# it here for completeness
Class::MOP::Method::Wrapped->meta->add_attribute(
- Class::MOP::Attribute->new('modifier_table')
+ Class::MOP::Attribute->new('modifier_table' => (
+ _definition_context(),
+ ))
);
## --------------------------------------------------------
Class::MOP::Method::Generated->meta->add_attribute(
Class::MOP::Attribute->new('is_inline' => (
reader => { 'is_inline' => \&Class::MOP::Method::Generated::is_inline },
- default => 0,
+ default => 0,
+ _definition_context(),
))
);
Class::MOP::Method::Generated->meta->add_attribute(
Class::MOP::Attribute->new('definition_context' => (
reader => { 'definition_context' => \&Class::MOP::Method::Generated::definition_context },
+ _definition_context(),
))
);
Class::MOP::Method::Inlined->meta->add_attribute(
Class::MOP::Attribute->new('_expected_method_class' => (
reader => { '_expected_method_class' => \&Class::MOP::Method::Inlined::_expected_method_class },
+ _definition_context(),
))
);
reader => {
'associated_attribute' => \&Class::MOP::Method::Accessor::associated_attribute
},
+ _definition_context(),
))
);
Class::MOP::Method::Accessor->meta->add_attribute(
Class::MOP::Attribute->new('accessor_type' => (
reader => { 'accessor_type' => \&Class::MOP::Method::Accessor::accessor_type },
+ _definition_context(),
))
);
reader => {
'options' => \&Class::MOP::Method::Constructor::options
},
- default => sub { +{} }
+ default => sub { +{} },
+ _definition_context(),
))
);
reader => {
'associated_metaclass' => \&Class::MOP::Method::Constructor::associated_metaclass
},
+ _definition_context(),
))
);
Class::MOP::Instance->meta->add_attribute(
Class::MOP::Attribute->new('associated_metaclass',
reader => { associated_metaclass => \&Class::MOP::Instance::associated_metaclass },
+ _definition_context(),
),
);
reader => { _class_name => \&Class::MOP::Instance::_class_name },
#lazy => 1, # not yet supported by Class::MOP but out our version does it anyway
#default => sub { $_[0]->associated_metaclass->name },
+ _definition_context(),
),
);
Class::MOP::Instance->meta->add_attribute(
Class::MOP::Attribute->new('attributes',
reader => { attributes => \&Class::MOP::Instance::get_all_attributes },
+ _definition_context(),
),
);
Class::MOP::Instance->meta->add_attribute(
Class::MOP::Attribute->new('slots',
reader => { slots => \&Class::MOP::Instance::slots },
+ _definition_context(),
),
);
Class::MOP::Instance->meta->add_attribute(
Class::MOP::Attribute->new('slot_hash',
reader => { slot_hash => \&Class::MOP::Instance::slot_hash },
+ _definition_context(),
),
);
Class::MOP::Method::Wrapped
Class::MOP::Method::Meta
+ Class::MOP::Method::Overload
/;
$_->meta->make_immutable(
This module was designed to be as unintrusive as possible. Many of its
features are accessible without B<any> change to your existing
-code. It is meant to be a compliment to your existing code and not an
+code. It is meant to be a complement to your existing code and not an
intrusion on your code base. Unlike many other B<Class::> modules,
this module B<does not> require you subclass it, or even that you
C<use> it in within your module's package.
-The only features which requires additions to your code are the
+The only features which require additions to your code are the
attribute handling and instance construction features, and these are
both completely optional features. The only reason for this is because
Perl 5's object system does not actually have these features built
class's ancestors.
Downward metaclass compatibility means that the metaclasses of a
-given class's ancestors are all either the same as (or a subclass
-of) that metaclass.
+given class's ancestors are all the same as (or a subclass of) that
+metaclass.
Here is a diagram showing a set of two classes (C<A> and C<B>) and
two metaclasses (C<Meta::A> and C<Meta::B>) which have correct
problem, and one which can only occur if you are doing deep metaclass
programming. So in other words, don't worry about it.
-Note that if you're using L<Moose> we encourage you to I<not> use
+Note that if you're using L<Moose> we encourage you to I<not> use the
L<metaclass> pragma, and instead use L<Moose::Util::MetaRole> to apply
roles to a class's metaclasses. This topic is covered at length in
various L<Moose::Cookbook> recipes.
Note that this module does not export any constants or functions.
-=head2 Constants
-
-=over 4
-
-=item I<Class::MOP::IS_RUNNING_ON_5_10>
-
-We set this constant depending on what version perl we are on, this
-allows us to take advantage of new 5.10 features and stay backwards
-compatible.
-
-=back
-
=head2 Utility functions
Note that these are all called as B<functions, not methods>.
=over 4
-=item B<Class::MOP::load_class($class_name, \%options?)>
-
-This will load the specified C<$class_name>, if it is not already
-loaded (as reported by C<is_class_loaded>). This function can be used
-in place of tricks like C<eval "use $module"> or using C<require>
-unconditionally.
-
-If the module cannot be loaded, an exception is thrown.
-
-You can pass a hash reference with options as second argument. The
-only option currently recognised is C<-version>, which will ensure
-that the loaded class has at least the required version.
-
-See also L</Class Loading Options>.
-
-For historical reasons, this function explicitly returns a true value.
-
-=item B<Class::MOP::is_class_loaded($class_name, \%options?)>
-
-Returns a boolean indicating whether or not C<$class_name> has been
-loaded.
-
-This does a basic check of the symbol table to try and determine as
-best it can if the C<$class_name> is loaded, it is probably correct
-about 99% of the time, but it can be fooled into reporting false
-positives. In particular, loading any of the core L<IO> modules will
-cause most of the rest of the core L<IO> modules to falsely report
-having been loaded, due to the way the base L<IO> module works.
-
-You can pass a hash reference with options as second argument. The
-only option currently recognised is C<-version>, which will ensure
-that the loaded class has at least the required version.
-
-See also L</Class Loading Options>.
-
=item B<Class::MOP::get_code_info($code)>
This function returns two values, the name of the package the C<$code>
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!>
-
-This will return an integer that is managed by L<Class::MOP::Class> to
-determine if a module's symbol table has been altered.
-
-In Perl 5.10 or greater, this flag is package specific. However in
-versions prior to 5.10, this will use the C<PL_sub_generation>
-variable which is not package specific.
-
-=item B<Class::MOP::load_first_existing_class(@class_names)>
-
-=item B<Class::MOP::load_first_existing_class($classA, \%optionsA?, $classB, ...)>
-
-B<NOTE: DO NOT USE THIS FUNCTION, IT IS FOR INTERNAL USE ONLY!>
-
-Given a list of class names, this function will attempt to load each
-one in turn.
-
-If it finds a class it can load, it will return that class' name. If
-none of the classes can be loaded, it will throw an exception.
-
-Additionally, you can pass a hash reference with options after each
-class name. Currently, only C<-version> is recognised and will ensure
-that the loaded class has at least the required version. If the class
-version is not sufficient, an exception will be raised.
-
-See also L</Class Loading Options>.
-
=back
=head2 Metaclass cache functions
-Class::MOP holds a cache of metaclasses. The following are functions
+C<Class::MOP> holds a cache of metaclasses. The following are functions
(B<not methods>) which can be used to access that cache. It is not
recommended that you mess with these. Bad things could happen, but if
you are brave and willing to risk it: go for it!
=back
-=head2 Class Loading Options
-
-=over 4
-
-=item -version
-
-Can be used to pass a minimum required version that will be checked
-against the class version after it was loaded.
-
-=back
+Some utility functions (such as C<Class::MOP::load_class>) that were
+previously defined in C<Class::MOP> regarding loading of classes have been
+extracted to L<Class::Load>. Please see L<Class::Load> for documentation.
=head1 SEE ALSO
and offers an excellent introduction section which delves into the topic of
metaclass compatibility.
-L<http://www.iam.unibe.ch/~scg/Archive/Papers/Duca05ySafeMetaclassTrait.pdf>
+L<http://scg.unibe.ch/archive/papers/Duca05ySafeMetaclassTrait.pdf>
=item "Safe Metaclass Programming"
not the same thing as modules like L<Class::Accessor> and
L<Class::MethodMaker>. That being said there are very few modules on CPAN
with similar goals to this module. The one I have found which is most
-like this module is L<Class::Meta>, although it's philosophy and the MOP it
+like this module is L<Class::Meta>, although its philosophy and the MOP it
creates are very different from this modules.
=head1 BUGS
projects / gitmo/Moose.git / blobdiff