# THIS FILE IS AUTOGENERATED!

# if regular Mouse is loaded, bail out
unless ($INC{'Mouse.pm'}) {
eval <<'END_OF_TINY';

# tell Perl we already have all of the Mouse files loaded:
$INC{'Mouse.pm'} = __FILE__;
$INC{'Mouse/Object.pm'} = __FILE__;
$INC{'Mouse/Role.pm'} = __FILE__;
$INC{'Mouse/Util.pm'} = __FILE__;
$INC{'Mouse/TypeRegistry.pm'} = __FILE__;
$INC{'Mouse/Spec.pm'} = __FILE__;
$INC{'Mouse/Meta/Attribute.pm'} = __FILE__;
$INC{'Mouse/Meta/Class.pm'} = __FILE__;
$INC{'Mouse/Meta/Role.pm'} = __FILE__;
$INC{'Mouse/Meta/TypeConstraint.pm'} = __FILE__;
$INC{'Mouse/Meta/Method.pm'} = __FILE__;
$INC{'Mouse/Meta/Module.pm'} = __FILE__;
$INC{'Mouse/Meta/Method/Accessor.pm'} = __FILE__;
$INC{'Mouse/Meta/Method/Constructor.pm'} = __FILE__;
$INC{'Mouse/Meta/Method/Destructor.pm'} = __FILE__;
$INC{'Mouse/Meta/Role/Method.pm'} = __FILE__;
$INC{'Mouse/Util/TypeConstraints.pm'} = __FILE__;

# and now their contents

package Mouse::Util;
use strict;
use warnings;

use Exporter;

use Carp qw(confess);
use B ();

use constant _MOUSE_VERBOSE => !!$ENV{MOUSE_VERBOSE};

our @ISA       = qw(Exporter);
our @EXPORT_OK = qw(
    find_meta
    does_role
    resolve_metaclass_alias
    apply_all_roles
    english_list

    load_class
    is_class_loaded

    get_linear_isa
    get_code_info

    get_code_package

    not_supported

    does meta dump
    _MOUSE_VERBOSE
);
our %EXPORT_TAGS = (
    all  => \@EXPORT_OK,
    meta => [qw(does meta dump _MOUSE_VERBOSE)],
);

# aliases as public APIs

# it must be 'require', because Mouse::Meta::Module depends on Mouse::Util
require Mouse::Meta::Module; # for the entities of metaclass cache utilities

BEGIN {
    *class_of                    = \&Mouse::Meta::Module::class_of;
    *get_metaclass_by_name       = \&Mouse::Meta::Module::get_metaclass_by_name;
    *get_all_metaclass_instances = \&Mouse::Meta::Module::get_all_metaclass_instances;
    *get_all_metaclass_names     = \&Mouse::Meta::Module::get_all_metaclass_names;
}

# Moose::Util compatible utilities

sub find_meta{
    return class_of( $_[0] );
}

sub does_role{
    my ($class_or_obj, $role_name) = @_;

    my $meta = class_of($class_or_obj);

    (defined $role_name)
        || ($meta || 'Mouse::Meta::Class')->throw_error("You must supply a role name to does()");

    return defined($meta) && $meta->does_role($role_name);
}

BEGIN {
    my $impl;
    if ($] >= 5.009_005) {
        require mro;
        $impl = \&mro::get_linear_isa;
    } else {
        my $e = do {
            local $@;
            eval { require MRO::Compat };
            $@;
        };
        if (!$e) {
            $impl = \&mro::get_linear_isa;
        } else {
#       VVVVV   CODE TAKEN FROM MRO::COMPAT   VVVVV
            my $_get_linear_isa_dfs; # this recurses so it isn't pretty
            $_get_linear_isa_dfs = sub {
                no strict 'refs';

                my $classname = shift;

                my @lin = ($classname);
                my %stored;
                foreach my $parent (@{"$classname\::ISA"}) {
                    my $plin = $_get_linear_isa_dfs->($parent);
                    foreach  my $p(@$plin) {
                        next if exists $stored{$p};
                        push(@lin, $p);
                        $stored{$p} = 1;
                    }
                }
                return \@lin;
            };
#       ^^^^^   CODE TAKEN FROM MRO::COMPAT   ^^^^^
            $impl = $_get_linear_isa_dfs;
        }
    }


    no warnings 'once';
    *get_linear_isa = $impl;
}

{ # taken from Sub::Identify
    sub get_code_info($) {
        my ($coderef) = @_;
        ref($coderef) or return;

        my $cv = B::svref_2object($coderef);
        $cv->isa('B::CV') or return;

        my $gv = $cv->GV;
        $gv->isa('B::GV') or return;

        return ($gv->STASH->NAME, $gv->NAME);
    }

    sub get_code_package{
        my($coderef) = @_;

        my $cv = B::svref_2object($coderef);
        $cv->isa('B::CV') or return '';

        my $gv = $cv->GV;
        $gv->isa('B::GV') or return '';

        return $gv->STASH->NAME;
    }
}

# taken from Mouse::Util (0.90)
{
    my %cache;

    sub resolve_metaclass_alias {
        my ( $type, $metaclass_name, %options ) = @_;

        my $cache_key = $type . q{ } . ( $options{trait} ? '-Trait' : '' );

        return $cache{$cache_key}{$metaclass_name} ||= do{

            my $possible_full_name = join '::',
                'Mouse::Meta', $type, 'Custom', ($options{trait} ? 'Trait' : ()), $metaclass_name
            ;

            my $loaded_class = load_first_existing_class(
                $possible_full_name,
                $metaclass_name
            );

            $loaded_class->can('register_implementation')
                ? $loaded_class->register_implementation
                : $loaded_class;
        };
    }
}

# Utilities from Class::MOP


# taken from Class/MOP.pm
sub is_valid_class_name {
    my $class = shift;

    return 0 if ref($class);
    return 0 unless defined($class);

    return 1 if $class =~ /^\w+(?:::\w+)*$/;

    return 0;
}

# taken from Class/MOP.pm
sub load_first_existing_class {
    my @classes = @_
      or return;

    my %exceptions;
    for my $class (@classes) {
        my $e = _try_load_one_class($class);

        if ($e) {
            $exceptions{$class} = $e;
        }
        else {
            return $class;
        }
    }

    # not found
    confess join(
        "\n",
        map {
            sprintf( "Could not load class (%s) because : %s",
                $_, $exceptions{$_} )
          } @classes
    );
}

# taken from Class/MOP.pm
my %is_class_loaded_cache;
sub _try_load_one_class {
    my $class = shift;

    unless ( is_valid_class_name($class) ) {
        my $display = defined($class) ? $class : 'undef';
        confess "Invalid class name ($display)";
    }

    return undef if $is_class_loaded_cache{$class} ||= is_class_loaded($class);

    my $file = $class . '.pm';
    $file =~ s{::}{/}g;

    return do {
        local $@;
        eval { require($file) };
        $@;
    };
}


sub load_class {
    my $class = shift;
    my $e = _try_load_one_class($class);
    confess "Could not load class ($class) because : $e" if $e;

    return 1;
}


sub is_class_loaded {
    my $class = shift;

    return 0 if ref($class) || !defined($class) || !length($class);

    # walk the symbol table tree to avoid autovififying
    # \*{${main::}{"Foo::"}} == \*main::Foo::

    my $pack = \%::;
    foreach my $part (split('::', $class)) {
        my $entry = \$pack->{$part . '::'};
        return 0 if ref($entry) ne 'GLOB';
        $pack = *{$entry}{HASH} or return 0;
    }

    # check for $VERSION or @ISA
    return 1 if exists $pack->{VERSION}
             && defined *{$pack->{VERSION}}{SCALAR} && defined ${ $pack->{VERSION} };
    return 1 if exists $pack->{ISA}
             && defined *{$pack->{ISA}}{ARRAY} && @{ $pack->{ISA} } != 0;

    # check for any method
    foreach my $name( keys %{$pack} ) {
        my $entry = \$pack->{$name};
        return 1 if ref($entry) ne 'GLOB' || defined *{$entry}{CODE};
    }

    # fail
    return 0;
}


sub apply_all_roles {
    my $meta = Mouse::Meta::Class->initialize(shift);

    my @roles;

    # Basis of Data::OptList
    my $max = scalar(@_);
    for (my $i = 0; $i < $max ; $i++) {
        if ($i + 1 < $max && ref($_[$i + 1])) {
            push @roles, [ $_[$i++] => $_[$i] ];
        } else {
            push @roles, [ $_[$i]   => undef ];
        }
        my $role_name = $roles[-1][0];
        load_class($role_name);
        ( $role_name->can('meta') && $role_name->meta->isa('Mouse::Meta::Role') )
            || $meta->throw_error("You can only consume roles, $role_name(".$role_name->meta.") is not a Mouse role");
    }

    if ( scalar @roles == 1 ) {
        my ( $role, $params ) = @{ $roles[0] };
        $role->meta->apply( $meta, ( defined $params ? %$params : () ) );
    }
    else {
        Mouse::Meta::Role->combine_apply($meta, @roles);
    }
    return;
}

# taken from Moose::Util 0.90
sub english_list {
    return $_[0] if @_ == 1;

    my @items = sort @_;

    return "$items[0] and $items[1]" if @items == 2;

    my $tail = pop @items;

    return join q{, }, @items, "and $tail";
}


# common utilities

sub not_supported{
    my($feature) = @_;

    $feature ||= ( caller(1) )[3]; # subroutine name

    local $Carp::CarpLevel = $Carp::CarpLevel + 1;
    Carp::confess("Mouse does not currently support $feature");
}

sub meta{
    return Mouse::Meta::Class->initialize($_[0]);
}

sub dump { 
    my($self, $maxdepth) = @_;

    require 'Data/Dumper.pm'; # we don't want to create its namespace
    my $dd = Data::Dumper->new([$self]);
    $dd->Maxdepth(defined($maxdepth) ? $maxdepth : 2);
    $dd->Indent(1);
    return $dd->Dump();
}

sub does :method;
*does = \&does_role; # alias

package Mouse;
use 5.006_002;

use strict;
use warnings;

our $VERSION = '0.37_01';

use Exporter;

use Carp 'confess';
use Scalar::Util 'blessed';

BEGIN { Mouse::Util->import(qw(load_class is_class_loaded get_code_package not_supported)) }

BEGIN { Mouse::Util::TypeConstraints->import(()) }

our @ISA = qw(Exporter);

our @EXPORT = qw(
    extends with
    has
    before after around
    override super
    augment  inner

    blessed confess
);

our %is_removable = map{ $_ => undef } @EXPORT;
delete $is_removable{blessed};
delete $is_removable{confess};

sub extends { Mouse::Meta::Class->initialize(scalar caller)->superclasses(@_) }

sub has {
    my $meta = Mouse::Meta::Class->initialize(scalar caller);
    my $name = shift;

    $meta->add_attribute($_ => @_) for ref($name) ? @{$name} : $name;
}

sub before {
    my $meta = Mouse::Meta::Class->initialize(scalar caller);

    my $code = pop;

    for (@_) {
        $meta->add_before_method_modifier($_ => $code);
    }
}

sub after {
    my $meta = Mouse::Meta::Class->initialize(scalar caller);

    my $code = pop;

    for (@_) {
        $meta->add_after_method_modifier($_ => $code);
    }
}

sub around {
    my $meta = Mouse::Meta::Class->initialize(scalar caller);

    my $code = pop;

    for (@_) {
        $meta->add_around_method_modifier($_ => $code);
    }
}

sub with {
    Mouse::Util::apply_all_roles(scalar(caller), @_);
}

