# 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/TypeRegistry.pm'} = __FILE__;
$INC{'Mouse/Util.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/Accessor.pm'} = __FILE__;
$INC{'Mouse/Meta/Method/Constructor.pm'} = __FILE__;
$INC{'Mouse/Meta/Method/Destructor.pm'} = __FILE__;
$INC{'Mouse/Util/TypeConstraints.pm'} = __FILE__;

# and now their contents

package Mouse::Util;
use strict;
use warnings;
use base qw/Exporter/;
use Carp;

our @EXPORT_OK = qw(
    get_linear_isa
    apply_all_roles
    version 
    authority
    identifier
);
our %EXPORT_TAGS = (
    all  => \@EXPORT_OK,
);

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

                my $classname = shift;

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

    no strict 'refs';
    *{ __PACKAGE__ . '::get_linear_isa'} = $impl;
}

{ # adapted from Class::MOP::Module

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

# taken from Class/MOP.pm
{
    my %cache;

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

        my $cache_key = $type;
        return $cache{$cache_key}{$metaclass_name}
          if $cache{$cache_key}{$metaclass_name};

        my $possible_full_name =
            'Mouse::Meta::' 
          . $type
          . '::Custom::'
          . $metaclass_name;

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

        return $cache{$cache_key}{$metaclass_name} =
            $loaded_class->can('register_implementation')
          ? $loaded_class->register_implementation
          : $loaded_class;
    }
}

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

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

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

    return 0;
}

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

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

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

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

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

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

    return if Mouse::is_class_loaded($class);

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

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

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] => {} ];
        }
    }

    foreach my $role_spec (@roles) {
        Mouse::load_class( $role_spec->[0] );
    }

    ( $_->[0]->can('meta') && $_->[0]->meta->isa('Mouse::Meta::Role') )
        || croak("You can only consume roles, "
        . $_->[0]
        . " is not a Moose role")
        foreach @roles;

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

}

package Mouse;
use strict;
use warnings;
use 5.006;
use base 'Exporter';

our $VERSION = '0.24';

use Carp 'confess';
use Scalar::Util 'blessed';
our @EXPORT = qw(extends has before after around override super blessed confess with);

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

sub has {
    my $meta = Mouse::Meta::Class->initialize(caller);
    $meta->add_attribute(@_);
}

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

    my $code = pop;

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

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

    my $code = pop;

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

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

    my $code = pop;

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

sub with {
    Mouse::Util::apply_all_roles((caller)[0], @_);
}

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 init_meta {
    # This used to be called as a function. This hack preserves
    # backwards compatibility.
    if ( $_[0] ne __PACKAGE__ ) {
        return __PACKAGE__->init_meta(
            for_class  => $_[0],
            base_class => $_[1],
            metaclass  => $_[2],
        );
    }

    shift;
    my %args = @_;

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

    Carp::croak("The Metaclass $metaclass must be a subclass of Mouse::Meta::Class.")
            unless $metaclass->isa('Mouse::Meta::Class');
    
    # make a subtype for each Mouse class
    class_type($class)
        unless find_type_constraint($class);

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

    {
        no strict 'refs';
        no warnings 'redefine';
        *{$class.'::meta'} = sub { $meta };
    }

    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;
    }

    Mouse->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;

    no strict 'refs';
    for my $keyword (@EXPORT) {
        delete ${ $caller . '::' }{$keyword};
    }
}

sub load_class {
    my $class = shift;

    if (ref($class) || !defined($class) || !length($class)) {
        my $display = defined($class) ? $class : 'undef';
        confess "Invalid class name ($display)";
    }

    return 1 if $class eq 'Mouse::Object';
    return 1 if is_class_loaded($class);

    (my $file = "$class.pm") =~ s{::}{/}g;

    eval { CORE::require($file) };
    confess "Could not load class ($class) because : $@" if $@;

    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)) {
        return 0 unless exists ${$$pack}{"${part}::"};
        $pack = \*{${$$pack}{"${part}::"}};
    }

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

    # check for any method
    foreach ( keys %{$$pack} ) {
        next if substr($_, -2, 2) eq '::';
        return 1 if defined *{${$$pack}{$_}}{CODE};
    }

    # fail
    return 0;
}

sub class_of {
    return unless defined $_[0];
    my $class = blessed($_[0]) || $_[0];
    return Mouse::Meta::Class::get_metaclass_by_name($class);
}

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

use Carp 'confess';
use Scalar::Util ();
sub new {
    my ($class, $name, %options) = @_;

    $options{name} = $name;

    $options{init_arg} = $name
        unless exists $options{init_arg};

    $options{is} ||= '';

    bless \%options, $class;
}

sub name                 { $_[0]->{name}                   }
sub associated_class     { $_[0]->{associated_class}       }
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 predicate            { $_[0]->{predicate}              }
sub clearer              { $_[0]->{clearer}                }
sub handles              { $_[0]->{handles}                }
sub is_weak_ref          { $_[0]->{weak_ref}               }
sub init_arg             { $_[0]->{init_arg}               }
sub type_constraint      { $_[0]->{type_constraint}        }
sub find_type_constraint {
    Carp::carp("This method was deprecated");
    $_[0]->type_constraint();
}
sub trigger              { $_[0]->{trigger}                }
sub builder              { $_[0]->{builder}                }
sub should_auto_deref    { $_[0]->{auto_deref}             }
sub should_coerce        { $_[0]->{should_coerce}          }

