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(),
),
);
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
=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