our $SUPER_PACKAGE;
our $SUPER_BODY;
our @SUPER_ARGS;

sub super {
    # This check avoids a recursion loop - see
    # t/100_bugs/020_super_recursion.t
    return if defined $SUPER_PACKAGE && $SUPER_PACKAGE ne caller();
    return unless $SUPER_BODY; $SUPER_BODY->(@SUPER_ARGS);
}

sub override {
    my $meta = Mouse::Meta::Class->initialize(caller);
    my $pkg = $meta->name;

    my $name = shift;
    my $code = shift;

    my $body = $pkg->can($name)
        or confess "You cannot override '$name' because it has no super method";

    $meta->add_method($name => sub {
        local $SUPER_PACKAGE = $pkg;
        local @SUPER_ARGS = @_;
        local $SUPER_BODY = $body;

        $code->(@_);
    });
}

sub inner  { not_supported }
sub augment{ not_supported }

sub init_meta {
    shift;
    my %args = @_;

    my $class = $args{for_class}
                    or confess("Cannot call init_meta without specifying a for_class");
    my $base_class = $args{base_class} || 'Mouse::Object';
    my $metaclass  = $args{metaclass}  || 'Mouse::Meta::Class';

    confess("The Metaclass $metaclass must be a subclass of Mouse::Meta::Class.")
            unless $metaclass->isa('Mouse::Meta::Class');

    # make a subtype for each Mouse class
    Mouse::Util::TypeConstraints::class_type($class)
        unless Mouse::Util::TypeConstraints::find_type_constraint($class);

    my $meta = $metaclass->initialize($class);

    $meta->add_method(meta => sub{
        return $metaclass->initialize(ref($_[0]) || $_[0]);
    });

    $meta->superclasses($base_class)
        unless $meta->superclasses;

    return $meta;
}

sub import {
    my $class = shift;

    strict->import;
    warnings->import;

    my $opts = do {
        if (ref($_[0]) && ref($_[0]) eq 'HASH') {
            shift @_;
        } else {
            +{ };
        }
    };
    my $level = delete $opts->{into_level};
       $level = 0 unless defined $level;
    my $caller = caller($level);

    # we should never export to main
    if ($caller eq 'main') {
        warn qq{$class does not export its sugar to the 'main' package.\n};
        return;
    }

    $class->init_meta(
        for_class  => $caller,
    );

    if (@_) {
        __PACKAGE__->export_to_level( $level+1, $class, @_);
    } else {
        # shortcut for the common case of no type character
        no strict 'refs';
        for my $keyword (@EXPORT) {
            *{ $caller . '::' . $keyword } = *{__PACKAGE__ . '::' . $keyword};
        }
    }
}

sub unimport {
    my $caller = caller;

    my $stash = do{
        no strict 'refs';
        \%{$caller . '::'}
    };

    for my $keyword (@EXPORT) {
        my $code;
        if(exists $is_removable{$keyword}
            && ($code = $caller->can($keyword))
            && get_code_package($code) eq __PACKAGE__){

            delete $stash->{$keyword};
        }
    }
}

package Mouse::Meta::Attribute;
use strict;
use warnings;

use Carp ();

BEGIN { Mouse::Util->import(qw(:meta)) }

sub _process_options{
    my($class, $name, $args) = @_;


    # XXX: for backward compatibility (with method modifiers)
    if($class->can('canonicalize_args') != \&canonicalize_args){
        %{$args} = $class->canonicalize_args($name, %{$args});
    }

    # taken from Class::MOP::Attribute::new

    defined($name)
        or $class->throw_error('You must provide a name for the attribute');

    if(!exists $args->{init_arg}){
        $args->{init_arg} = $name;
    }

    # 'required' requires eigher 'init_arg', 'builder', or 'default'
    my $can_be_required = defined( $args->{init_arg} );

    if(exists $args->{builder}){
        # XXX:
        # Moose refuses a CODE ref builder, but Mouse doesn't for backward compatibility
        # This feature will be changed in a future. (gfx)
        $class->throw_error('builder must be a defined scalar value which is a method name')
            #if ref $args->{builder} || !defined $args->{builder};
            if !defined $args->{builder};

        $can_be_required++;
    }
    elsif(exists $args->{default}){
        if(ref $args->{default} && ref($args->{default}) ne 'CODE'){
            $class->throw_error("References are not allowed as default values, you must "
                              . "wrap the default of '$name' in a CODE reference (ex: sub { [] } and not [])");
        }
        $can_be_required++;
    }

    if( $args->{required} && !$can_be_required ) {
        $class->throw_error("You cannot have a required attribute ($name) without a default, builder, or an init_arg");
    }

    # taken from Mouse::Meta::Attribute->new and _process_args->

    if(exists $args->{is}){
        my $is = $args->{is};

        if($is eq 'ro'){
            $args->{reader} ||= $name;
        }
        elsif($is eq 'rw'){
            if(exists $args->{writer}){
                $args->{reader} ||= $name;
             }
             else{
                $args->{accessor} ||= $name;
             }
        }
        elsif($is eq 'bare'){
            # do nothing, but don't complain (later) about missing methods
        }
        else{
            $is = 'undef' if !defined $is;
            $class->throw_error("I do not understand this option (is => $is) on attribute ($name)");
        }
    }

    my $tc;
    if(exists $args->{isa}){
        $args->{type_constraint} = Mouse::Util::TypeConstraints::find_or_create_isa_type_constraint($args->{isa});
    }
    elsif(exists $args->{does}){
        # TODO
        # $args->{type_constraint} = Mouse::Util::TypeConstraints::find_or_create_does_type_constraint($args->{does});
    }
    $tc = $args->{type_constraint};

    if($args->{coerce}){
        defined($tc)
            || $class->throw_error("You cannot have coercion without specifying a type constraint on attribute ($name)");

        $args->{weak_ref}
            && $class->throw_error("You cannot have a weak reference to a coerced value on attribute ($name)");
    }

    if ($args->{lazy_build}) {
        exists($args->{default})
            && $class->throw_error("You can not use lazy_build and default for the same attribute ($name)");

        $args->{lazy}      = 1;
        $args->{builder} ||= "_build_${name}";
        if ($name =~ /^_/) {
            $args->{clearer}   ||= "_clear${name}";
            $args->{predicate} ||= "_has${name}";
        }
        else {
            $args->{clearer}   ||= "clear_${name}";
            $args->{predicate} ||= "has_${name}";
        }
    }

    if ($args->{auto_deref}) {
        defined($tc)
            || $class->throw_error("You cannot auto-dereference without specifying a type constraint on attribute ($name)");

        ( $tc->is_a_type_of('ArrayRef') || $tc->is_a_type_of('HashRef') )
            || $class->throw_error("You cannot auto-dereference anything other than a ArrayRef or HashRef on attribute ($name)");
    }

    if (exists $args->{trigger}) {
        ('CODE' eq ref $args->{trigger})
            || $class->throw_error("Trigger must be a CODE ref on attribute ($name)");
    }

    if ($args->{lazy}) {
        (exists $args->{default} || defined $args->{builder})
            || $class->throw_error("You cannot have lazy attribute ($name) without specifying a default value for it");
    }

    return;
}

sub new {
    my $class = shift;
    my $name  = shift;

    my %args  = (@_ == 1) ? %{ $_[0] } : @_;

    $class->_process_options($name, \%args);

    $args{name} = $name;

    my $instance = bless \%args, $class;

    # extra attributes
    if($class ne __PACKAGE__){
        $class->meta->_initialize_instance($instance,\%args);
    }

# XXX: there is no fast way to check attribute validity
#    my @bad = ...;
#    if(@bad){
#        @bad = sort @bad;
#        Carp::cluck("Found unknown argument(s) passed to '$name' attribute constructor in '$class': @bad");
#    }

    return $instance;
}

# readers

sub name                 { $_[0]->{name}                   }
sub associated_class     { $_[0]->{associated_class}       }

sub accessor             { $_[0]->{accessor}               }
sub reader               { $_[0]->{reader}                 }
sub writer               { $_[0]->{writer}                 }
sub predicate            { $_[0]->{predicate}              }
sub clearer              { $_[0]->{clearer}                }
sub handles              { $_[0]->{handles}                }

sub _is_metadata         { $_[0]->{is}                     }
sub is_required          { $_[0]->{required}               }
sub default              { $_[0]->{default}                }
sub is_lazy              { $_[0]->{lazy}                   }
sub is_lazy_build        { $_[0]->{lazy_build}             }
sub is_weak_ref          { $_[0]->{weak_ref}               }
sub init_arg             { $_[0]->{init_arg}               }
sub type_constraint      { $_[0]->{type_constraint}        }

sub trigger              { $_[0]->{trigger}                }
sub builder              { $_[0]->{builder}                }
sub should_auto_deref    { $_[0]->{auto_deref}             }
sub should_coerce        { $_[0]->{coerce}                 }

sub get_read_method      { $_[0]->{reader} || $_[0]->{accessor} }
sub get_write_method     { $_[0]->{writer} || $_[0]->{accessor} }

# predicates

sub has_accessor         { exists $_[0]->{accessor}        }
sub has_reader           { exists $_[0]->{reader}          }
sub has_writer           { exists $_[0]->{writer}          }
sub has_predicate        { exists $_[0]->{predicate}       }
sub has_clearer          { exists $_[0]->{clearer}         }
sub has_handles          { exists $_[0]->{handles}         }

sub has_default          { exists $_[0]->{default}         }
sub has_type_constraint  { exists $_[0]->{type_constraint} }
sub has_trigger          { exists $_[0]->{trigger}         }
sub has_builder          { exists $_[0]->{builder}         }

sub has_read_method      { exists $_[0]->{reader} || exists $_[0]->{accessor} }
sub has_write_method     { exists $_[0]->{writer} || exists $_[0]->{accessor} }

sub _create_args {
    $_[0]->{_create_args} = $_[1] if @_ > 1;
    $_[0]->{_create_args}
}

sub interpolate_class{
    my($class, $name, $args) = @_;

    if(my $metaclass = delete $args->{metaclass}){
        $class = Mouse::Util::resolve_metaclass_alias( Attribute => $metaclass );
    }

    my @traits;
    if(my $traits_ref = delete $args->{traits}){

        for (my $i = 0; $i < @{$traits_ref}; $i++) {
            my $trait = Mouse::Util::resolve_metaclass_alias(Attribute => $traits_ref->[$i], trait => 1);

            next if $class->does($trait);

            push @traits, $trait;

            # are there options?
            push @traits, $traits_ref->[++$i]
                if ref($traits_ref->[$i+1]);
        }

        if (@traits) {
            $class = Mouse::Meta::Class->create_anon_class(
                superclasses => [ $class ],
                roles        => \@traits,
                cache        => 1,
            )->name;
        }
    }

    return( $class, @traits );
}

sub canonicalize_args{
    my ($self, $name, %args) = @_;

    Carp::cluck("$self->canonicalize_args has been deprecated."
        . "Use \$self->_process_options instead.")
            if _MOUSE_VERBOSE;

    return %args;
}

sub create {
    my ($self, $class, $name, %args) = @_;

    Carp::cluck("$self->create has been deprecated."
        . "Use \$meta->add_attribute and \$attr->install_accessors instead.")
            if _MOUSE_VERBOSE;

    # noop
    return $self;
}

sub _coerce_and_verify {
    my($self, $value, $instance) = @_;

    my $type_constraint = $self->{type_constraint};

    return $value if !$type_constraint;

    if ($self->should_coerce && $type_constraint->has_coercion) {
        $value = $type_constraint->coerce($value);
    }

    return $value if $type_constraint->check($value);

    $self->verify_against_type_constraint($value);

    return $value;
}