sub has_default          { exists $_[0]->{default}         }
sub has_predicate        { exists $_[0]->{predicate}       }
sub has_clearer          { exists $_[0]->{clearer}         }
sub has_handles          { exists $_[0]->{handles}         }
sub has_type_constraint  { exists $_[0]->{type_constraint} }
sub has_trigger          { exists $_[0]->{trigger}         }
sub has_builder          { exists $_[0]->{builder}         }

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

sub inlined_name {
    my $self = shift;
    my $name = $self->name;
    my $key   = "'" . $name . "'";
    return $key;
}

sub generate_predicate {
    my $attribute = shift;
    my $key = $attribute->inlined_name;

    my $predicate = 'sub { exists($_[0]->{'.$key.'}) }';

    my $sub = eval $predicate;
    confess $@ if $@;
    return $sub;
}

sub generate_clearer {
    my $attribute = shift;
    my $key = $attribute->inlined_name;

    my $clearer = 'sub { delete($_[0]->{'.$key.'}) }';

    my $sub = eval $clearer;
    confess $@ if $@;
    return $sub;
}

sub generate_handles {
    my $attribute = shift;
    my $reader = $attribute->name;
    my %handles = $attribute->_canonicalize_handles($attribute->handles);

    my %method_map;

    for my $local_method (keys %handles) {
        my $remote_method = $handles{$local_method};

        my $method = 'sub {
            my $self = shift;
            $self->'.$reader.'->'.$remote_method.'(@_)
        }';

        $method_map{$local_method} = eval $method;
        confess $@ if $@;
    }

    return \%method_map;
}

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

    $args{name} = $name;
    $args{associated_class} = $class;

    %args = $self->canonicalize_args($name, %args);
    $self->validate_args($name, \%args);

    $args{should_coerce} = delete $args{coerce}
        if exists $args{coerce};

    if (exists $args{isa}) {
        confess "Got isa => $args{isa}, but Mouse does not yet support parameterized types for containers other than ArrayRef and HashRef (rt.cpan.org #39795)"
            if $args{isa} =~ /^([^\[]+)\[.+\]$/ &&
               $1 ne 'ArrayRef' &&
               $1 ne 'HashRef'  &&
               $1 ne 'Maybe'
        ;

        my $type_constraint = delete $args{isa};
        $args{type_constraint}= Mouse::Util::TypeConstraints::find_or_create_isa_type_constraint($type_constraint);
    }

    my $attribute = $self->new($name, %args);

    $attribute->_create_args(\%args);

    $class->add_attribute($attribute);

    # install an accessor
    if ($attribute->_is_metadata eq 'rw' || $attribute->_is_metadata eq 'ro') {
        my $code = Mouse::Meta::Method::Accessor->generate_accessor_method_inline(
            $attribute,
        );
        $class->add_method($name => $code);
    }

    for my $method (qw/predicate clearer/) {
        my $predicate = "has_$method";
        if ($attribute->$predicate) {
            my $generator = "generate_$method";
            my $coderef = $attribute->$generator;
            $class->add_method($attribute->$method => $coderef);
        }
    }

    if ($attribute->has_handles) {
        my $method_map = $attribute->generate_handles;
        for my $method_name (keys %$method_map) {
            $class->add_method($method_name => $method_map->{$method_name});
        }
    }

    return $attribute;
}

sub canonicalize_args {
    my $self = shift;
    my $name = shift;
    my %args = @_;

    if ($args{lazy_build}) {
        $args{lazy}      = 1;
        $args{required}  = 1;
        $args{builder}   = "_build_${name}"
            if !exists($args{builder});
        if ($name =~ /^_/) {
            $args{clearer}   = "_clear${name}" if !exists($args{clearer});
            $args{predicate} = "_has${name}" if !exists($args{predicate});
        }
        else {
            $args{clearer}   = "clear_${name}" if !exists($args{clearer});
            $args{predicate} = "has_${name}" if !exists($args{predicate});
        }
    }

    return %args;
}

sub validate_args {
    my $self = shift;
    my $name = shift;
    my $args = shift;

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

    confess "You cannot have lazy attribute ($name) without specifying a default value for it"
        if $args->{lazy}
        && !exists($args->{default})
        && !exists($args->{builder});

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

    confess "You cannot auto-dereference without specifying a type constraint on attribute ($name)"
        if $args->{auto_deref} && !exists($args->{isa});

    confess "You cannot auto-dereference anything other than a ArrayRef or HashRef on attribute ($name)"
        if $args->{auto_deref}
        && $args->{isa} ne 'ArrayRef'
        && $args->{isa} ne 'HashRef';

    if ($args->{trigger}) {
        if (ref($args->{trigger}) eq 'HASH') {
            Carp::carp "HASH-based form of trigger has been removed. Only the coderef form of triggers are now supported.";
        }

        confess "Trigger must be a CODE ref on attribute ($name)"
            if ref($args->{trigger}) ne 'CODE';
    }

    return 1;
}

