view release on metacpan or  search on metacpan

inc/Class/MOP.pm  view on Meta::CPAN

#line 1

package Class::MOP;
BEGIN {
  $Class::MOP::AUTHORITY = 'cpan:STEVAN';
}
BEGIN {
  $Class::MOP::VERSION = '2.0009';
}

use strict;
use warnings;

use 5.008;

use MRO::Compat;

use Carp          'confess';
use Scalar::Util  'weaken', 'isweak', 'reftype', 'blessed';
use Data::OptList;
use Try::Tiny;

use Class::MOP::Mixin::AttributeCore;
use Class::MOP::Mixin::HasAttributes;
use Class::MOP::Mixin::HasMethods;
use Class::MOP::Class;
use Class::MOP::Attribute;
use Class::MOP::Method;

BEGIN {
    *IS_RUNNING_ON_5_10 = ($] < 5.009_005)
        ? sub () { 0 }
        : sub () { 1 };

    # this is either part of core or set up appropriately by MRO::Compat
    *check_package_cache_flag = \&mro::get_pkg_gen;
}

XSLoader::load(
    'Moose',
    $Class::MOP::{VERSION} ? ${ $Class::MOP::{VERSION} } : ()
);

{
    # Metaclasses are singletons, so we cache them here.
    # there is no need to worry about destruction though
    # because they should die only when the program dies.
    # After all, do package definitions even get reaped?
    # Anonymous classes manage their own destruction.
    my %METAS;

    sub get_all_metaclasses         {        %METAS         }
    sub get_all_metaclass_instances { values %METAS         }
    sub get_all_metaclass_names     { keys   %METAS         }
    sub get_metaclass_by_name       { $METAS{$_[0]}         }
    sub store_metaclass_by_name     { $METAS{$_[0]} = $_[1] }
    sub weaken_metaclass            { weaken($METAS{$_[0]}) }
    sub metaclass_is_weak           { isweak($METAS{$_[0]}) }
    sub does_metaclass_exist        { exists $METAS{$_[0]} && defined $METAS{$_[0]} }
    sub remove_metaclass_by_name    { delete $METAS{$_[0]}; return }

    # This handles instances as well as class names
    sub class_of {
        return unless defined $_[0];
        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
    # Class::MOP::Package or Class::MOP::Module. Mostly
    # 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 = 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__};