sub verify_against_type_constraint {
    my ($self, $value) = @_;

    my $type_constraint = $self->{type_constraint};
    return 1 if !$type_constraint;;
    return 1 if $type_constraint->check($value);

    $self->verify_type_constraint_error($self->name, $value, $type_constraint);
}

sub verify_type_constraint_error {
    my($self, $name, $value, $type) = @_;
    $self->throw_error("Attribute ($name) does not pass the type constraint because: " . $type->get_message($value));
}

sub coerce_constraint { ## my($self, $value) = @_;
    my $type = $_[0]->{type_constraint}
        or return $_[1];

    Carp::cluck("coerce_constraint() has been deprecated, which was an internal utility anyway");

    return Mouse::Util::TypeConstraints->typecast_constraints($_[0]->associated_class->name, $type, $_[1]);
}

sub _canonicalize_handles {
    my $self    = shift;
    my $handles = shift;

    if (ref($handles) eq 'HASH') {
        return %$handles;
    }
    elsif (ref($handles) eq 'ARRAY') {
        return map { $_ => $_ } @$handles;
    }
    else {
        $self->throw_error("Unable to canonicalize the 'handles' option with $handles");
    }
}

sub clone_and_inherit_options{
    my $self = shift;
    my $name = shift;

    return ref($self)->new($name, %{$self}, (@_ == 1) ? %{$_[0]} : @_);
}

sub clone_parent {
    my $self  = shift;
    my $class = shift;
    my $name  = shift;
    my %args  = ($self->get_parent_args($class, $name), @_);

    Carp::cluck("$self->clone_parent has been deprecated."
        . "Use \$meta->add_attribute and \$attr->install_accessors instead.")
        if _MOUSE_VERBOSE;

    $self->clone_and_inherited_args($class, $name, %args);
}

sub get_parent_args {
    my $self  = shift;
    my $class = shift;
    my $name  = shift;

    for my $super ($class->linearized_isa) {
        my $super_attr = $super->can("meta") && $super->meta->get_attribute($name)
            or next;
        return %{ $super_attr->_create_args };
    }

    $self->throw_error("Could not find an attribute by the name of '$name' to inherit from");
}

sub associate_method{
    my ($attribute, $method) = @_;
    $attribute->{associated_methods}++;
    return;
}

sub install_accessors{
    my($attribute) = @_;

    my $metaclass       = $attribute->{associated_class};

    foreach my $type(qw(accessor reader writer predicate clearer handles)){
        if(exists $attribute->{$type}){
            my $installer    = '_install_' . $type;

            Mouse::Meta::Method::Accessor->$installer($attribute, $attribute->{$type}, $metaclass);

            $attribute->{associated_methods}++;
        }
    }

    if($attribute->can('create') != \&create){
        # backword compatibility
        $attribute->create($metaclass, $attribute->name, %{$attribute});
    }

    return;
}

sub throw_error{
    my $self = shift;

    my $metaclass = (ref $self && $self->associated_class) || 'Mouse::Meta::Class';
    $metaclass->throw_error(@_, depth => 1);
}

package Mouse::Meta::Class;
use strict;
use warnings;

use Scalar::Util qw/blessed weaken/;

BEGIN { Mouse::Util->import(qw/:meta get_linear_isa not_supported/) }

our @ISA = qw(Mouse::Meta::Module);

sub method_metaclass(){ 'Mouse::Meta::Method' } # required for get_method()

sub _construct_meta {
    my($class, %args) = @_;

    $args{attributes} ||= {};
    $args{methods}    ||= {};
    $args{roles}      ||= [];

    $args{superclasses} = do {
        no strict 'refs';
        \@{ $args{package} . '::ISA' };
    };

    #return Mouse::Meta::Class->initialize($class)->new_object(%args)
    #    if $class ne __PACKAGE__;

    return bless \%args, ref($class) || $class;
}

sub create_anon_class{
    my $self = shift;
    return $self->create(undef, @_);
}

sub is_anon_class{
    return exists $_[0]->{anon_serial_id};
}

sub roles { $_[0]->{roles} }

sub superclasses {
    my $self = shift;

    if (@_) {
        Mouse::load_class($_) for @_;
        @{ $self->{superclasses} } = @_;
    }

    return @{ $self->{superclasses} };
}

sub find_method_by_name{
    my($self, $method_name) = @_;
    defined($method_name)
        or $self->throw_error('You must define a method name to find');
    foreach my $class( $self->linearized_isa ){
        my $method = $self->initialize($class)->get_method($method_name);
        return $method if defined $method;
    }
    return undef;
}

sub get_all_methods {
    my($self) = @_;
    return map{ $self->find_method_by_name($_) } $self->get_all_method_names;
}

sub get_all_method_names {
    my $self = shift;
    my %uniq;
    return grep { $uniq{$_}++ == 0 }
            map { Mouse::Meta::Class->initialize($_)->get_method_list() }
            $self->linearized_isa;
}

sub add_attribute {
    my $self = shift;

    my($attr, $name);

    if(blessed $_[0]){
        $attr = $_[0];

        $attr->isa('Mouse::Meta::Attribute')
            || $self->throw_error("Your attribute must be an instance of Mouse::Meta::Attribute (or a subclass)");

        $name = $attr->name;
    }
    else{
        # _process_attribute
        $name = shift;

        my %args = (@_ == 1) ? %{$_[0]} : @_;

        defined($name)
            or $self->throw_error('You must provide a name for the attribute');

        if ($name =~ s/^\+//) { # inherited attributes
            my $inherited_attr;

            foreach my $class($self->linearized_isa){
                my $meta = Mouse::Util::get_metaclass_by_name($class) or next;
                $inherited_attr = $meta->get_attribute($name) and last;
            }

            defined($inherited_attr)
                or $self->throw_error("Could not find an attribute by the name of '$name' to inherit from in ".$self->name);

            $attr = $inherited_attr->clone_and_inherit_options($name, \%args);
        }
        else{
            my($attribute_class, @traits) = Mouse::Meta::Attribute->interpolate_class($name, \%args);
            $args{traits} = \@traits if @traits;

            $attr = $attribute_class->new($name, \%args);
        }
    }

    weaken( $attr->{associated_class} = $self );

    $self->{attributes}{$attr->name} = $attr;
    $attr->install_accessors();

    if(_MOUSE_VERBOSE && !$attr->{associated_methods} && ($attr->{is} || '') ne 'bare'){
        Carp::cluck(qq{Attribute (}.$attr->name.qq{) of class }.$self->name.qq{ has no associated methods (did you mean to provide an "is" argument?)});
    }
    return $attr;
}

sub compute_all_applicable_attributes { shift->get_all_attributes(@_) }
sub get_all_attributes {
    my $self = shift;
    my (@attr, %seen);

    for my $class ($self->linearized_isa) {
        my $meta = $self->_metaclass_cache($class)
            or next;

        for my $name (keys %{ $meta->get_attribute_map }) {
            next if $seen{$name}++;
            push @attr, $meta->get_attribute($name);
        }
    }

    return @attr;
}

sub linearized_isa { @{ get_linear_isa($_[0]->name) } }

sub new_object {
    my $self = shift;
    my %args = (@_ == 1 ? %{$_[0]} : @_);

    my $instance = bless {}, $self->name;

    $self->_initialize_instance($instance, \%args);
    return $instance;
}

sub _initialize_instance{
    my($self, $instance, $args) = @_;

    my @triggers_queue;

    foreach my $attribute ($self->get_all_attributes) {
        my $from = $attribute->init_arg;
        my $key  = $attribute->name;

        if (defined($from) && exists($args->{$from})) {
            $instance->{$key} = $attribute->_coerce_and_verify($args->{$from});

            weaken($instance->{$key})
                if ref($instance->{$key}) && $attribute->is_weak_ref;

            if ($attribute->has_trigger) {
                push @triggers_queue, [ $attribute->trigger, $instance->{$from} ];
            }
        }
        else {
            if ($attribute->has_default || $attribute->has_builder) {
                unless ($attribute->is_lazy) {
                    my $default = $attribute->default;
                    my $builder = $attribute->builder;
                    my $value =   $builder                ? $instance->$builder()
                                : ref($default) eq 'CODE' ? $instance->$default()
                                :                           $default;

                    # XXX: we cannot use $attribute->set_value() because it invokes triggers.
                    $instance->{$key} = $attribute->_coerce_and_verify($value, $instance);;

                    weaken($instance->{$key})
                        if ref($instance->{$key}) && $attribute->is_weak_ref;
                }
            }
            else {
                if ($attribute->is_required) {
                    $self->throw_error("Attribute (".$attribute->name.") is required");
                }
            }
        }
    }

    foreach my $trigger_and_value(@triggers_queue){
        my($trigger, $value) = @{$trigger_and_value};
        $trigger->($instance, $value);
    }

    if($self->is_anon_class){
        $instance->{__METACLASS__} = $self;
    }

    return $instance;
}

sub clone_object {
    my $class    = shift;
    my $instance = shift;
    my %params   = (@_ == 1) ? %{$_[0]} : @_;

    (blessed($instance) && $instance->isa($class->name))
        || $class->throw_error("You must pass an instance of the metaclass (" . $class->name . "), not ($instance)");

    my $clone = bless { %$instance }, ref $instance;

    foreach my $attr ($class->get_all_attributes()) {
        if ( defined( my $init_arg = $attr->init_arg ) ) {
            if (exists $params{$init_arg}) {
                $clone->{ $attr->name } = $params{$init_arg};
            }
        }
    }

    return $clone;
}

sub clone_instance {
    my ($class, $instance, %params) = @_;

    Carp::cluck('clone_instance has been deprecated. Use clone_object instead')
        if _MOUSE_VERBOSE;
    return $class->clone_object($instance, %params);
}

sub make_immutable {
    my $self = shift;
    my %args = (
        inline_constructor => 1,
        inline_destructor  => 1,
        @_,
    );

    $self->{is_immutable}++;

    if ($args{inline_constructor}) {
        $self->add_method('new' => Mouse::Meta::Method::Constructor->generate_constructor_method_inline( $self ));
    }

    if ($args{inline_destructor}) {
        $self->add_method('DESTROY' => Mouse::Meta::Method::Destructor->generate_destructor_method_inline( $self ));
    }

    # Moose's make_immutable returns true allowing calling code to skip setting an explicit true value
    # at the end of a source file. 
    return 1;
}

sub make_mutable { not_supported }

sub is_immutable {  $_[0]->{is_immutable} }
sub is_mutable   { !$_[0]->{is_immutable} }

sub _install_modifier_pp{
    my( $self, $into, $type, $name, $code ) = @_;

    my $original = $into->can($name)
        or $self->throw_error("The method '$name' is not found in the inheritance hierarchy for class $into");

    my $modifier_table = $self->{modifiers}{$name};

    if(!$modifier_table){
        my(@before, @after, @around, $cache, $modified);

        $cache = $original;

        $modified = sub {
            for my $c (@before) { $c->(@_) }

            if(wantarray){ # list context
                my @rval = $cache->(@_);

                for my $c(@after){ $c->(@_) }
                return @rval;
            }
            elsif(defined wantarray){ # scalar context
                my $rval = $cache->(@_);

                for my $c(@after){ $c->(@_) }
                return $rval;
            }
            else{ # void context
                $cache->(@_);

                for my $c(@after){ $c->(@_) }
                return;
            }
        };

        $self->{modifiers}{$name} = $modifier_table = {
            original => $original,

            before   => \@before,
            after    => \@after,
            around   => \@around,

            cache    => \$cache, # cache for around modifiers
        };

        $self->add_method($name => $modified);
    }

    if($type eq 'before'){
        unshift @{$modifier_table->{before}}, $code;
    }
    elsif($type eq 'after'){
        push @{$modifier_table->{after}}, $code;
    }
    else{ # around
        push @{$modifier_table->{around}}, $code;

        my $next = ${ $modifier_table->{cache} };
        ${ $modifier_table->{cache} } = sub{ $code->($next, @_) };
    }

    return;
}