sub verify_against_type_constraint {
    my ($self, $value) = @_;
    my $tc = $self->type_constraint;
    return 1 unless $tc;

    local $_ = $value;
    return 1 if $tc->check($value);

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

sub verify_type_constraint_error {
    my($self, $name, $value, $type) = @_;
    Carp::confess("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];
    return Mouse::Util::TypeConstraints->typecast_constraints($_[0]->associated_class->name, $_[0]->type_constraint, $_[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 {
        confess "Unable to canonicalize the 'handles' option with $handles";
    }
}

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

    $self->create($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 };
    }

    confess "Could not find an attribute by the name of '$name' to inherit from";
}

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

use Scalar::Util qw/blessed weaken/;
BEGIN { Mouse::Util->import(qw/get_linear_isa version authority identifier/) }
use Carp 'confess';

do {
    my %METACLASS_CACHE;

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

    sub initialize {
        my $class = blessed($_[0]) || $_[0];
        my $name  = $_[1];

        $METACLASS_CACHE{$name} = $class->new(name => $name)
            if !exists($METACLASS_CACHE{$name});
        return $METACLASS_CACHE{$name};
    }

    # Means of accessing all the metaclasses that have
    # been initialized thus far
    sub get_all_metaclasses         {        %METACLASS_CACHE         }
    sub get_all_metaclass_instances { values %METACLASS_CACHE         }
    sub get_all_metaclass_names     { keys   %METACLASS_CACHE         }
    sub get_metaclass_by_name       { $METACLASS_CACHE{$_[0]}         }
    sub store_metaclass_by_name     { $METACLASS_CACHE{$_[0]} = $_[1] }
    sub weaken_metaclass            { weaken($METACLASS_CACHE{$_[0]}) }
    sub does_metaclass_exist        { exists $METACLASS_CACHE{$_[0]} && defined $METACLASS_CACHE{$_[0]} }
    sub remove_metaclass_by_name    { $METACLASS_CACHE{$_[0]} = undef }
};

sub new {
    my $class = shift;
    my %args  = @_;

    $args{attributes} = {};
    $args{superclasses} = do {
        no strict 'refs';
        \@{ $args{name} . '::ISA' };
    };
    $args{roles} ||= [];

    bless \%args, $class;
}

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

sub superclasses {
    my $self = shift;

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

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

sub add_method {
    my $self = shift;
    my $name = shift;
    my $code = shift;

    my $pkg = $self->name;

    no strict 'refs';
    no warnings 'redefine';
    $self->{'methods'}->{$name}++; # Moose stores meta object here.
    *{ $pkg . '::' . $name } = $code;
}

sub has_method {
    my $self = shift;
    my $name = shift;
    $self->name->can($name);
}

# copied from Class::Inspector
my $get_methods_for_class = sub {
    my $self = shift;
    my $name = shift;

    no strict 'refs';
    # Get all the CODE symbol table entries
    my @functions =
      grep !/^(?:has|with|around|before|after|augment|inner|blessed|extends|confess|override|super)$/,
      grep { defined &{"${name}::$_"} }
      keys %{"${name}::"};
    push @functions, keys %{$self->{'methods'}->{$name}} if $self;
    wantarray ? @functions : \@functions;
};

sub get_method_list {
    my $self = shift;
    $get_methods_for_class->($self, $self->name);
}

sub get_all_method_names {
    my $self = shift;
    my %uniq;
    return grep { $uniq{$_}++ == 0 }
            map { $get_methods_for_class->(undef, $_) }
            $self->linearized_isa;
}

sub add_attribute {
    my $self = shift;

    if (@_ == 1 && blessed($_[0])) {
        my $attr = shift @_;
        $self->{'attributes'}{$attr->name} = $attr;
    } else {
        my $names = shift @_;
        $names = [$names] if !ref($names);
        my $metaclass = 'Mouse::Meta::Attribute';
        my %options = @_;

        if ( my $metaclass_name = delete $options{metaclass} ) {
            my $new_class = Mouse::Util::resolve_metaclass_alias(
                'Attribute',
                $metaclass_name
            );
            if ( $metaclass ne $new_class ) {
                $metaclass = $new_class;
            }
        }

        for my $name (@$names) {
            if ($name =~ s/^\+//) {
                $metaclass->clone_parent($self, $name, @_);
            }
            else {
                $metaclass->create($self, $name, @_);
            }
        }
    }
}

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 get_attribute_map { $_[0]->{attributes} }
sub has_attribute     { exists $_[0]->{attributes}->{$_[1]} }
sub get_attribute     { $_[0]->{attributes}->{$_[1]} }
sub get_attribute_list {
    my $self = shift;
    keys %{$self->get_attribute_map};
}

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

sub clone_object {
    my $class    = shift;
    my $instance = shift;

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

    $class->clone_instance($instance, @_);
}

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

    (blessed($instance))
        || confess "You can only clone instances, ($instance) is not a blessed 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 make_immutable {
    my $self = shift;
    my %args = (
        inline_constructor => 1,
        inline_destructor  => 1,
        @_,
    );

    my $name = $self->name;
    $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 { confess "Mouse does not currently support 'make_mutable'" }

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

sub attribute_metaclass { "Mouse::Meta::Class" }

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

    # which is modifer class available?
    my $modifier_class = do {
        if (eval "require Class::Method::Modifiers::Fast; 1") {
            'Class::Method::Modifiers::Fast';
        } elsif (eval "require Class::Method::Modifiers; 1") {
            'Class::Method::Modifiers';
        } else {
            Carp::croak("Method modifiers require the use of Class::Method::Modifiers or Class::Method::Modifiers::Fast. Please install it from CPAN and file a bug report with this application.");
        }
    };
    my $modifier = $modifier_class->can('_install_modifier');

    # replace this method itself :)
    {
        no strict 'refs';
        no warnings 'redefine';
        *{__PACKAGE__ . '::_install_modifier'} = sub {
            my ( $self, $into, $type, $name, $code ) = @_;
            $modifier->(
                $into,
                $type,
                $name,
                $code
            );
        };
    }

    # call me. for first time.
    $self->_install_modifier( $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 $pkg = $self->name;
    my $method = "${pkg}::${name}";

    # Class::Method::Modifiers won't do this for us, so do it ourselves

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

    no strict 'refs';
    *$method = sub { $code->($pkg, $body, @_) };
}


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

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

    (defined $role_name)
        || confess "You must supply a role name to look for";

    for my $class ($self->linearized_isa) {
        next unless $class->can('meta') and $class->meta->can('roles');
        for my $role (@{ $class->meta->roles }) {
            return 1 if $role->name eq $role_name;
        }
    }

    return 0;
}

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

    (ref $options{superclasses} eq 'ARRAY')
        || confess "You must pass an ARRAY ref of superclasses"
            if exists $options{superclasses};

    (ref $options{attributes} eq 'ARRAY')
        || confess "You must pass an ARRAY ref of attributes"
            if exists $options{attributes};

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

    do {
        ( defined $package_name && $package_name )
          || confess "You must pass a package name";

        my $code = "package $package_name;";
        $code .= "\$$package_name\:\:VERSION = '" . $options{version} . "';"
          if exists $options{version};
        $code .= "\$$package_name\:\:AUTHORITY = '" . $options{authority} . "';"
          if exists $options{authority};

        eval $code;
        confess "creation of $package_name failed : $@" if $@;
    };

    my %initialize_options = %options;
    delete @initialize_options{qw(
        package
        superclasses
        attributes
        methods
        version
        authority
    )};
    my $meta = $self->initialize( $package_name => %initialize_options );

    # FIXME totally lame
    $meta->add_method('meta' => sub {
        $self->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 (exists $options{attributes}) {
        foreach my $attr (@{$options{attributes}}) {
            Mouse::Meta::Attribute->create($meta, $attr->{name}, %$attr);
        }
    }
    if (exists $options{methods}) {
        foreach my $method_name (keys %{$options{methods}}) {
            $meta->add_method($method_name, $options{methods}->{$method_name});
        }
    }
    return $meta;
}

{
    my $ANON_CLASS_SERIAL = 0;
    my $ANON_CLASS_PREFIX = 'Mouse::Meta::Class::__ANON__::SERIAL::';
    sub create_anon_class {
        my ( $class, %options ) = @_;
        my $package_name = $ANON_CLASS_PREFIX . ++$ANON_CLASS_SERIAL;
        return $class->create( $package_name, %options );
    }
}

package Mouse::Meta::Method::Accessor;
use strict;
use warnings;
use Carp ();

# internal use only. do not call directly
sub generate_accessor_method_inline {
    my ($class, $attribute) = @_;

    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   = $attribute->inlined_name;

    my $accessor = 
        '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" .
        "sub {\n";
    if ($attribute->_is_metadata eq 'rw') {
        $accessor .= 
            '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" .
            'if (scalar(@_) >= 2) {' . "\n";

        my $value = '$_[1]';

        if ($constraint) {
            if ($should_coerce) {
                $accessor .=
                    "\n".
                    '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" .
                    'my $val = Mouse::Util::TypeConstraints->typecast_constraints("'.$attribute->associated_class->name.'", $attribute->{type_constraint}, '.$value.');';
                $value = '$val';
            }
            if ($compiled_type_constraint) {
                $accessor .= 
                    "\n".
                    '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" .
                    'unless ($compiled_type_constraint->('.$value.')) {
                        $attribute->verify_type_constraint_error($name, '.$value.', $attribute->{type_constraint});
                    }' . "\n";
            } else {
                $accessor .= 
                    "\n".
                    '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" .
                    'unless ($constraint->check('.$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";
    }
    else {
        $accessor .= 'Carp::confess("Cannot assign a value to a read-only accessor") if scalar(@_) >= 2;' . "\n";
    }

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

        $accessor .= $attribute->has_builder
                ? $self.'->$builder'
                    : ref($default) eq 'CODE'
                    ? '$default->('.$self.')'
                    : '$default';
        $accessor .= ' if !exists '.$self.'->{'.$key.'};' . "\n";
    }

    if ($should_deref) {
        if (ref($constraint) && $constraint->name eq 'ArrayRef') {
            $accessor .= 'if (wantarray) {
                return @{ '.$self.'->{'.$key.'} || [] };
            }';
        }
        else {
            $accessor .= 'if (wantarray) {
                return %{ '.$self.'->{'.$key.'} || {} };
            }';
        }
    }

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

    my $sub = eval $accessor;
    Carp::confess($@) if $@;
    return $sub;
}

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

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

    my $associated_metaclass_name = $meta->name;
    my @attrs = $meta->get_all_attributes;
    my $buildall = $class->_generate_BUILDALL($meta);
    my $buildargs = $class->_generate_BUILDARGS($meta);
    my $processattrs = $class->_generate_processattrs($meta, \@attrs);
    my @compiled_constraints = map { $_ ? $_->{_compiled_type_constraint} : undef } map { $_->{type_constraint} } @attrs;

    my $code = <<"...";
    sub {
        my \$class = shift;
        return \$class->Mouse::Object::new(\@_)
            if \$class ne '$associated_metaclass_name';
        $buildargs;
        my \$instance = bless {}, \$class;
        $processattrs;
        $buildall;
        return \$instance;
    }
...

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

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

    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->{'$from'}) {\n";

            if ($attr->should_coerce && $attr->type_constraint) {
                $code .= "my \$value = Mouse::Util::TypeConstraints->typecast_constraints('".$attr->associated_class->name."', \$attrs[$index]->{type_constraint}, \$args->{'$from'});\n";
            }
            else {
                $code .= "my \$value = \$args->{'$from'};\n";
            }

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

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

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

            if ($attr->has_trigger) {
                $code .= "\$attrs[$index]->{trigger}->( \$instance, \$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 .= "Mouse::Util::TypeConstraints->typecast_constraints('".$attr->associated_class->name."', \$attrs[$index]->{type_constraint}, ";
                }

                    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('$key', \$value, \$attrs[$index]->type_constraint)
                        }
                    }";
                }

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

                if ($attr->is_weak_ref) {
                    $code .= "Scalar::Util::weaken( \$instance->{'$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;
    }

    return join "\n", @res;
}

sub _generate_BUILDARGS {
    my $self = shift;
    my $meta = shift;

    if ($meta->name->can('BUILDARGS') && $meta->name->can('BUILDARGS') != Mouse::Object->can('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, $meta) = @_;
    return '' unless $meta->name->can('BUILD');

    my @code = ();
    push @code, q{no strict 'refs';};
    push @code, q{no warnings 'once';};
    no strict 'refs';
    no warnings 'once';
    for my $klass ($meta->linearized_isa) {
        if (*{ $klass . '::BUILD' }{CODE}) {
            unshift  @code, qq{${klass}::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 = ();
            no strict 'refs';
            for my $klass ($meta->linearized_isa) {
                if (*{$klass . '::DEMOLISH'}{CODE}) {
                    push @code, "${klass}::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::Role;
use strict;
use warnings;
use Carp 'confess';
BEGIN { Mouse::Util->import(qw(version authority identifier)) }

do {
    my %METACLASS_CACHE;

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

    sub initialize {
        my $class = shift;
        my $name  = shift;
        $METACLASS_CACHE{$name} = $class->new(name => $name)
            if !exists($METACLASS_CACHE{$name});
        return $METACLASS_CACHE{$name};
    }
};

sub new {
    my $class = shift;
    my %args  = @_;

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

    bless \%args, $class;
}

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

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



sub add_attribute {
    my $self = shift;
    my $name = shift;
    my $spec = shift;
    $self->{attributes}->{$name} = $spec;
}

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

# copied from Class::Inspector
sub get_method_list {
    my $self = shift;
    my $name = $self->name;

    no strict 'refs';
    # Get all the CODE symbol table entries
    my @functions =
      grep !/^(?:has|with|around|before|after|augment|inner|override|super|blessed|extends|confess|excludes|meta|requires)$/,
      grep { defined &{"${name}::$_"} }
      keys %{"${name}::"};
    wantarray ? @functions : \@functions;
}

# Moose uses Application::ToInstance, Application::ToClass, Application::ToRole
sub apply {
    my $self  = shift;
    my $selfname = $self->name;
    my $class = shift;
    my $classname = $class->name;
    my %args  = @_;

    if ($class->isa('Mouse::Object')) {
        Carp::croak('Mouse does not support Application::ToInstance yet');
    }

    if ($class->isa('Mouse::Meta::Class')) {
        for my $name (@{$self->{required_methods}}) {
            unless ($classname->can($name)) {
                confess "'$selfname' requires the method '$name' to be implemented by '$classname'";
            }
        }
    }

    {
        no strict 'refs';
        for my $name ($self->get_method_list) {
            next if $name eq 'meta';

            my $class_function = "${classname}::${name}";
            my $role_function = "${selfname}::${name}";
            if (defined &$class_function) {
                # XXX what's Moose's behavior?
                #next;
            } else {
                *{$class_function} = \&{$role_function};
            }
            if ($args{alias} && $args{alias}->{$name}) {
                my $dstname = $args{alias}->{$name};
                unless ($classname->can($dstname)) {
                    *{"${classname}::${dstname}"} = \&$role_function;
                }
            }
        }
    }

    if ($class->isa('Mouse::Meta::Class')) {
        # apply role to class
        for my $name ($self->get_attribute_list) {
            next if $class->has_attribute($name);
            my $spec = $self->get_attribute($name);

            my $metaclass = 'Mouse::Meta::Attribute';
            if ( my $metaclass_name = $spec->{metaclass} ) {
                my $new_class = Mouse::Util::resolve_metaclass_alias(
                    'Attribute',
                    $metaclass_name
                );
                if ( $metaclass ne $new_class ) {
                    $metaclass = $new_class;
                }
            }

            $metaclass->create($class, $name, %$spec);
        }
    } else {
        # apply role to role
        # XXX Room for speed improvement
        for my $name ($self->get_attribute_list) {
            next if $class->has_attribute($name);
            my $spec = $self->get_attribute($name);
            $class->add_attribute($name, $spec);
        }
    }

    # XXX Room for speed improvement in role to role
    for my $modifier_type (qw/before after around override/) {
        my $add_method = "add_${modifier_type}_method_modifier";
        my $modified = $self->{"${modifier_type}_method_modifiers"};

        for my $method_name (keys %$modified) {
            for my $code (@{ $modified->{$method_name} }) {
                $class->$add_method($method_name => $code);
            }
        }
    }

    # append roles
    push @{ $class->roles }, $self, @{ $self->roles };
}

sub combine_apply {
    my(undef, $class, @roles) = @_;
    my $classname = $class->name;

    if ($class->isa('Mouse::Meta::Class')) {
        for my $role_spec (@roles) {
            my $self = $role_spec->[0]->meta;
            for my $name (@{$self->{required_methods}}) {
                unless ($classname->can($name)) {
                    my $method_required = 0;
                    for my $role (@roles) {
                        $method_required = 1 if $self->name ne $role->[0] && $role->[0]->can($name);
                    }
                    confess "'".$self->name."' requires the method '$name' to be implemented by '$classname'"
                        unless $method_required;
                }
            }
        }
    }

    {
        no strict 'refs';
        for my $role_spec (@roles) {
            my $self = $role_spec->[0]->meta;
            my $selfname = $self->name;
            my %args = %{ $role_spec->[1] };
            for my $name ($self->get_method_list) {
                next if $name eq 'meta';

                my $class_function = "${classname}::${name}";
                my $role_function = "${selfname}::${name}";
                if (defined &$class_function) {
                    # XXX what's Moose's behavior?
                    #next;
                } else {
                    *$class_function = *$role_function;
                }
                if ($args{alias} && $args{alias}->{$name}) {
                    my $dstname = $args{alias}->{$name};
                    unless ($classname->can($dstname)) {
                        *{"${classname}::${dstname}"} = \&$role_function;
                    }
                }
            }
        }
    }


    if ($class->isa('Mouse::Meta::Class')) {
        # apply role to class
        for my $role_spec (@roles) {
            my $self = $role_spec->[0]->meta;
            for my $name ($self->get_attribute_list) {
                next if $class->has_attribute($name);
                my $spec = $self->get_attribute($name);

                my $metaclass = 'Mouse::Meta::Attribute';
                if ( my $metaclass_name = $spec->{metaclass} ) {
                    my $new_class = Mouse::Util::resolve_metaclass_alias(
                        'Attribute',
                        $metaclass_name
                    );
                    if ( $metaclass ne $new_class ) {
                        $metaclass = $new_class;
                    }
                }

                $metaclass->create($class, $name, %$spec);
            }
        }
    } else {
        # apply role to role
        # XXX Room for speed improvement
        for my $role_spec (@roles) {
            my $self = $role_spec->[0]->meta;
            for my $name ($self->get_attribute_list) {
                next if $class->has_attribute($name);
                my $spec = $self->get_attribute($name);
                $class->add_attribute($name, $spec);
            }
        }
    }

    # XXX Room for speed improvement in role to role
    for my $modifier_type (qw/before after around override/) {
        my $add_method = "add_${modifier_type}_method_modifier";
        for my $role_spec (@roles) {
            my $self = $role_spec->[0]->meta;
            my $modified = $self->{"${modifier_type}_method_modifiers"};

            for my $method_name (keys %$modified) {
                for my $code (@{ $modified->{$method_name} }) {
                    $class->$add_method($method_name => $code);
                }
            }
        }
    }

    # append roles
    my %role_apply_cache;
    my $apply_roles = $class->roles;
    for my $role_spec (@roles) {
        my $self = $role_spec->[0]->meta;
        push @$apply_roles, $self unless $role_apply_cache{$self}++;
        for my $role (@{ $self->roles }) {
            push @$apply_roles, $role unless $role_apply_cache{$role}++;
        }
    }
}

for my $modifier_type (qw/before after around override/) {
    no strict 'refs';
    *{ __PACKAGE__ . '::' . "add_${modifier_type}_method_modifier" } = sub {
        my ($self, $method_name, $method) = @_;

        push @{ $self->{"${modifier_type}_method_modifiers"}->{$method_name} },
            $method;
    };

    *{ __PACKAGE__ . '::' . "get_${modifier_type}_method_modifiers" } = sub {
        my ($self, $method_name, $method) = @_;
        @{ $self->{"${modifier_type}_method_modifiers"}->{$method_name} || [] }
    };
}

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


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

    (defined $role_name)
        || confess "You must supply a role name to look for";

    # if we are it,.. then return true
    return 1 if $role_name eq $self->name;

    for my $role (@{ $self->{roles} }) {
        return 1 if $role->does_role($role_name);
    }
    return 0;
}


package Mouse::Meta::TypeConstraint;
use strict;
use warnings;
use overload '""'     => sub { shift->{name} },   # stringify to tc name
             fallback => 1;

sub new {
    my $class = shift;
    my %args = @_;
    my $name = $args{name} || '__ANON__';

    my $check = $args{_compiled_type_constraint} or Carp::croak("missing _compiled_type_constraint");
    if (ref $check eq 'Mouse::Meta::TypeConstraint') {
        $check = $check->{_compiled_type_constraint};
    }

    bless +{
        name                      => $name,
        _compiled_type_constraint => $check,
        message                   => $args{message}
    }, $class;
}

sub name { shift->{name} }

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

sub message {
    return $_[0]->{message};
}

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->name
          . "' failed with value $value";
    }
}

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

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

sub new {
    my $class = shift;

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

    my $instance = bless {}, $class;

    for my $attribute ($class->meta->get_all_attributes) {
        my $from = $attribute->init_arg;
        my $key  = $attribute->name;

        if (defined($from) && exists($args->{$from})) {
            $args->{$from} = $attribute->coerce_constraint($args->{$from})
                if $attribute->should_coerce;
            $attribute->verify_against_type_constraint($args->{$from});

            $instance->{$key} = $args->{$from};

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

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

                    $value = $attribute->coerce_constraint($value)
                        if $attribute->should_coerce;
                    $attribute->verify_against_type_constraint($value);

                    $instance->{$key} = $value;

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

    $instance->BUILDALL($args);

    return $instance;
}

sub BUILDARGS {
    my $class = shift;

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

sub DESTROY { shift->DEMOLISHALL }

sub BUILDALL {
    my $self = shift;

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

    for my $class (reverse $self->meta->linearized_isa) {
        no strict 'refs';
        no warnings 'once';
        my $code = *{ $class . '::BUILD' }{CODE}
            or next;
        $code->($self, @_);
    }
}

sub DEMOLISHALL {
    my $self = shift;

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

    no strict 'refs';

    my @isa;
    if ( my $meta = Mouse::class_of($self) ) {
        @isa = $meta->linearized_isa;
    } else {
        # 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 ;)
        my $class_name = ref $self;
        @isa = @{ Mouse::Util::get_linear_isa($class_name) }
    }

    foreach my $class (@isa) {
        no strict 'refs';
        my $demolish = *{"${class}::DEMOLISH"}{CODE};
        $self->$demolish
            if defined $demolish;
    }
}

sub dump { 
    my $self = shift;
    require Data::Dumper;
    local $Data::Dumper::Maxdepth = shift if @_;
    Data::Dumper::Dumper $self;
}


sub does {
    my ($self, $role_name) = @_;
    (defined $role_name)
        || confess "You must supply a role name to does()";
    my $meta = $self->meta;
    foreach my $class ($meta->linearized_isa) {
        my $m = $meta->initialize($class);
        return 1 
            if $m->can('does_role') && $m->does_role($role_name);            
    }
    return 0;   
};

package Mouse::Role;
use strict;
use warnings;
use base 'Exporter';

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

our @EXPORT = qw(before after around super override inner augment has extends with requires excludes confess blessed);

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

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

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

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

sub around {
    my $meta = Mouse::Meta::Role->initialize(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
        && confess "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 {
    croak "Moose::Role cannot support 'inner'";
}

sub augment {
    croak "Moose::Role cannot support 'augment'";
}

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

    my $name = shift;
    my %opts = @_;

    $meta->add_attribute($name => \%opts);
}

sub extends  { confess "Roles do not currently support 'extends'" }

sub with     {
    my $meta = Mouse::Meta::Role->initialize(caller);
    my $role  = shift;
    my $args  = shift || {};
    confess "Mouse::Role only supports 'with' on individual roles at a time" if @_ || !ref $args;

    Mouse::load_class($role);
    $role->meta->apply($meta, %$args);
}

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

sub excludes { confess "Mouse::Role does not currently support 'excludes'" }

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;
    }

    my $meta = Mouse::Meta::Role->initialize(caller);

    no strict 'refs';
    no warnings 'redefine';
    *{$caller.'::meta'} = sub { $meta };

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

sub unimport {
    my $caller = caller;

    no strict 'refs';
    for my $keyword (@EXPORT) {
        delete ${ $caller . '::' }{$keyword};
    }
}

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 base 'Exporter';

use Carp ();
use Scalar::Util qw/blessed looks_like_number openhandle/;
our @EXPORT = qw(
    as where message from via type subtype coerce class_type role_type enum
    find_type_constraint
);

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

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

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

BEGIN {
    no warnings 'uninitialized';
    %TYPE = (
        Any        => sub { 1 },
        Item       => sub { 1 },
        Bool       => sub {
            !defined($_[0]) || $_[0] eq "" || "$_[0]" eq '1' || "$_[0]" eq '0'
        },
        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]) },
        ClassName  => sub { Mouse::is_class_loaded($_[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' },
    );
    while (my ($name, $code) = each %TYPE) {
        $TYPE{$name} = Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $name );
    }

    sub optimized_constraints { \%TYPE }
    my @TYPE_KEYS = keys %TYPE;
    sub list_all_builtin_type_constraints { @TYPE_KEYS }

    @TYPE_SOURCE{@TYPE_KEYS} = (__PACKAGE__) x @TYPE_KEYS;
}

sub type {
    my $pkg = caller(0);
    my($name, %conf) = @_;
    if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
        Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
    };
    my $constraint = $conf{where} || do {
        my $as = delete $conf{as} || 'Any';
        if (! exists $TYPE{$as}) {
            $TYPE{$as} = _build_type_constraint($as);
        }
        $TYPE{$as};
    };

    $TYPE_SOURCE{$name} = $pkg;
    $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
        name => $name,
        _compiled_type_constraint => sub {
            local $_ = $_[0];
            if (ref $constraint eq 'CODE') {
                $constraint->($_[0])
            } else {
                $constraint->check($_[0])
            }
        }
    );
}

sub subtype {
    my $pkg = caller(0);
    my($name, %conf) = @_;
    if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
        Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
    };
    my $constraint = delete $conf{where};
    my $as_constraint = find_or_create_isa_type_constraint(delete $conf{as} || 'Any');

    $TYPE_SOURCE{$name} = $pkg;
    $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
        name => $name,
        _compiled_type_constraint => (
            $constraint ? 
            sub {
                local $_ = $_[0];
                $as_constraint->check($_[0]) && $constraint->($_[0])
            } :
            sub {
                local $_ = $_[0];
                $as_constraint->check($_[0]);
            }
        ),
        %conf
    );

    return $name;
}

sub coerce {
    my($name, %conf) = @_;

    Carp::croak "Cannot find type '$name', perhaps you forgot to load it."
        unless $TYPE{$name};

    unless ($COERCE{$name}) {
        $COERCE{$name}      = {};
        $COERCE_KEYS{$name} = [];
    }
    while (my($type, $code) = each %conf) {
        Carp::croak "A coercion action already exists for '$type'"
            if $COERCE{$name}->{$type};

        if (! $TYPE{$type}) {
            # looks parameterized
            if ($type =~ /^[^\[]+\[.+\]$/) {
                $TYPE{$type} = _build_type_constraint($type);
            } else {
                Carp::croak "Could not find the type constraint ($type) to coerce from"
            }
        }

        unshift @{ $COERCE_KEYS{$name} }, $type;
        $COERCE{$name}->{$type} = $code;
    }
}

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}'?";
        subtype($name, as => $conf->{class});
    } else {
        subtype(
            $name => where => sub { $_->isa($name) }
        );
    }
}