sub _install_modifier {
    my ( $self, $into, $type, $name, $code ) = @_;

    # load Class::Method::Modifiers first
    my $no_cmm_fast = do{
        local $@;
        eval q{ require Class::Method::Modifiers::Fast };
        $@;
    };

    my $impl;
    if($no_cmm_fast){
        $impl = \&_install_modifier_pp;
    }
    else{
        my $install_modifier = Class::Method::Modifiers::Fast->can('_install_modifier');
        $impl = sub {
            my ( $self, $into, $type, $name, $code ) = @_;
            $install_modifier->(
                $into,
                $type,
                $name,
                $code
            );
            $self->{methods}{$name}++; # register it to the method map
            return;
        };
    }

    # replace this method itself :)
    {
        no warnings 'redefine';
        *_install_modifier = $impl;
    }

    $self->$impl( $into, $type, $name, $code );
}

sub add_before_method_modifier {
    my ( $self, $name, $code ) = @_;
    $self->_install_modifier( $self->name, 'before', $name, $code );
}

sub add_around_method_modifier {
    my ( $self, $name, $code ) = @_;
    $self->_install_modifier( $self->name, 'around', $name, $code );
}

sub add_after_method_modifier {
    my ( $self, $name, $code ) = @_;
    $self->_install_modifier( $self->name, 'after', $name, $code );
}

sub add_override_method_modifier {
    my ($self, $name, $code) = @_;

    my $package = $self->name;

    my $body = $package->can($name)
        or $self->throw_error("You cannot override '$name' because it has no super method");

    $self->add_method($name => sub { $code->($package, $body, @_) });
}

sub does_role {
    my ($self, $role_name) = @_;

    (defined $role_name)
        || $self->throw_error("You must supply a role name to look for");

    for my $class ($self->linearized_isa) {
        my $meta = Mouse::Util::get_metaclass_by_name($class);
        next unless $meta && $meta->can('roles');

        for my $role (@{ $meta->roles }) {

            return 1 if $role->does_role($role_name);
        }
    }

    return 0;
}

package Mouse::Meta::Method;
use strict;
use warnings;

BEGIN { Mouse::Util->import(qw(:meta)) }

use overload
    '&{}' => 'body',
    fallback => 1,
;

sub new{
    my($class, %args) = @_;

    return bless \%args, $class;
}

sub body        { $_[0]->{body}    }
sub name        { $_[0]->{name}    }
sub package_name{ $_[0]->{package} }

sub fully_qualified_name {
    my $self = shift;
    return $self->package_name . '::' . $self->name;
}

package Mouse::Meta::Method::Accessor;
use strict;
use warnings;
use Scalar::Util qw(blessed);

sub _install_accessor{
    my (undef, $attribute, $method_name, $class, $type) = @_;

    my $name          = $attribute->name;
    my $default       = $attribute->default;
    my $constraint    = $attribute->type_constraint;
    my $builder       = $attribute->builder;
    my $trigger       = $attribute->trigger;
    my $is_weak       = $attribute->is_weak_ref;
    my $should_deref  = $attribute->should_auto_deref;
    my $should_coerce = $attribute->should_coerce;

    my $compiled_type_constraint = $constraint ? $constraint->_compiled_type_constraint : undef;

    my $self  = '$_[0]';
    my $key   = sprintf q{"%s"}, quotemeta $name;

    $type ||= 'accessor';

    my $accessor = 
        '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" .
        "sub {\n";
    if ($type eq 'accessor' || $type eq 'writer') {
        if($type eq 'accessor'){
            $accessor .= 
                '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" .
                'if (scalar(@_) >= 2) {' . "\n";
        }
        else{ # writer
            $accessor .= 
                '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" .
                'if(@_ < 2){ Carp::confess("Not enough arguments for writer '.$method_name.'") }'.
                '{' . "\n";
        }
                
        my $value = '$_[1]';

        if (defined $constraint) {
            if(!$compiled_type_constraint){
                Carp::confess("[BUG] Missing compiled type constraint for $constraint");
            }
            if ($should_coerce) {
                $accessor .=
                    "\n".
                    '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" .
                    'my $val = $constraint->coerce('.$value.');';
                $value = '$val';
            }
            $accessor .= 
                "\n".
                '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" .
                'unless ($compiled_type_constraint->('.$value.')) {
                    $attribute->verify_type_constraint_error($name, '.$value.', $attribute->{type_constraint});
                }' . "\n";
        }

        # if there's nothing left to do for the attribute we can return during
        # this setter
        $accessor .= 'return ' if !$is_weak && !$trigger && !$should_deref;

        $accessor .= $self.'->{'.$key.'} = '.$value.';' . "\n";

        if ($is_weak) {
            $accessor .= 'Scalar::Util::weaken('.$self.'->{'.$key.'}) if ref('.$self.'->{'.$key.'});' . "\n";
        }

        if ($trigger) {
            $accessor .= '$trigger->('.$self.', '.$value.');' . "\n";
        }

        $accessor .= "}\n";
    }
    elsif($type eq 'reader') {
        $accessor .= 'Carp::confess("Cannot assign a value to a read-only accessor") if scalar(@_) >= 2;' . "\n";
    }
    else{
        $class->throw_error("Unknown accessor type '$type'");
    }

    if ($attribute->is_lazy) {
        $accessor .= $self.'->{'.$key.'} = ';

        if($should_coerce && defined($constraint)){
            $accessor .= '$attribute->_coerce_and_verify(';
        }
        $accessor .=   $attribute->has_builder ? $self.'->$builder'
                     : ref($default) eq 'CODE' ? '$default->('.$self.')'
                     :                           '$default';

        if($should_coerce && defined $constraint){
            $accessor .= ')';
        }
        $accessor .= ' if !exists '.$self.'->{'.$key.'};' . "\n";
    }

    if ($should_deref) {
        if ($constraint->is_a_type_of('ArrayRef')) {
            $accessor .= 'if (wantarray) {
                return @{ '.$self.'->{'.$key.'} || [] };
            }';
        }
        elsif($constraint->is_a_type_of('HashRef')){
            $accessor .= 'if (wantarray) {
                return %{ '.$self.'->{'.$key.'} || {} };
            }';
        }
        else{
            $class->throw_error("Can not auto de-reference the type constraint " . $constraint->name);
        }
    }

    $accessor .= 'return '.$self.'->{'.$key."};\n}";

    #print $accessor, "\n";
    my $code = eval $accessor;
    $attribute->throw_error($@) if $@;

    $class->add_method($method_name => $code);
    return;
}

sub _install_reader{
    my $class = shift;
    $class->_install_accessor(@_, 'reader');
    return;
}

sub _install_writer{
    my $class = shift;
    $class->_install_accessor(@_, 'writer');
    return;
}


sub _install_predicate {
    my (undef, $attribute, $method_name, $class) = @_;

    my $slot = $attribute->name;

    $class->add_method($method_name => sub{
        return exists $_[0]->{$slot};
    });
    return;
}

sub _install_clearer {
    my (undef, $attribute, $method_name, $class) = @_;

    my $slot = $attribute->name;

    $class->add_method($method_name => sub{
        delete $_[0]->{$slot};
    });
    return;
}

sub _install_handles {
    my (undef, $attribute, $handles, $class) = @_;

    my $reader  = $attribute->reader || $attribute->accessor
        or $class->throw_error("You must pass a reader method for '".$attribute->name."'");

    my %handles = $attribute->_canonicalize_handles($handles);

    foreach my $handle_name (keys %handles) {
        my $method_to_call = $handles{$handle_name};

        my $code = sub {
            my $instance = shift;
            my $proxy    = $instance->$reader();

            my $error = !defined($proxy)                ? ' is not defined'
                      : ref($proxy) && !blessed($proxy) ? qq{ is not an object (got '$proxy')}
                                                        : undef;
            if ($error) {
                $instance->meta->throw_error(
                    "Cannot delegate $handle_name to $method_to_call because "
                        . "the value of "
                        . $attribute->name
                        . $error
                 );
            }
            $proxy->$method_to_call(@_);
        };
        $class->add_method($handle_name => $code);
    }
    return;
}


package Mouse::Meta::Method::Constructor;
use strict;
use warnings;

sub generate_constructor_method_inline {
    my ($class, $metaclass) = @_;

    my $associated_metaclass_name = $metaclass->name;
    my @attrs         = $metaclass->get_all_attributes;

    my $buildall      = $class->_generate_BUILDALL($metaclass);
    my $buildargs     = $class->_generate_BUILDARGS($metaclass);
    my $processattrs  = $class->_generate_processattrs($metaclass, \@attrs);

    my @compiled_constraints = map { $_ ? $_->_compiled_type_constraint : undef }
                               map { $_->type_constraint } @attrs;

    my $code = sprintf("#line %d %s\n", __LINE__, __FILE__).<<"...";
    sub {
        my \$class = shift;
        return \$class->Mouse::Object::new(\@_)
            if \$class ne q{$associated_metaclass_name};
        $buildargs;
        my \$instance = bless {}, \$class;
        $processattrs;
        $buildall;
        return \$instance;
    }
...

    local $@;
    my $res = eval $code;
    die $@ if $@;
    $res;
}

sub _generate_processattrs {
    my ($class, $metaclass, $attrs) = @_;
    my @res;

    my $has_triggers;

    for my $index (0 .. @$attrs - 1) {
        my $attr = $attrs->[$index];
        my $key  = $attr->name;
        my $code = '';

        if (defined $attr->init_arg) {
            my $from = $attr->init_arg;

            $code .= "if (exists \$args->{q{$from}}) {\n";

            my $value = "\$args->{q{$from}}";
            if(my $type_constraint = $attr->type_constraint){
                if($attr->should_coerce && $type_constraint->has_coercion){
                    $code .= "my \$value = \$attrs[$index]->{type_constraint}->coerce(\$args->{q{$from}});\n";
                    $value = '$value';
                }

                $code .= "\$compiled_constraints[$index]->($value)\n";
                $code .= "  or \$attrs[$index]->verify_type_constraint_error(q{$key}, $value, \$attrs[$index]->{type_constraint});\n";
            }

            $code .= "\$instance->{q{$key}} = $value;\n";

            if ($attr->is_weak_ref) {
                $code .= "Scalar::Util::weaken( \$instance->{q{$key}} ) if ref($value);\n";
            }

            if ($attr->has_trigger) {
                $has_triggers++;
                $code .= "push \@triggers, [\$attrs[$index]->{trigger}, $value];\n";
            }

            $code .= "\n} else {\n";
        }

        if ($attr->has_default || $attr->has_builder) {
            unless ($attr->is_lazy) {
                my $default = $attr->default;
                my $builder = $attr->builder;

                $code .= "my \$value = ";

                if ($attr->should_coerce && $attr->type_constraint) {
                    $code .= "\$attrs[$index]->_coerce_and_verify(";
                }

                if ($attr->has_builder) {
                    $code .= "\$instance->$builder()";
                }
                elsif (ref($default) eq 'CODE') {
                    $code .= "\$attrs[$index]->{default}->(\$instance)";
                }
                elsif (!defined($default)) {
                    $code .= 'undef';
                }
                elsif ($default =~ /^\-?[0-9]+(?:\.[0-9]+)$/) {
                    $code .= $default;
                }
                else {
                    $code .= "'$default'";
                }

                if ($attr->should_coerce) {
                    $code .= ");\n";
                }
                else {
                    $code .= ";\n";
                }

                if ($attr->has_type_constraint) {
                    $code .= "{
                        unless (\$attrs[$index]->{type_constraint}->check(\$value)) {
                            \$attrs[$index]->verify_type_constraint_error(q{$key}, \$value, \$attrs[$index]->type_constraint)
                        }
                    }";
                }

                $code .= "\$instance->{q{$key}} = \$value;\n";

                if ($attr->is_weak_ref) {
                    $code .= "Scalar::Util::weaken( \$instance->{q{$key}} ) if ref( \$value );\n";
                }
            }
        }
        elsif ($attr->is_required) {
            $code .= "Carp::confess('Attribute ($key) is required');";
        }

        $code .= "}\n" if defined $attr->init_arg;

        push @res, $code;
    }

    if($metaclass->is_anon_class){
        push @res, q{$instnace->{__METACLASS__} = $metaclass;};
    }

    if($has_triggers){
        unshift @res, q{my @triggers;};
        push    @res,  q{$_->[0]->($instance, $_->[1]) for @triggers;};
    }

    return join "\n", @res;
}