sub role_type {
    my($name, $conf) = @_;
    my $role = $conf->{role};
    subtype(
        $name => where => sub {
            return unless defined $_ && ref($_) && $_->isa('Mouse::Object');
            $_->meta->does_role($role);
        }
    );
}

# this is an original method for Mouse
sub typecast_constraints {
    my($class, $pkg, $types, $value) = @_;
    Carp::croak("wrong arguments count") unless @_==4;

    local $_;
    for my $type ( split /\|/, $types ) {
        next unless $COERCE{$type};
        for my $coerce_type (@{ $COERCE_KEYS{$type}}) {
            $_ = $value;
            next unless $TYPE{$coerce_type}->check($value);
            $_ = $value;
            $_ = $COERCE{$type}->{$coerce_type}->($value);
            return $_ if $types->check($_);
        }
    }
    return $value;
}

my $serial_enum = 0;
sub enum {
    # enum ['small', 'medium', 'large']
    if (ref($_[0]) eq 'ARRAY') {
        my @elements = @{ shift @_ };

        my $name = 'Mouse::Util::TypeConstaints::Enum::Serial::'
                 . ++$serial_enum;
        enum($name, @elements);
        return $name;
    }

    # enum size => 'small', 'medium', 'large'
    my $name = shift;
    my %is_valid = map { $_ => 1 } @_;

    subtype(
        $name => where => sub { $is_valid{$_} }
    );
}