sub _generate_BUILDARGS {
    my($self, $metaclass) = @_;

    if ($metaclass->name->can('BUILDARGS') && $metaclass->name->can('BUILDARGS') != \&Mouse::Object::BUILDARGS) {
        return 'my $args = $class->BUILDARGS(@_)';
    }

    return <<'...';
        my $args;
        if ( scalar @_ == 1 ) {
            ( ref( $_[0] ) eq 'HASH' )
                || Carp::confess "Single parameters to new() must be a HASH ref";
            $args = +{ %{ $_[0] } };
        }
        else {
            $args = +{@_};
        }
...
}

sub _generate_BUILDALL {
    my ($class, $metaclass) = @_;

    return '' unless $metaclass->name->can('BUILD');

    my @code;
    for my $class ($metaclass->linearized_isa) {
        no strict 'refs';
        no warnings 'once';

        if (*{ $class . '::BUILD' }{CODE}) {
            unshift  @code, qq{${class}::BUILD(\$instance, \$args);};
        }
    }
    return join "\n", @code;
}

package Mouse::Meta::Method::Destructor;
use strict;
use warnings;

sub generate_destructor_method_inline {
    my ($class, $meta) = @_;

    my $demolishall = do {
        if ($meta->name->can('DEMOLISH')) {
            my @code = ();
            for my $class ($meta->linearized_isa) {
                no strict 'refs';
                if (*{$class . '::DEMOLISH'}{CODE}) {
                    push @code, "${class}::DEMOLISH(\$self);";
                }
            }
            join "\n", @code;
        } else {
            return sub { }; # no demolish =)
        }
    };

    my $code = <<"...";
    sub {
        my \$self = shift;
        $demolishall;
    }
...

    local $@;
    my $res = eval $code;
    die $@ if $@;
    return $res;
}

package Mouse::Meta::Module;
use strict;
use warnings;

use Carp ();
use Scalar::Util qw/blessed weaken/;

BEGIN { Mouse::Util->import(qw/:meta get_code_package not_supported load_class/) }


my %METAS;

# because Mouse doesn't introspect existing classes, we're forced to
# only pay attention to other Mouse classes
sub _metaclass_cache {
    my($class, $name) = @_;
    return $METAS{$name};
}

sub initialize {
    my($class, $package_name, @args) = @_;

    ($package_name && !ref($package_name))
        || $class->throw_error("You must pass a package name and it cannot be blessed");

    return $METAS{$package_name}
        ||= $class->_construct_meta(package => $package_name, @args);
}

sub class_of{
    my($class_or_instance) = @_;
    return undef unless defined $class_or_instance;
    return $METAS{ ref($class_or_instance) || $class_or_instance };
}

# Means of accessing all the metaclasses that have
# been initialized thus far
#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 does_metaclass_exist        { defined $METAS{$_[0]} }
#sub remove_metaclass_by_name    { delete $METAS{$_[0]}  }



sub name { $_[0]->{package} }

# The followings are Class::MOP specific methods

#sub version   { no strict 'refs'; ${shift->name.'::VERSION'}   }
#sub authority { no strict 'refs'; ${shift->name.'::AUTHORITY'} }
#sub identifier {
#    my $self = shift;
#    return join '-' => (
#       $self->name,
#        ($self->version   || ()),
#        ($self->authority || ()),
#    );
#}

# add_attribute is an abstract method

sub get_attribute_map {        $_[0]->{attributes}          }
sub has_attribute     { exists $_[0]->{attributes}->{$_[1]} }
sub get_attribute     {        $_[0]->{attributes}->{$_[1]} }
sub get_attribute_list{ keys %{$_[0]->{attributes}}         }
sub remove_attribute  { delete $_[0]->{attributes}->{$_[1]} }

sub namespace{
    my $name = $_[0]->{package};
    no strict 'refs';
    return \%{ $name . '::' };
}

sub add_method {
    my($self, $name, $code) = @_;

    if(!defined $name){
        $self->throw_error('You must pass a defined name');
    }
    if(!defined $code){
        $self->throw_error('You must pass a defined code');
    }

    if(ref($code) ne 'CODE'){
        not_supported 'add_method for a method object';
    }

    $self->{methods}->{$name}++; # Moose stores meta object here.

    my $pkg = $self->name;
    no strict 'refs';
    no warnings 'redefine';
    *{ $pkg . '::' . $name } = $code;
}

# XXX: for backward compatibility
my %foreign = map{ $_ => undef } qw(
    Mouse Mouse::Role Mouse::Util Mouse::Util::TypeConstraints
    Carp Scalar::Util
);
sub _code_is_mine{
    my($self, $code) = @_;

    my $package = get_code_package($code);

    return !exists $foreign{$package};
}

sub has_method {
    my($self, $method_name) = @_;

    return 1 if $self->{methods}->{$method_name};

    my $code = do{ no strict 'refs'; *{$self->{package} . '::' . $method_name}{CODE} };

    return $code && $self->_code_is_mine($code);
}

sub get_method{
    my($self, $method_name) = @_;

    if($self->has_method($method_name)){
        my $method_metaclass = $self->method_metaclass;
        load_class($method_metaclass);

        my $package = $self->name;
        return $method_metaclass->new(
            body    => $package->can($method_name),
            name    => $method_name,
            package => $package,
        );
    }

    return undef;
}

sub get_method_list {
    my($self) = @_;

    return grep { $self->has_method($_) } keys %{ $self->namespace };
}

{
    my $ANON_SERIAL = 0;
    my $ANON_PREFIX = 'Mouse::Meta::Module::__ANON__::';

    my %IMMORTALS;

    sub create {
        my ($class, $package_name, %options) = @_;

        $class->throw_error('You must pass a package name') if @_ == 1;


        if(exists $options{superclasses}){
            if($class->isa('Mouse::Meta::Class')){
                (ref $options{superclasses} eq 'ARRAY')
                    || $class->throw_error("You must pass an ARRAY ref of superclasses");
            }
            else{ # role
                delete $options{superclasses};
            }
        }

        my $attributes;
        if(exists $options{attributes}){
            $attributes = delete $options{attributes};
           (ref $attributes eq 'ARRAY' || ref $attributes eq 'HASH')
               || $class->throw_error("You must pass an ARRAY ref of attributes")
           }

        (ref $options{methods} eq 'HASH')
            || $class->throw_error("You must pass a HASH ref of methods")
                if exists $options{methods};

        (ref $options{roles} eq 'ARRAY')
            || $class->throw_error("You must pass an ARRAY ref of roles")
                if exists $options{roles};


        my @extra_options;
        my $mortal;
        my $cache_key;

        if(!defined $package_name){ # anonymous
            $mortal = !$options{cache};

            # anonymous but immortal
            if(!$mortal){
                    # something like Super::Class|Super::Class::2=Role|Role::1
                    $cache_key = join '=' => (
                        join('|',      @{$options{superclasses} || []}),
                        join('|', sort @{$options{roles}        || []}),
                    );
                    return $IMMORTALS{$cache_key} if exists $IMMORTALS{$cache_key};
            }
            $package_name = $ANON_PREFIX . ++$ANON_SERIAL;

            push @extra_options, (anon_serial_id => $ANON_SERIAL);
        }

        # instantiate a module
        {
            no strict 'refs';
            ${ $package_name . '::VERSION'   } = delete $options{version}   if exists $options{version};
            ${ $package_name . '::AUTHORITY' } = delete $options{authority} if exists $options{authority};
        }

        my %initialize_options = %options;
        delete @initialize_options{qw(
            package
            superclasses
            attributes
            methods
            roles
        )};
        my $meta = $class->initialize( $package_name, %initialize_options, @extra_options);

        weaken $METAS{$package_name}
            if $mortal;

        # FIXME totally lame
        $meta->add_method('meta' => sub {
            $class->initialize(ref($_[0]) || $_[0]);
        });

        $meta->superclasses(@{$options{superclasses}})
            if exists $options{superclasses};

        # NOTE:
        # process attributes first, so that they can
        # install accessors, but locally defined methods
        # can then overwrite them. It is maybe a little odd, but
        # I think this should be the order of things.
        if (defined $attributes) {
            if(ref($attributes) eq 'ARRAY'){
                foreach my $attr (@{$attributes}) {
                    $meta->add_attribute($attr->{name} => $attr);
                }
            }
            else{
                while(my($name, $attr) = each %{$attributes}){
                    $meta->add_attribute($name => $attr);
                }
            }
        }
        if (exists $options{methods}) {
            foreach my $method_name (keys %{$options{methods}}) {
                $meta->add_method($method_name, $options{methods}->{$method_name});
            }
        }
        if (exists $options{roles}){
            Mouse::Util::apply_all_roles($package_name, @{$options{roles}});
        }

        if(!$mortal && exists $meta->{anon_serial_id}){
            $IMMORTALS{$cache_key} = $meta;
        }

        return $meta;
    }

    sub DESTROY{
        my($self) = @_;

        my $serial_id = $self->{anon_serial_id};

        return if !$serial_id;

        my $stash = $self->namespace;

        @{$self->{superclasses}} = () if exists $self->{superclasses};
        %{$stash} = ();
        delete $METAS{$self->name};

        no strict 'refs';
        delete ${$ANON_PREFIX}{ $serial_id . '::' };

        return;
    }
}

sub throw_error{
    my($class, $message, %args) = @_;

    local $Carp::CarpLevel  = $Carp::CarpLevel + 1 + ($args{depth} || 0);
    local $Carp::MaxArgNums = 20; # default is 8, usually we use named args which gets messier though

    if(exists $args{longmess} && !$args{longmess}){ # intentionaly longmess => 0
        Carp::croak($message);
    }
    else{
        Carp::confess($message);
    }
}

package Mouse::Meta::Role;
use strict;
use warnings;

BEGIN { Mouse::Util->import(qw(:meta not_supported english_list get_code_info)) }
our @ISA = qw(Mouse::Meta::Module);

sub method_metaclass(){ 'Mouse::Meta::Role::Method' } # required for get_method()

sub _construct_meta {
    my $class = shift;

    my %args  = @_;

    $args{methods}          ||= {};
    $args{attributes}       ||= {};
    $args{required_methods} ||= [];
    $args{roles}            ||= [];

#    return Mouse::Meta::Class->initialize($class)->new_object(%args)
#        if $class ne __PACKAGE__;

    return bless \%args, ref($class) || $class;
}

sub create_anon_role{
    my $self = shift;
    return $self->create(undef, @_);
}

sub is_anon_role{
    return exists $_[0]->{anon_serial_id};
}

sub get_roles { $_[0]->{roles} }

sub get_required_method_list{
    return @{ $_[0]->{required_methods} };
}

sub add_required_methods {
    my($self, @methods) = @_;
    push @{$self->{required_methods}}, @methods;
}

sub requires_method {
    my($self, $name) = @_;
    return scalar( grep{ $_ eq $name } @{ $self->{required_methods} } ) != 0;
}

sub add_attribute {
    my $self = shift;
    my $name = shift;

    $self->{attributes}->{$name} = (@_ == 1) ? $_[0] : { @_ };
}

sub _canonicalize_apply_args{
    my($self, $applicant, %args) = @_;

    if($applicant->isa('Mouse::Meta::Class')){
        $args{_to} = 'class';
    }
    elsif($applicant->isa('Mouse::Meta::Role')){
        $args{_to} = 'role';
    }
    else{
        $args{_to} = 'instance';

        not_supported 'Application::ToInstance';
    }

    if($args{alias} && !exists $args{-alias}){
        $args{-alias} = $args{alias};
    }
    if($args{excludes} && !exists $args{-excludes}){
        $args{-excludes} = $args{excludes};
    }

    if(my $excludes = $args{-excludes}){
        $args{-excludes} = {}; # replace with a hash ref
        if(ref $excludes){
            %{$args{-excludes}} = (map{ $_ => undef } @{$excludes});
        }
        else{
            $args{-excludes}{$excludes} = undef;
        }
    }

    return \%args;
}

sub _check_required_methods{
    my($role, $class, $args, @other_roles) = @_;

    if($args->{_to} eq 'class'){
        my $class_name = $class->name;
        my $role_name  = $role->name;
        my @missing;
        foreach my $method_name(@{$role->{required_methods}}){
            if(!$class_name->can($method_name)){
                my $has_method      = 0;

                foreach my $another_role_spec(@other_roles){
                    my $another_role_name = $another_role_spec->[0];
                    if($role_name ne $another_role_name && $another_role_name->can($method_name)){
                        $has_method = 1;
                        last;
                    }
                }

                push @missing, $method_name if !$has_method;
            }
        }
        if(@missing){
            $class->throw_error("'$role_name' requires the "
                . (@missing == 1 ? 'method' : 'methods')
                . " "
                . english_list(map{ sprintf q{'%s'}, $_ } @missing)
                . " to be implemented by '$class_name'");
        }
    }
    elsif($args->{_to} eq 'role'){
        # apply role($role) to role($class)
        foreach my $method_name($role->get_required_method_list){
            next if $class->has_method($method_name); # already has it
            $class->add_required_methods($method_name);
        }
    }

    return;
}

sub _apply_methods{
    my($role, $class, $args) = @_;

    my $role_name  = $role->name;
    my $class_name = $class->name;

    my $alias    = $args->{-alias};
    my $excludes = $args->{-excludes};

    foreach my $method_name($role->get_method_list){
        next if $method_name eq 'meta';

        my $code = $role_name->can($method_name);

        if(!exists $excludes->{$method_name}){
            if(!$class->has_method($method_name)){
                $class->add_method($method_name => $code);
            }
        }

        if($alias && $alias->{$method_name}){
            my $dstname = $alias->{$method_name};

            my $dstcode = do{ no strict 'refs'; *{$class_name . '::' . $dstname}{CODE} };

            if(defined($dstcode) && $dstcode != $code){
                $class->throw_error("Cannot create a method alias if a local method of the same name exists");
            }
            else{
                $class->add_method($dstname => $code);
            }
        }
    }

    return;
}

sub _apply_attributes{
    my($role, $class, $args) = @_;

    if ($args->{_to} eq 'class') {
        # apply role to class
        for my $attr_name ($role->get_attribute_list) {
            next if $class->has_attribute($attr_name);

            my $spec = $role->get_attribute($attr_name);

            $class->add_attribute($attr_name => %{$spec});
        }
    }
    elsif($args->{_to} eq 'role'){
        # apply role to role
        for my $attr_name ($role->get_attribute_list) {
            next if $class->has_attribute($attr_name);

            my $spec = $role->get_attribute($attr_name);
            $class->add_attribute($attr_name => $spec);
        }
    }

    return;
}

sub _apply_modifiers{
    my($role, $class, $args) = @_;

    for my $modifier_type (qw/override before around after/) {
        my $add_modifier = "add_${modifier_type}_method_modifier";
        my $modifiers    = $role->{"${modifier_type}_method_modifiers"};

        while(my($method_name, $modifier_codes) = each %{$modifiers}){
            foreach my $code(ref($modifier_codes) eq 'ARRAY' ? @{$modifier_codes} : $modifier_codes){
                $class->$add_modifier($method_name => $code);
            }
        }
    }
    return;
}

sub _append_roles{
    my($role, $class, $args) = @_;

    my $roles = ($args->{_to} eq 'class') ? $class->roles : $class->get_roles;

    foreach my $r($role, @{$role->get_roles}){
        if(!$class->does_role($r->name)){
            push @{$roles}, $r;
        }
    }
    return;
}

# Moose uses Application::ToInstance, Application::ToClass, Application::ToRole
sub apply {
    my $self      = shift;
    my $applicant = shift;

    my $args = $self->_canonicalize_apply_args($applicant, @_);

    $self->_check_required_methods($applicant, $args);
    $self->_apply_methods($applicant, $args);
    $self->_apply_attributes($applicant, $args);
    $self->_apply_modifiers($applicant, $args);
    $self->_append_roles($applicant, $args);
    return;
}

sub combine_apply {
    my(undef, $class, @roles) = @_;

    if($class->isa('Mouse::Object')){
        not_supported 'Application::ToInstance';
    }

    # check conflicting
    my %method_provided;
    my @method_conflicts;
    my %attr_provided;
    my %override_provided;

    foreach my $role_spec (@roles) {
        my $role      = $role_spec->[0]->meta;
        my $role_name = $role->name;

        # methods
        foreach my $method_name($role->get_method_list){
            next if $class->has_method($method_name); # manually resolved

            my $code = do{ no strict 'refs'; \&{ $role_name . '::' . $method_name } };

            my $c = $method_provided{$method_name};

            if($c && $c->[0] != $code){
                push @{$c}, $role;
                push @method_conflicts, $c;
            }
            else{
                $method_provided{$method_name} = [$code, $method_name, $role];
            }
        }

        # attributes
        foreach my $attr_name($role->get_attribute_list){
            my $attr = $role->get_attribute($attr_name);
            my $c    = $attr_provided{$attr_name};
            if($c && $c != $attr){
                $class->throw_error("We have encountered an attribute conflict with '$attr_name' "
                                   . "during composition. This is fatal error and cannot be disambiguated.")
            }
            else{
                $attr_provided{$attr_name} = $attr;
            }
        }

        # override modifiers
        foreach my $method_name($role->get_method_modifier_list('override')){
            my $override = $role->get_override_method_modifier($method_name);
            my $c        = $override_provided{$method_name};
            if($c && $c != $override){
                $class->throw_error( "We have encountered an 'override' method conflict with '$method_name' during "
                                   . "composition (Two 'override' methods of the same name encountered). "
                                   . "This is fatal error.")
            }
            else{
                $override_provided{$method_name} = $override;
            }
        }
    }
    if(@method_conflicts){
        my $error;

        if(@method_conflicts == 1){
            my($code, $method_name, @roles) = @{$method_conflicts[0]};
            $class->throw_error(
                sprintf q{Due to a method name conflict in roles %s, the method '%s' must be implemented or excluded by '%s'},
                    english_list(map{ sprintf q{'%s'}, $_->name } @roles), $method_name, $class->name
            );
        }
        else{
            @method_conflicts = sort { $a->[0] cmp $b->[0] } @method_conflicts; # to avoid hash-ordering bugs
            my $methods = english_list(map{ sprintf q{'%s'}, $_->[1] } @method_conflicts);
            my $roles   = english_list(
                map{ sprintf q{'%s'}, $_->name }
                map{ my($code, $method_name, @roles) = @{$_}; @roles } @method_conflicts
            );

            $class->throw_error(
                sprintf q{Due to method name conflicts in roles %s, the methods %s must be implemented or excluded by '%s'},
                    $roles, $methods, $class->name
            );
        }
    }

    foreach my $role_spec (@roles) {
        my($role_name, $args) = @{$role_spec};

        my $role = $role_name->meta;

        $args = $role->_canonicalize_apply_args($class, %{$args});

        $role->_check_required_methods($class, $args, @roles);
        $role->_apply_methods($class, $args);
        $role->_apply_attributes($class, $args);
        $role->_apply_modifiers($class, $args);
        $role->_append_roles($class, $args);
    }
    return;
}

for my $modifier_type (qw/before after around/) {

    my $modifier = "${modifier_type}_method_modifiers";
    my $add_method_modifier =  sub {
        my ($self, $method_name, $method) = @_;

        push @{ $self->{$modifier}->{$method_name} ||= [] }, $method;
        return;
    };
    my $has_method_modifiers = sub{
        my($self, $method_name) = @_;
        my $m = $self->{$modifier}->{$method_name};
        return $m && @{$m} != 0;
    };
    my $get_method_modifiers = sub {
        my ($self, $method_name) = @_;
        return @{ $self->{$modifier}->{$method_name} ||= [] }
    };

    no strict 'refs';
    *{ 'add_' . $modifier_type . '_method_modifier'  } = $add_method_modifier;
    *{ 'has_' . $modifier_type . '_method_modifiers' } = $has_method_modifiers;
    *{ 'get_' . $modifier_type . '_method_modifiers' } = $get_method_modifiers;
}

sub add_override_method_modifier{
    my($self, $method_name, $method) = @_;

    if($self->has_method($method_name)){
        # This error happens in the override keyword or during role composition,
        # so I added a message, "A local method of ...", only for compatibility (gfx)
        $self->throw_error("Cannot add an override of method '$method_name' "
                   . "because there is a local version of '$method_name'"
                   . "(A local method of the same name as been found)");
    }

    $self->{override_method_modifiers}->{$method_name} = $method;
}

sub has_override_method_modifier {
    my ($self, $method_name) = @_;
    return exists $self->{override_method_modifiers}->{$method_name};
}

sub get_override_method_modifier {
    my ($self, $method_name) = @_;
    return $self->{override_method_modifiers}->{$method_name};
}

sub get_method_modifier_list {
    my($self, $modifier_type) = @_;

    return keys %{ $self->{$modifier_type . '_method_modifiers'} };
}

# This is currently not passing all the Moose tests.
sub does_role {
    my ($self, $role_name) = @_;

    (defined $role_name)
        || $self->throw_error("You must supply a role name to look for");

    # if we are it,.. then return true
    return 1 if $role_name eq $self->name;
    # otherwise.. check our children
    for my $role (@{ $self->get_roles }) {
        return 1 if $role->does_role($role_name);
    }
    return 0;
}


package Mouse::Meta::Role::Method;
use strict;
use warnings;

our @ISA = qw(Mouse::Meta::Method);

package Mouse::Meta::TypeConstraint;
use strict;
use warnings;

use overload
    '""'     => sub { shift->{name} },   # stringify to tc name
    fallback => 1;