sub _build_type_constraint {

    my $spec = shift;
    my $code;
    $spec =~ s/\s+//g;
    if ($spec =~ /^([^\[]+)\[(.+)\]$/) {
        # parameterized
        my $constraint = $1;
        my $param      = $2;
        my $parent;
        if ($constraint eq 'Maybe') {
            $parent = _build_type_constraint('Undef');
        } else {
            $parent = _build_type_constraint($constraint);
        }
        my $child = _build_type_constraint($param);
        if ($constraint eq 'ArrayRef') {
            my $code_str = 
                "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
                "sub {\n" .
                "    if (\$parent->check(\$_[0])) {\n" .
                "        foreach my \$e (\@{\$_[0]}) {\n" .
                "            return () unless \$child->check(\$e);\n" .
                "        }\n" .
                "        return 1;\n" .
                "    }\n" .
                "    return ();\n" .
                "};\n"
            ;
            $code = eval $code_str or Carp::confess("Failed to generate inline type constraint: $@");
        } elsif ($constraint eq 'HashRef') {
            my $code_str = 
                "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
                "sub {\n" .
                "    if (\$parent->check(\$_[0])) {\n" .
                "        foreach my \$e (values \%{\$_[0]}) {\n" .
                "            return () unless \$child->check(\$e);\n" .
                "        }\n" .
                "        return 1;\n" .
                "    }\n" .
                "    return ();\n" .
                "};\n"
            ;
            $code = eval $code_str or Carp::confess($@);
        } elsif ($constraint eq 'Maybe') {
            my $code_str =
                "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
                "sub {\n" .
                "    return \$child->check(\$_[0]) || \$parent->check(\$_[0]);\n" .
                "};\n"
            ;
            $code = eval $code_str or Carp::confess($@);
        } else {
            Carp::confess("Support for parameterized types other than Maybe, ArrayRef or HashRef is not implemented yet");
        }
        $TYPE{$spec} = Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
    } else {
        $code = $TYPE{ $spec };
        if (! $code) {
            # is $spec a known role?  If so, constrain with 'does' instead of 'isa'
            require Mouse::Meta::Role;
            my $check = Mouse::Meta::Role->_metaclass_cache($spec)? 
                'does' : 'isa';
            my $code_str = 
                "#line " . __LINE__ . ' "' . __FILE__ . "\"\n" .
                "sub {\n" .
                "    Scalar::Util::blessed(\$_[0]) && \$_[0]->$check('$spec');\n" .
                "}"
            ;
            $code = eval $code_str  or Carp::confess($@);
            $TYPE{$spec} = Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
        }
    }
    return Mouse::Meta::TypeConstraint->new( _compiled_type_constraint => $code, name => $spec );
}

sub find_type_constraint {
    my $type_constraint = shift;
    return $TYPE{$type_constraint};
}

sub find_or_create_isa_type_constraint {
    my $type_constraint = shift;

    my $code;

    $type_constraint =~ s/\s+//g;

    $code = $TYPE{$type_constraint};
    if (! $code) {
        my @type_constraints = split /\|/, $type_constraint;
        if (@type_constraints == 1) {
            $code = $TYPE{$type_constraints[0]} ||
                _build_type_constraint($type_constraints[0]);
        } else {
            my @code_list = map {
                $TYPE{$_} || _build_type_constraint($_)
            } @type_constraints;
            $code = Mouse::Meta::TypeConstraint->new(
                _compiled_type_constraint => sub {
                    my $i = 0;
                    for my $code (@code_list) {
                        return 1 if $code->check($_[0]);
                    }
                    return 0;
                },
                name => $type_constraint,
            );
        }
    }
    return $code;
}

END_OF_TINY
} #unless

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

1;