use Carp qw(confess);
use Scalar::Util qw(blessed reftype);

BEGIN { Mouse::Util->import(qw(:meta)) }

my $null_check = sub { 1 };

sub new {
    my($class, %args) = @_;

    $args{name} = '__ANON__' if !defined $args{name};

    my $check = delete $args{optimized};

    if($args{_compiled_type_constraint}){
        Carp::cluck("'_compiled_type_constraint' has been deprecated, use 'optimized' instead");
        $check = $args{_compiled_type_constraint};

        if(blessed($check)){
            Carp::cluck("Constraint must be a CODE reference");
            $check = $check->{compiled_type_constraint};
        }
    }

    if($check){
        $args{hand_optimized_type_constraint} = $check;
        $args{compiled_type_constraint}       = $check;
    }

    $check = $args{constraint};

    if(blessed($check)){
        Carp::cluck("Constraint for $args{name} must be a CODE reference");
        $check = $check->{compiled_type_constraint};
    }

    if(defined($check) && ref($check) ne 'CODE'){
        confess("Constraint for $args{name} is not a CODE reference");
    }

    $args{package_defined_in} ||= caller;

    my $self = bless \%args, $class;
    $self->compile_type_constraint() if !$self->{hand_optimized_type_constraint};

    if($self->{type_constraints}){ # Union
        my @coercions;
        foreach my $type(@{$self->{type_constraints}}){
            if($type->has_coercion){
                push @coercions, $type;
            }
        }
        if(@coercions){
            $self->{_compiled_type_coercion} = sub {
                my($thing) = @_;
                foreach my $type(@coercions){
                    my $value = $type->coerce($thing);
                    return $value if $self->check($value);
                }
                return $thing;
            };
        }
    }

    return $self;
}

sub create_child_type{
    my $self = shift;
    # XXX: FIXME
    return ref($self)->new(
        # a child inherits its parent's attributes
        %{$self},

        # but does not inherit 'compiled_type_constraint' and 'hand_optimized_type_constraint'
        compiled_type_constraint       => undef,
        hand_optimized_type_constraint => undef,

        # and is given child-specific args, of course.
        @_,

        # and its parent
        parent => $self,
   );
}

sub name    { $_[0]->{name}    }
sub parent  { $_[0]->{parent}  }
sub message { $_[0]->{message} }

sub _compiled_type_constraint{ $_[0]->{compiled_type_constraint} }

sub has_coercion{ exists $_[0]->{_compiled_type_coercion} }

sub compile_type_constraint{
    my($self) = @_;

    # add parents first
    my @checks;
    for(my $parent = $self->parent; defined $parent; $parent = $parent->parent){
         if($parent->{hand_optimized_type_constraint}){
            push @checks, $parent->{hand_optimized_type_constraint};
            last; # a hand optimized constraint must include all the parents
        }
        elsif($parent->{constraint}){
            push @checks, $parent->{constraint};
        }
    }

    # then add child
    if($self->{constraint}){
        push @checks, $self->{constraint};
    }

    if($self->{type_constraints}){ # Union
        my @types = map{ $_->_compiled_type_constraint } @{ $self->{type_constraints} };
        push @checks, sub{
            foreach my $c(@types){
                return 1 if $c->($_[0]);
            }
            return 0;
        };
    }

    if(@checks == 0){
        $self->{compiled_type_constraint} = $null_check;
    }
    elsif(@checks == 1){
        my $c = $checks[0];
        $self->{compiled_type_constraint} = sub{
            my(@args) = @_;
            local $_ = $args[0];
            return $c->(@args);
        };
    }
    else{
        $self->{compiled_type_constraint} =  sub{
            my(@args) = @_;
            local $_ = $args[0];
            foreach my $c(@checks){
                return undef if !$c->(@args);
            }
            return 1;
        };
    }
    return;
}

sub _add_type_coercions{
    my $self = shift;

    my $coercions = ($self->{_coercion_map} ||= []);
    my %has       = map{ $_->[0] => undef } @{$coercions};

    for(my $i = 0; $i < @_; $i++){
        my $from   = $_[  $i];
        my $action = $_[++$i];

        if(exists $has{$from}){
            confess("A coercion action already exists for '$from'");
        }

        my $type = Mouse::Util::TypeConstraints::find_or_parse_type_constraint($from)
            or confess("Could not find the type constraint ($from) to coerce from");

        push @{$coercions}, [ $type => $action ];
    }

    # compile
    if(exists $self->{type_constraints}){ # union type
        confess("Cannot add additional type coercions to Union types");
    }
    else{
        $self->{_compiled_type_coercion} = sub {
           my($thing) = @_;
           foreach my $pair (@{$coercions}) {
                #my ($constraint, $converter) = @$pair;
                if ($pair->[0]->check($thing)) {
                  local $_ = $thing;
                  return $pair->[1]->($thing);
                }
           }
           return $thing;
        };
    }
    return;
}

sub check {
    my $self = shift;
    return $self->_compiled_type_constraint->(@_);
}

sub coerce {
    my $self = shift;
    if(!$self->{_compiled_type_coercion}){
        confess("Cannot coerce without a type coercion ($self)");
    }

    return $_[0] if $self->_compiled_type_constraint->(@_);

    return $self->{_compiled_type_coercion}->(@_);
}

sub get_message {
    my ($self, $value) = @_;
    if ( my $msg = $self->message ) {
        local $_ = $value;
        return $msg->($value);
    }
    else {
        $value = ( defined $value ? overload::StrVal($value) : 'undef' );
        return "Validation failed for '$self' failed with value $value";
    }
}

sub is_a_type_of{
    my($self, $other) = @_;

    # ->is_a_type_of('__ANON__') is always false
    return 0 if !blessed($other) && $other eq '__ANON__';

    (my $other_name = $other) =~ s/\s+//g;

    return 1 if $self->name eq $other_name;

    if(exists $self->{type_constraints}){ # union
        foreach my $type(@{$self->{type_constraints}}){
            return 1 if $type->name eq $other_name;
        }
    }

    for(my $parent = $self->parent; defined $parent; $parent = $parent->parent){
        return 1 if $parent->name eq $other_name;
    }

    return 0;
}


package Mouse::Object;
use strict;
use warnings;

BEGIN { Mouse::Util->import(qw(does dump)) }

sub new {
    my $class = shift;

    $class->throw_error('Cannot call new() on an instance') if ref $class;

    my $args = $class->BUILDARGS(@_);

    my $instance = Mouse::Meta::Class->initialize($class)->new_object($args);
    $instance->BUILDALL($args);
    return $instance;
}

sub BUILDARGS {
    my $class = shift;

    if (scalar @_ == 1) {
        (ref($_[0]) eq 'HASH')
            || $class->meta->throw_error("Single parameters to new() must be a HASH ref");

        return {%{$_[0]}};
    }
    else {
        return {@_};
    }
}

sub DESTROY {
    my $self = shift;

    $self->DEMOLISHALL();
}

sub BUILDALL {
    my $self = shift;

    # short circuit
    return unless $self->can('BUILD');

    for my $class (reverse $self->meta->linearized_isa) {
        my $build = do{ no strict 'refs'; *{ $class . '::BUILD' }{CODE} }
            or next;

        $self->$build(@_);
    }
    return;
}

sub DEMOLISHALL {
    my $self = shift;

    # short circuit
    return unless $self->can('DEMOLISH');

    # We cannot count on being able to retrieve a previously made
    # metaclass, _or_ being able to make a new one during global
    # destruction. However, we should still be able to use mro at
    # that time (at least tests suggest so ;)

    foreach my $class (@{ Mouse::Util::get_linear_isa(ref $self) }) {
        my $demolish = do{ no strict 'refs'; *{ $class . '::DEMOLISH'}{CODE} }
            or next;

        $self->$demolish();
    }
    return;
}

package Mouse::Role;
use strict;
use warnings;

use Exporter;

use Carp 'confess';
use Scalar::Util 'blessed';

BEGIN { Mouse::Util->import(qw(load_class get_code_package not_supported)) }
BEGIN { Mouse->import(()) }

our @ISA = qw(Exporter);

our @EXPORT = qw(
    extends with
    has
    before after around
    override super
    augment  inner

    requires excludes

    blessed confess
);

our %is_removable = map{ $_ => undef } @EXPORT;
delete $is_removable{confess};
delete $is_removable{blessed};

sub before {
    my $meta = Mouse::Meta::Role->initialize(scalar caller);

    my $code = pop;
    for (@_) {
        $meta->add_before_method_modifier($_ => $code);
    }
}

sub after {
    my $meta = Mouse::Meta::Role->initialize(scalar caller);

    my $code = pop;
    for (@_) {
        $meta->add_after_method_modifier($_ => $code);
    }
}

sub around {
    my $meta = Mouse::Meta::Role->initialize(scalar caller);

    my $code = pop;
    for (@_) {
        $meta->add_around_method_modifier($_ => $code);
    }
}


sub super {
    return unless $Mouse::SUPER_BODY; 
    $Mouse::SUPER_BODY->(@Mouse::SUPER_ARGS);
}

sub override {
    my $classname = caller;
    my $meta = Mouse::Meta::Role->initialize($classname);

    my $name = shift;
    my $code = shift;
    my $fullname = "${classname}::${name}";

    defined &$fullname
        && $meta->throw_error("Cannot add an override of method '$fullname' "
                            . "because there is a local version of '$fullname'");

    $meta->add_override_method_modifier($name => sub {
        local $Mouse::SUPER_PACKAGE = shift;
        local $Mouse::SUPER_BODY = shift;
        local @Mouse::SUPER_ARGS = @_;

        $code->(@_);
    });
}

# We keep the same errors messages as Moose::Role emits, here.
sub inner {
    Carp::croak "Roles cannot support 'inner'";
}

sub augment {
    Carp::croak "Roles cannot support 'augment'";
}

sub has {
    my $meta = Mouse::Meta::Role->initialize(scalar caller);
    my $name = shift;

    $meta->add_attribute($_ => @_) for ref($name) ? @{$name} : $name;
}

sub extends  {
    Carp::croak "Roles do not support 'extends'"
}

sub with     {
    my $meta = Mouse::Meta::Role->initialize(scalar caller);
    Mouse::Util::apply_all_roles($meta->name, @_);
}

sub requires {
    my $meta = Mouse::Meta::Role->initialize(scalar caller);
    $meta->throw_error("Must specify at least one method") unless @_;
    $meta->add_required_methods(@_);
}

sub excludes {
    not_supported;
}

sub import {
    my $class = shift;

    strict->import;
    warnings->import;

    my $caller = caller;

    # we should never export to main
    if ($caller eq 'main') {
        warn qq{$class does not export its sugar to the 'main' package.\n};
        return;
    }

    Mouse::Meta::Role->initialize($caller)->add_method(meta => sub {
        return Mouse::Meta::Role->initialize(ref($_[0]) || $_[0]);
    });

    Mouse::Role->export_to_level(1, @_);
}

sub unimport {
    my $caller = caller;

    my $stash = do{
        no strict 'refs';
        \%{$caller . '::'}
    };

    for my $keyword (@EXPORT) {
        my $code;
        if(exists $is_removable{$keyword}
            && ($code = $caller->can($keyword))
            && get_code_package($code) eq __PACKAGE__){

            delete $stash->{$keyword};
        }
    }
    return;
}

package Mouse::Spec;
use strict;
use warnings;

our $VERSION = '0.37_01';

our $MouseVersion = $VERSION;
our $MooseVersion = '0.90';

sub MouseVersion{ $MouseVersion }
sub MooseVersion{ $MooseVersion }

package Mouse::TypeRegistry;
sub import {
    warn "Mouse::TypeRegistry is deprecated, please use Mouse::Util::TypeConstraints instead.";

    shift @_;
    unshift @_, 'Mouse::Util::TypeConstraints';
    goto \&Mouse::Util::TypeConstraints::import;
}

sub unimport {
    warn "Mouse::TypeRegistry is deprecated, please use Mouse::Util::TypeConstraints instead.";

    shift @_;
    unshift @_, 'Mouse::Util::TypeConstraints';
    goto \&Mouse::Util::TypeConstraints::unimport;
}

package Mouse::Util::TypeConstraints;
use strict;
use warnings;

use Exporter;

use Carp qw(confess);
use Scalar::Util qw/blessed looks_like_number openhandle/;

BEGIN { Mouse::Util->import(qw(does_role not_supported)) }
our @ISA    = qw(Exporter);
our @EXPORT = qw(
    as where message from via type subtype coerce class_type role_type enum
    find_type_constraint
);

my %TYPE;
my %COERCE;
my %COERCE_KEYS;

sub as ($) {
    return(as => $_[0]);
}
sub where (&) {
    return(where => $_[0])
}
sub message (&) {
    return(message => $_[0])
}

sub from    { @_ }
sub via (&) { $_[0] }

BEGIN {
    my %builtins = (
        Any        => undef, # null check
        Item       => undef, # null check
        Maybe      => undef, # null check

        Bool       => sub { $_[0] ? $_[0] eq '1' : 1 },
        Undef      => sub { !defined($_[0]) },
        Defined    => sub { defined($_[0]) },
        Value      => sub { defined($_[0]) && !ref($_[0]) },
        Num        => sub { !ref($_[0]) && looks_like_number($_[0]) },
        Int        => sub { defined($_[0]) && !ref($_[0]) && $_[0] =~ /^-?[0-9]+$/ },
        Str        => sub { defined($_[0]) && !ref($_[0]) },
        Ref        => sub { ref($_[0]) },

        ScalarRef  => sub { ref($_[0]) eq 'SCALAR' },
        ArrayRef   => sub { ref($_[0]) eq 'ARRAY'  },
        HashRef    => sub { ref($_[0]) eq 'HASH'   },
        CodeRef    => sub { ref($_[0]) eq 'CODE'   },
        RegexpRef  => sub { ref($_[0]) eq 'Regexp' },
        GlobRef    => sub { ref($_[0]) eq 'GLOB'   },

        FileHandle => sub {
            ref($_[0]) eq 'GLOB' && openhandle($_[0])
            or
            blessed($_[0]) && $_[0]->isa("IO::Handle")
        },

        Object     => sub { blessed($_[0]) && blessed($_[0]) ne 'Regexp' },

        ClassName  => sub { Mouse::Util::is_class_loaded($_[0]) },
        RoleName   => sub { (Mouse::Util::find_meta($_[0]) || return 0)->isa('Mouse::Meta::Role') },
    );

    while (my ($name, $code) = each %builtins) {
        $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
            name      => $name,
            optimized => $code,
        );
    }

    sub optimized_constraints {
        Carp::cluck('optimized_constraints() has been deprecated');
        return \%TYPE;
    }

    my @builtins = keys %TYPE;
    sub list_all_builtin_type_constraints { @builtins }

    sub list_all_type_constraints         { keys %TYPE }
}

sub _create_type{
    my $mode = shift;

    my $name;
    my %args;

    if(@_ == 1 && ref $_[0]){   # @_ : { name => $name, where => ... }
        %args = %{$_[0]};
    }
    elsif(@_ == 2 && ref $_[1]){ # @_ : $name => { where => ... }
        $name = $_[0];
        %args = %{$_[1]};
    }
    elsif(@_ % 2){               # @_ : $name => ( where => ... )
        ($name, %args) = @_;
    }
    else{                        # @_ : (name => $name, where => ...)
        %args = @_;
    }

    if(!defined $name){
        if(!defined($name = $args{name})){
            $name = '__ANON__';
        }
    }

    $args{name} = $name;

    my $package_defined_in = $args{package_defined_in} ||= caller(1);

    my $existing = $TYPE{$name};
    if($existing && $existing->{package_defined_in} ne $package_defined_in){
        confess("The type constraint '$name' has already been created in "
              . "$existing->{package_defined_in} and cannot be created again in $package_defined_in");
    }

    $args{constraint} = delete($args{where})       if exists $args{where};
    $args{optimized}  = delete $args{optimized_as} if exists $args{optimized_as};

    my $constraint;
    if($mode eq 'subtype'){
        my $parent = delete($args{as})
            or confess('A subtype cannot consist solely of a name, it must have a parent');

        $constraint = find_or_create_isa_type_constraint($parent)->create_child_type(%args);
    }
    else{
        $constraint = Mouse::Meta::TypeConstraint->new(%args);
    }

    return $TYPE{$name} = $constraint;
}

sub type {
    return _create_type('type', @_);
}

sub subtype {
    return _create_type('subtype', @_);
}

sub coerce {
    my $type_name = shift;

    my $type = find_type_constraint($type_name)
        or confess("Cannot find type '$type_name', perhaps you forgot to load it.");

    $type->_add_type_coercions(@_);
    return;
}

sub class_type {
    my($name, $conf) = @_;
    if ($conf && $conf->{class}) {
        # No, you're using this wrong
        warn "class_type() should be class_type(ClassName). Perhaps you're looking for subtype $name => as '$conf->{class}'?";
        _create_type 'type', $name => (
            as   => $conf->{class},

            type => 'Class',
       );
    }
    else {
        _create_type 'type', $name => (
            optimized_as => sub { blessed($_[0]) && $_[0]->isa($name) },

            type => 'Class',
        );
    }
}

sub role_type {
    my($name, $conf) = @_;
    my $role = ($conf && $conf->{role}) ? $conf->{role} : $name;
    _create_type 'type', $name => (
        optimized_as => sub { blessed($_[0]) && does_role($_[0], $role) },

        type => 'Role',
    );
}

sub typecast_constraints {
    my($class, $pkg, $type, $value) = @_;
    Carp::croak("wrong arguments count") unless @_ == 4;

    Carp::cluck("typecast_constraints() has been deprecated, which was an internal utility anyway");

    return $type->coerce($value);
}

sub enum {
    my($name, %valid);

    # enum ['small', 'medium', 'large']
    if (ref($_[0]) eq 'ARRAY') {
        %valid = map{ $_ => undef } @{ $_[0] };
        $name  = sprintf '(%s)', join '|', sort @{$_[0]};
    }
    # enum size => 'small', 'medium', 'large'
    else{
        $name  = shift;
        %valid = map{ $_ => undef } @_;
    }
    return _create_type 'type', $name => (
        optimized_as  => sub{ defined($_[0]) && !ref($_[0]) && exists $valid{$_[0]} },

        type => 'Enum',
    );
}

sub _find_or_create_regular_type{
    my($spec)  = @_;

    return $TYPE{$spec} if exists $TYPE{$spec};

    my $meta  = Mouse::Util::get_metaclass_by_name($spec);

    if(!$meta){
        return;
    }

    my $check;
    my $type;
    if($meta->isa('Mouse::Meta::Role')){
        $check = sub{
            return blessed($_[0]) && $_[0]->does($spec);
        };
        $type = 'Role';
    }
    else{
        $check = sub{
            return blessed($_[0]) && $_[0]->isa($spec);
        };
        $type = 'Class';
    }

    return $TYPE{$spec} = Mouse::Meta::TypeConstraint->new(
        name      => $spec,
        optimized => $check,

        type      => $type,
    );
}

$TYPE{ArrayRef}{constraint_generator} = sub {
    my($type_parameter) = @_;
    my $check = $type_parameter->_compiled_type_constraint;

    return sub{
        foreach my $value (@{$_}) {
            return undef unless $check->($value);
        }
        return 1;
    }
};
$TYPE{HashRef}{constraint_generator} = sub {
    my($type_parameter) = @_;
    my $check = $type_parameter->_compiled_type_constraint;

    return sub{
        foreach my $value(values %{$_}){
            return undef unless $check->($value);
        }
        return 1;
    };
};

# 'Maybe' type accepts 'Any', so it requires parameters
$TYPE{Maybe}{constraint_generator} = sub {
    my($type_parameter) = @_;
    my $check = $type_parameter->_compiled_type_constraint;

    return sub{
        return !defined($_) || $check->($_);
    };
};

sub _find_or_create_parameterized_type{
    my($base, $param) = @_;

    my $name = sprintf '%s[%s]', $base->name, $param->name;

    $TYPE{$name} ||= do{
        my $generator = $base->{constraint_generator};

        if(!$generator){
            confess("The $name constraint cannot be used, because $param doesn't subtype from a parameterizable type");
        }

        Mouse::Meta::TypeConstraint->new(
            name               => $name,
            parent             => $base,
            constraint         => $generator->($param),

            type               => 'Parameterized',
        );
    }
}
sub _find_or_create_union_type{
    my @types = map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_;

    my $name = join '|', map{ $_->name } @types;

    $TYPE{$name} ||= do{
        return Mouse::Meta::TypeConstraint->new(
            name              => $name,
            type_constraints  => \@types,

            type              => 'Union',
        );
    };
}

# The type parser
sub _parse_type{
    my($spec, $start) = @_;

    my @list;
    my $subtype;

    my $len = length $spec;
    my $i;

    for($i = $start; $i < $len; $i++){
        my $char = substr($spec, $i, 1);

        if($char eq '['){
            my $base = _find_or_create_regular_type( substr($spec, $start, $i - $start) )
                or return;

            ($i, $subtype) = _parse_type($spec, $i+1)
                or return;
            $start = $i+1; # reset

            push @list, _find_or_create_parameterized_type($base => $subtype);
        }
        elsif($char eq ']'){
            $len = $i+1;
            last;
        }
        elsif($char eq '|'){
            my $type = _find_or_create_regular_type( substr($spec, $start, $i - $start) );

            if(!defined $type){
                # XXX: Mouse creates a new class type, but Moose does not.
                $type = class_type( substr($spec, $start, $i - $start) );
            }

            push @list, $type;

            ($i, $subtype) = _parse_type($spec, $i+1)
                or return;

            $start = $i+1; # reset

            push @list, $subtype;
        }
    }
    if($i - $start){
        push @list, _find_or_create_regular_type(substr $spec, $start, $i - $start);
    }

    if(@list == 0){
       return;
    }
    elsif(@list == 1){
        return ($len, $list[0]);
    }
    else{
        return ($len, _find_or_create_union_type(@list));
    }
}


sub find_type_constraint {
    my($spec) = @_;
    return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint');

    $spec =~ s/\s+//g;
    return $TYPE{$spec};
}

sub find_or_parse_type_constraint {
    my($spec) = @_;
    return $spec if blessed($spec) && $spec->isa('Mouse::Meta::TypeConstraint');

    $spec =~ s/\s+//g;
    return $TYPE{$spec} || do{
        my($pos, $type) = _parse_type($spec, 0);
        $type;
    };
}

sub find_or_create_does_type_constraint{
    my $type = find_or_parse_type_constriant(@_) || role_type(@_);

    if($type->{type} && $type->{type} ne 'Role'){
        Carp::cluck("$type is not a role type");
    }
    return $type;
}

sub find_or_create_isa_type_constraint {
    return find_or_parse_type_constraint(@_) || class_type(@_);
}

END_OF_TINY
} #unless

package Mouse::Tiny;
use base 'Mouse';

1;

