Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Update TB2::Mouse to Mouse::Tiny 1.08.

This gets rid of our trigger patch and gets us any other goodies from the
last 2.5 years.
  • Loading branch information...
commit 0e4c5cc516cd5e6ab78d80f5017a4d9c16990aa7 1 parent 2f8d415
@schwern schwern authored
Showing with 246 additions and 175 deletions.
  1. +246 −175 lib/TB2/Mouse.pm
View
421 lib/TB2/Mouse.pm
@@ -1,39 +1,39 @@
-# This file was generated by Mouse::Maker 0.12 from Mouse 0.87.
+# This file was generated by tool/generate-mouse-tiny.pl from Mouse 1.08.
#
# ANY CHANGES MADE HERE WILL BE LOST!
use strict;
use warnings;
-# tell Perl we already have all of the TB2::Mouse files loaded:
-BEGIN {
- $INC{'TB2/Mouse.pm'} = __FILE__;
- $INC{'TB2/Mouse/Role.pm'} = __FILE__;
- $INC{'TB2/Mouse/Util.pm'} = __FILE__;
- $INC{'TB2/Mouse/Exporter.pm'} = __FILE__;
- $INC{'TB2/Mouse/PurePerl.pm'} = __FILE__;
- $INC{'TB2/Mouse/Object.pm'} = __FILE__;
- $INC{'TB2/Mouse/Meta/Class.pm'} = __FILE__;
- $INC{'TB2/Mouse/Meta/Method.pm'} = __FILE__;
- $INC{'TB2/Mouse/Meta/TypeConstraint.pm'} = __FILE__;
- $INC{'TB2/Mouse/Meta/Attribute.pm'} = __FILE__;
- $INC{'TB2/Mouse/Meta/Role.pm'} = __FILE__;
- $INC{'TB2/Mouse/Meta/Module.pm'} = __FILE__;
- $INC{'TB2/Mouse/Meta/Method/Delegation.pm'} = __FILE__;
- $INC{'TB2/Mouse/Meta/Method/Destructor.pm'} = __FILE__;
- $INC{'TB2/Mouse/Meta/Method/Accessor.pm'} = __FILE__;
- $INC{'TB2/Mouse/Meta/Method/Constructor.pm'} = __FILE__;
- $INC{'TB2/Mouse/Meta/Role/Method.pm'} = __FILE__;
- $INC{'TB2/Mouse/Meta/Role/Composite.pm'} = __FILE__;
- $INC{'TB2/Mouse/Meta/Role/Application.pm'} = __FILE__;
- $INC{'TB2/Mouse/Util/TypeConstraints.pm'} = __FILE__;
- $INC{'TB2/Mouse/Util/MetaRole.pm'} = __FILE__;
-}
+{
+# tell Perl we already have all of the Mouse files loaded:
+$INC{'TB2/Mouse.pm'} = __FILE__;
+$INC{'TB2/Mouse/Exporter.pm'} = __FILE__;
+$INC{'TB2/Mouse/Object.pm'} = __FILE__;
+$INC{'TB2/Mouse/PurePerl.pm'} = __FILE__;
+$INC{'TB2/Mouse/Role.pm'} = __FILE__;
+$INC{'TB2/Mouse/Util.pm'} = __FILE__;
+$INC{'TB2/Mouse/Meta/Attribute.pm'} = __FILE__;
+$INC{'TB2/Mouse/Meta/Class.pm'} = __FILE__;
+$INC{'TB2/Mouse/Meta/Method.pm'} = __FILE__;
+$INC{'TB2/Mouse/Meta/Module.pm'} = __FILE__;
+$INC{'TB2/Mouse/Meta/Role.pm'} = __FILE__;
+$INC{'TB2/Mouse/Meta/TypeConstraint.pm'} = __FILE__;
+$INC{'TB2/Mouse/Meta/Method/Accessor.pm'} = __FILE__;
+$INC{'TB2/Mouse/Meta/Method/Constructor.pm'} = __FILE__;
+$INC{'TB2/Mouse/Meta/Method/Delegation.pm'} = __FILE__;
+$INC{'TB2/Mouse/Meta/Method/Destructor.pm'} = __FILE__;
+$INC{'TB2/Mouse/Meta/Role/Application.pm'} = __FILE__;
+$INC{'TB2/Mouse/Meta/Role/Composite.pm'} = __FILE__;
+$INC{'TB2/Mouse/Meta/Role/Method.pm'} = __FILE__;
+$INC{'TB2/Mouse/Util/MetaRole.pm'} = __FILE__;
+$INC{'TB2/Mouse/Util/TypeConstraints.pm'} = __FILE__;
+eval sprintf("#line %d %s\n", __LINE__, __FILE__) . <<'END_OF_TINY';
# and now their contents
-# Contents of Mouse::PurePerl
+BEGIN{ # lib/TB2/Mouse/PurePerl.pm
package TB2::Mouse::PurePerl;
-# The pure Perl backend for Mousse
+# The pure Perl backend for Mouse
package TB2::Mouse::Util;
use strict;
use warnings;
@@ -471,7 +471,12 @@ sub handles { $_[0]->{handles} }
sub _is_metadata { $_[0]->{is} }
sub is_required { $_[0]->{required} }
-sub default { $_[0]->{default} }
+sub default {
+ my($self, $instance) = @_;
+ my $value = $self->{default};
+ $value = $value->($instance) if defined($instance) and ref($value) eq "CODE";
+ return $value;
+}
sub is_lazy { $_[0]->{lazy} }
sub is_lazy_build { $_[0]->{lazy_build} }
sub is_weak_ref { $_[0]->{weak_ref} }
@@ -519,7 +524,7 @@ sub _process_options{
if(exists $args->{builder}){
# XXX:
- # Moose refuses a CODE ref builder, but TB2::Mouse doesn't for backward compatibility
+ # 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};
@@ -687,13 +692,13 @@ sub compile_type_constraint{
}
else{
$self->{compiled_type_constraint} = sub{
- my(@args) = @_;
- for ($args[0]) {
- foreach my $c(@checks){
- return undef if !$c->(@args);
- }
- }
- return 1;
+ my(@args) = @_;
+ for ($args[0]) { # local $_ will cancel tie-ness due to perl's bug
+ foreach my $c(@checks){
+ return undef if !$c->(@args);
+ }
+ }
+ return 1;
};
}
return;
@@ -747,7 +752,7 @@ sub DESTROY {
my $demolish = TB2::Mouse::Util::get_code_ref($class, 'DEMOLISH')
|| next;
- $self->$demolish($TB2::Mouse::Util::in_global_destruction);
+ $self->$demolish(TB2::Mouse::Util::in_global_destruction());
}
};
$@;
@@ -775,26 +780,29 @@ sub BUILDALL {
sub DEMOLISHALL;
*DEMOLISHALL = \&DESTROY;
-# Contents of Mouse::Exporter
+}
+BEGIN{ # lib/TB2/Mouse/Exporter.pm
package TB2::Mouse::Exporter;
use strict;
use warnings;
-
use Carp ();
my %SPEC;
my $strict_bits;
-BEGIN{ $strict_bits = strict::bits(qw(subs refs vars)); }
-
my $warnings_extra_bits;
-BEGIN{ $warnings_extra_bits = warnings::bits(FATAL => 'recursion') }
+BEGIN{
+ $strict_bits = strict::bits(qw(subs refs vars));
+ $warnings_extra_bits = warnings::bits(FATAL => 'recursion');
+}
# it must be "require", because TB2::Mouse::Util depends on TB2::Mouse::Exporter,
# which depends on TB2::Mouse::Util::import()
require TB2::Mouse::Util;
sub import{
+ ## no critic ProhibitBitwiseOperators
+
# strict->import;
$^H |= $strict_bits;
# warnings->import('all', FATAL => 'recursion');
@@ -947,10 +955,10 @@ sub do_import {
}
# strict->import;
- $^H |= $strict_bits;
+ $^H |= $strict_bits; ## no critic ProhibitBitwiseOperators
# warnings->import('all', FATAL => 'recursion');
- ${^WARNING_BITS} |= $warnings::Bits{all};
- ${^WARNING_BITS} |= $warnings_extra_bits;
+ ${^WARNING_BITS} |= $warnings::Bits{all}; ## no critic ProhibitBitwiseOperators
+ ${^WARNING_BITS} |= $warnings_extra_bits; ## no critic ProhibitBitwiseOperators
if($spec->{INIT_META}){
my $meta;
@@ -968,7 +976,7 @@ sub do_import {
require TB2::Mouse::Util::MetaRole;
TB2::Mouse::Util::MetaRole::apply_metaroles(
- for => $into,
+ for => $into,
TB2::Mouse::Util::is_a_metarole($into->meta)
? (role_metaroles => { role => \@traits })
: (class_metaroles => { class => \@traits }),
@@ -1012,7 +1020,9 @@ sub do_unimport {
for my $keyword (@{ $spec->{REMOVABLES} }) {
next if !exists $stash->{$keyword};
my $gv = \$stash->{$keyword};
- if(ref($gv) eq 'GLOB' && *{$gv}{CODE} == $spec->{EXPORTS}{$keyword}){ # make sure it is from us
+
+ # remove what is from us
+ if(ref($gv) eq 'GLOB' && *{$gv}{CODE} == $spec->{EXPORTS}{$keyword}){
delete $stash->{$keyword};
}
}
@@ -1034,12 +1044,12 @@ sub _get_caller_package {
}
}
-#sub _spec{ %SPEC }
-
-# Contents of Mouse::Util
+}
+BEGIN{ # lib/TB2/Mouse/Util.pm
package TB2::Mouse::Util;
use TB2::Mouse::Exporter; # enables strict and warnings
-no warnings 'once';
+
+# Note that those which don't exist here are defined in XS or TB2::Mouse::PurePerl
# must be here because it will be refered by other modules loaded
sub get_linear_isa($;$); ## no critic
@@ -1083,16 +1093,16 @@ BEGIN{
groups => {
default => [], # export no functions by default
- # The ':meta' group is 'use metaclass' for Mousse
+ # The ':meta' group is 'use metaclass' for Mouse
meta => [qw(does meta dump throw_error)],
},
);
- our $VERSION = '1.005000_005';
+ our $VERSION = '1.08';
my $xs = !(defined(&is_valid_class_name) || $ENV{MOUSE_PUREPERL} || $ENV{PERL_ONLY});
- # Because TB2::Mouse::Util is loaded first in all the TB2::Mouse sub-modules,
+ # Because TB2::Mouse::Util is loaded first in all the Mouse sub-modules,
# XSLoader must be placed here, not in TB2/Mouse.pm.
if($xs){
# XXX: XSLoader tries to get the object path from caller's file name
@@ -1115,62 +1125,14 @@ BEGIN{
}
*MOUSE_XS = sub(){ $xs };
-}
-use Carp ();
-use Scalar::Util ();
-
-# aliases as public APIs
-# it must be 'require', not 'use', because TB2::Mouse::Meta::Module depends on TB2::Mouse::Util
-require TB2::Mouse::Meta::Module; # for the entities of metaclass cache utilities
-
-# aliases
-{
- *class_of = \&TB2::Mouse::Meta::Module::_class_of;
- *get_metaclass_by_name = \&TB2::Mouse::Meta::Module::_get_metaclass_by_name;
- *get_all_metaclass_instances = \&TB2::Mouse::Meta::Module::_get_all_metaclass_instances;
- *get_all_metaclass_names = \&TB2::Mouse::Meta::Module::_get_all_metaclass_names;
-
- *TB2::Mouse::load_class = \&load_class;
- *TB2::Mouse::is_class_loaded = \&is_class_loaded;
-
- # is-a predicates
- #generate_isa_predicate_for('TB2::Mouse::Meta::TypeConstraint' => 'is_a_type_constraint');
- #generate_isa_predicate_for('TB2::Mouse::Meta::Class' => 'is_a_metaclass');
- #generate_isa_predicate_for('TB2::Mouse::Meta::Role' => 'is_a_metarole');
-
- # duck type predicates
- generate_can_predicate_for(['_compiled_type_constraint'] => 'is_a_type_constraint');
- generate_can_predicate_for(['create_anon_class'] => 'is_a_metaclass');
- generate_can_predicate_for(['create_anon_role'] => 'is_a_metarole');
-}
-
-our $in_global_destruction = 0;
-END{ $in_global_destruction = 1 }
-
-# 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 || 'TB2::Mouse::Meta::Class')->throw_error("You must supply a role name to does()");
-
- return defined($meta) && $meta->does_role($role_name);
-}
-
-BEGIN {
+ # definition of mro::get_linear_isa()
my $get_linear_isa;
- if ($] >= 5.009_005) {
+ if ($] >= 5.010_000) {
require mro;
$get_linear_isa = \&mro::get_linear_isa;
- } else {
+ }
+ else {
# this code is based on MRO::Compat::__get_linear_isa
my $_get_linear_isa_dfs; # this recurses so it isn't pretty
$_get_linear_isa_dfs = sub {
@@ -1218,6 +1180,75 @@ BEGIN {
*get_linear_isa = $get_linear_isa;
}
+use Carp ();
+use Scalar::Util ();
+
+# aliases as public APIs
+# it must be 'require', not 'use', because TB2::Mouse::Meta::Module depends on TB2::Mouse::Util
+require TB2::Mouse::Meta::Module; # for the entities of metaclass cache utilities
+
+# aliases
+{
+ *class_of = \&TB2::Mouse::Meta::Module::_class_of;
+ *get_metaclass_by_name = \&TB2::Mouse::Meta::Module::_get_metaclass_by_name;
+ *get_all_metaclass_instances = \&TB2::Mouse::Meta::Module::_get_all_metaclass_instances;
+ *get_all_metaclass_names = \&TB2::Mouse::Meta::Module::_get_all_metaclass_names;
+
+ *TB2::Mouse::load_class = \&load_class;
+ *TB2::Mouse::is_class_loaded = \&is_class_loaded;
+
+ # is-a predicates
+ #generate_isa_predicate_for('TB2::Mouse::Meta::TypeConstraint' => 'is_a_type_constraint');
+ #generate_isa_predicate_for('TB2::Mouse::Meta::Class' => 'is_a_metaclass');
+ #generate_isa_predicate_for('TB2::Mouse::Meta::Role' => 'is_a_metarole');
+
+ # duck type predicates
+ generate_can_predicate_for(['_compiled_type_constraint'] => 'is_a_type_constraint');
+ generate_can_predicate_for(['create_anon_class'] => 'is_a_metaclass');
+ generate_can_predicate_for(['create_anon_role'] => 'is_a_metarole');
+}
+
+sub in_global_destruction;
+
+if (defined ${^GLOBAL_PHASE}) {
+ *in_global_destruction = sub {
+ return ${^GLOBAL_PHASE} eq 'DESTRUCT';
+ };
+}
+else {
+ my $in_global_destruction = 0;
+ END { $in_global_destruction = 1 }
+ *in_global_destruction = sub {
+ return $in_global_destruction;
+ };
+}
+
+# Moose::Util compatible utilities
+
+sub find_meta{
+ return class_of( $_[0] );
+}
+
+sub _does_role_impl {
+ my ($class_or_obj, $role_name) = @_;
+
+ my $meta = class_of($class_or_obj);
+
+ (defined $role_name)
+ || ($meta || 'TB2::Mouse::Meta::Class')->throw_error("You must supply a role name to does()");
+
+ return defined($meta) && $meta->does_role($role_name);
+}
+
+sub does_role {
+ my($thing, $role_name) = @_;
+
+ if( (Scalar::Util::blessed($thing) || is_class_loaded($thing))
+ && $thing->can('does')) {
+ return $thing->does($role_name);
+ }
+ goto &_does_role_impl;
+}
# taken from TB2::Mouse::Util (0.90)
{
@@ -1252,6 +1283,7 @@ sub get_code_info;
sub get_code_package;
sub is_valid_class_name;
+sub is_class_loaded;
# taken from Class/MOP.pm
sub load_first_existing_class {
@@ -1310,7 +1342,6 @@ sub load_class {
return $class;
}
-sub is_class_loaded;
sub apply_all_roles {
my $consumer = Scalar::Util::blessed($_[0])
@@ -1339,7 +1370,7 @@ sub apply_all_roles {
push @roles, [ $role => undef ];
}
is_a_metarole($role)
- || $consumer->meta->throw_error("You can only consume roles, $role_name is not a TB2::Mouse role");
+ || $consumer->meta->throw_error("You can only consume roles, $role_name is not a Mouse role");
}
if ( scalar @roles == 1 ) {
@@ -1377,7 +1408,7 @@ sub not_supported{
$feature ||= ( caller(1) )[3] . '()'; # subroutine name
local $Carp::CarpLevel = $Carp::CarpLevel + 1;
- Carp::confess("TB2::Mouse does not currently support $feature");
+ Carp::confess("Mouse does not currently support $feature");
}
# general meta() method
@@ -1416,10 +1447,11 @@ sub dump :method {
# general does() method
sub does :method {
- goto &does_role;
+ goto &_does_role_impl;
}
-# Contents of Mouse::Meta::TypeConstraint
+}
+BEGIN{ # lib/TB2/Mouse/Meta/TypeConstraint.pm
package TB2::Mouse::Meta::TypeConstraint;
use TB2::Mouse::Util qw(:meta); # enables strict and warnings
@@ -1571,7 +1603,7 @@ sub _compiled_type_coercion {
foreach my $pair (@coercions) {
#my ($constraint, $converter) = @$pair;
if ($pair->[0]->($thing)) {
- return $pair->[1]->($thing) for $thing;
+ return $pair->[1]->($thing) for $thing; # local $_ will cancel tie-ness due to perl's bug
}
}
return $thing;
@@ -1611,7 +1643,7 @@ sub coerce {
sub get_message {
my ($self, $value) = @_;
if ( my $msg = $self->message ) {
- return $msg->($value) for $value;
+ return $msg->($value) for $value; # local $_ will cancel tie-ness due to perl's bug
}
else {
if(not defined $value) {
@@ -1687,7 +1719,8 @@ sub _unite { # overload infix:<|>
);
}
-# Contents of Mouse::Util::TypeConstraints
+}
+BEGIN{ # lib/TB2/Mouse/Util/TypeConstraints.pm
package TB2::Mouse::Util::TypeConstraints;
use TB2::Mouse::Util; # enables strict and warnings
@@ -1702,7 +1735,7 @@ TB2::Mouse::Exporter->setup_import_methods(
as where message optimize_as
from via
- type subtype class_type role_type duck_type
+ type subtype class_type role_type maybe_type duck_type
enum
coerce
@@ -1830,7 +1863,7 @@ sub _define_type {
my $this = $args{package_defined_in};
if(!$this){
$this = caller(1);
- if($this !~ /\A TB2::Mouse \b/xms){
+ if($this !~ /\A Mouse \b/xms){
$args{package_defined_in} = $this;
}
}
@@ -1909,6 +1942,11 @@ sub role_type {
);
}
+sub maybe_type {
+ my $param = shift;
+ return _find_or_create_parameterized_type($TYPE{Maybe}, $param);
+}
+
sub duck_type {
my($name, @methods);
@@ -2102,27 +2140,28 @@ sub find_or_parse_type_constraint {
}
sub find_or_create_does_type_constraint{
- # XXX: Moose does not register a new role_type, but TB2::Mouse does.
+ # XXX: Moose does not register a new role_type, but Mouse does.
my $tc = find_or_parse_type_constraint(@_);
return defined($tc) ? $tc : role_type(@_);
}
sub find_or_create_isa_type_constraint {
- # XXX: Moose does not register a new class_type, but TB2::Mouse does.
+ # XXX: Moose does not register a new class_type, but Mouse does.
my $tc = find_or_parse_type_constraint(@_);
return defined($tc) ? $tc : class_type(@_);
}
-# Contents of Mouse
-package TB2::Mouse::TOP;
+}
+BEGIN{ # lib/TB2/Mouse.pm
+package TB2::Mouse;
use 5.006_002;
use TB2::Mouse::Exporter; # enables strict and warnings
-our $VERSION = '0.87';
+our $VERSION = '1.08';
-use Carp qw(confess);
-use Scalar::Util qw(blessed);
+use Carp ();
+use Scalar::Util ();
use TB2::Mouse::Util ();
@@ -2255,14 +2294,15 @@ sub init_meta {
$meta->superclasses($base_class)
unless $meta->superclasses;
- # make a class type for each TB2::Mouse class
+ # make a class type for each Mouse class
TB2::Mouse::Util::TypeConstraints::class_type($class)
unless TB2::Mouse::Util::TypeConstraints::find_type_constraint($class);
return $meta;
}
-# Contents of Mouse::Meta::Attribute
+}
+BEGIN{ # lib/TB2/Mouse/Meta/Attribute.pm
package TB2::Mouse::Meta::Attribute;
use TB2::Mouse::Util qw(:meta); # enables strict and warnings
@@ -2301,7 +2341,7 @@ my %valid_options = map { $_ => undef } (
'associated_methods',
'__METACLASS__',
- # Moose defines, but TB2::Mouse doesn't
+ # Moose defines, but Mouse doesn't
#'definition_context',
#'initializer',
@@ -2520,8 +2560,15 @@ sub install_accessors{
if(exists $attribute->{$type}){
my $generator = '_generate_' . $type;
my $code = $accessor_class->$generator($attribute, $metaclass);
- $metaclass->add_method($attribute->{$type} => $code);
- $attribute->associate_method($attribute->{$type});
+ my $name = $attribute->{$type};
+# TODO: do something for compatibility
+# if( $metaclass->name->can($name) ) {
+# my $t = $metaclass->has_method($name) ? 'method' : 'function';
+# Carp::cluck("You are overwriting a locally defined $t"
+# . " ($name) with an accessor");
+# }
+ $metaclass->add_method($name => $code);
+ $attribute->associate_method($name);
}
}
@@ -2598,17 +2645,17 @@ sub _make_delegation_method {
->_generate_delegation($self, $handle, $method_to_call);
}
-# Contents of Mouse::Meta::Class
+}
+BEGIN{ # lib/TB2/Mouse/Meta/Class.pm
package TB2::Mouse::Meta::Class;
use TB2::Mouse::Util qw/:meta/; # enables strict and warnings
-no warnings 'once';
use Scalar::Util ();
use TB2::Mouse::Meta::Module;
our @ISA = qw(TB2::Mouse::Meta::Module);
-our @CARP_NOT = qw(TB2::Mouse); # trust Mousse
+our @CARP_NOT = qw(Mouse); # trust Mouse
sub attribute_metaclass;
sub method_metaclass;
@@ -2673,7 +2720,7 @@ sub verify_superclass {
if(defined $super_meta) {
if(TB2::Mouse::Util::is_a_metarole($super_meta)){
- $self->throw_error("You cannot inherit from a TB2::Mouse Role ($super)");
+ $self->throw_error("You cannot inherit from a Mouse Role ($super)");
}
}
else {
@@ -2695,9 +2742,11 @@ sub verify_superclass {
sub inherit_from_foreign_class {
my($class, $super) = @_;
- Carp::carp("You inherit from non-TB2::Mouse class ($super),"
- . " but it is unlikely to work correctly."
- . " Please consider using TB2::MouseX::Foreign");
+ if($ENV{PERL_MOUSE_STRICT}) {
+ Carp::carp("You inherit from non-Mouse class ($super),"
+ . " but it is unlikely to work correctly."
+ . " Please consider using MouseX::Foreign");
+ }
return;
}
@@ -3012,9 +3061,9 @@ sub add_override_method_modifier {
or $self->throw_error("You cannot override '$name' because it has no super method");
$self->add_method($name => sub {
- local $TB2::Mouse::TOP::SUPER_PACKAGE = $package;
- local $TB2::Mouse::TOP::SUPER_BODY = $super_body;
- local @TB2::Mouse::TOP::SUPER_ARGS = @_;
+ local $TB2::Mouse::SUPER_PACKAGE = $package;
+ local $TB2::Mouse::SUPER_BODY = $super_body;
+ local @TB2::Mouse::SUPER_ARGS = @_;
&{$code};
});
return;
@@ -3033,8 +3082,8 @@ sub add_augment_method_modifier {
my $super_body = $super->body;
$self->add_method($name => sub {
- local $TB2::Mouse::TOP::INNER_BODY{$super_package} = $code;
- local $TB2::Mouse::TOP::INNER_ARGS{$super_package} = [@_];
+ local $TB2::Mouse::INNER_BODY{$super_package} = $code;
+ local $TB2::Mouse::INNER_ARGS{$super_package} = [@_];
&{$super_body};
});
return;
@@ -3061,7 +3110,8 @@ sub does_role {
return 0;
}
-# Contents of Mouse::Meta::Method
+}
+BEGIN{ # lib/TB2/Mouse/Meta/Method.pm
package TB2::Mouse::Meta::Method;
use TB2::Mouse::Util qw(:meta); # enables strict and warnings
use Scalar::Util ();
@@ -3109,7 +3159,8 @@ sub _equal {
&& $l->package_name eq $r->package_name;
}
-# Contents of Mouse::Meta::Method::Accessor
+}
+BEGIN{ # lib/TB2/Mouse/Meta/Method/Accessor.pm
package TB2::Mouse::Meta::Method::Accessor;
use TB2::Mouse::Util qw(:meta); # enables strict and warnings
@@ -3174,6 +3225,7 @@ sub _generate_accessor_any{
# this setter
$accessor .= 'return ' if !$is_weak && !$trigger && !$should_deref;
+ $accessor .= "my \@old_value = exists $slot ? $slot : ();\n" if $trigger;
$accessor .= "$slot = $value;\n";
if ($is_weak) {
@@ -3181,7 +3233,7 @@ sub _generate_accessor_any{
}
if ($trigger) {
- $accessor .= '$trigger->('.$self.', '.$value.');' . "\n";
+ $accessor .= '$trigger->('.$self.', '.$value.', @old_value);' . "\n";
}
$accessor .= "}\n";
@@ -3290,7 +3342,8 @@ sub _generate_clearer {
};
}
-# Contents of Mouse::Meta::Method::Constructor
+}
+BEGIN{ # lib/TB2/Mouse/Meta/Method/Constructor.pm
package TB2::Mouse::Meta::Method::Constructor;
use TB2::Mouse::Util qw(:meta); # enables strict and warnings
@@ -3380,10 +3433,6 @@ sub _generate_initialize_object {
$post_process .= "\$checks[$index]->($instance_slot)\n";
$post_process .= " or $attr_var->_throw_type_constraint_error($instance_slot, $constraint_var);\n";
}
- if($is_weak_ref){
- $post_process = "Scalar::Util::weaken($instance_slot) "
- . "if ref $instance_slot;\n";
- }
# build cde for an attribute
if (defined $init_arg) {
@@ -3444,6 +3493,11 @@ sub _generate_initialize_object {
$code .= "}\n" if defined $init_arg;
+ if($is_weak_ref){
+ $code .= "Scalar::Util::weaken($instance_slot) "
+ . "if ref $instance_slot and not Scalar::Util::isweak($instance_slot);\n";
+ }
+
push @res, $code;
}
@@ -3516,7 +3570,8 @@ sub _generate_BUILDALL {
return join "\n", @code;
}
-# Contents of Mouse::Meta::Method::Delegation
+}
+BEGIN{ # lib/TB2/Mouse/Meta/Method/Delegation.pm
package TB2::Mouse::Meta::Method::Delegation;
use TB2::Mouse::Util qw(:meta); # enables strict and warnings
use Scalar::Util;
@@ -3571,7 +3626,8 @@ sub _generate_delegation{
}
-# Contents of Mouse::Meta::Method::Destructor
+}
+BEGIN{ # lib/TB2/Mouse/Meta/Method/Destructor.pm
package TB2::Mouse::Meta::Method::Destructor;
use TB2::Mouse::Util qw(:meta); # enables strict and warnings
@@ -3584,7 +3640,7 @@ sub _generate_destructor{
for my $class ($metaclass->linearized_isa) {
if (TB2::Mouse::Util::get_code_ref($class, 'DEMOLISH')) {
$demolishall .= ' ' . $class
- . '::DEMOLISH($self, $TB2::Mouse::Util::in_global_destruction);'
+ . '::DEMOLISH($self, TB2::Mouse::Util::in_global_destruction());'
. "\n",
}
}
@@ -3630,10 +3686,10 @@ EOT
return $code;
}
-# Contents of Mouse::Meta::Module
+}
+BEGIN{ # lib/TB2/Mouse/Meta/Module.pm
package TB2::Mouse::Meta::Module;
use TB2::Mouse::Util qw/:meta/; # enables strict and warnings
-no warnings 'once';
use Carp ();
use Scalar::Util ();
@@ -3710,7 +3766,7 @@ sub get_attribute_list{ keys %{$_[0]->{attributes}} }
# XXX: not completely compatible with Moose
my %foreign = map{ $_ => undef } qw(
- TB2::Mouse TB2::Mouse::Role TB2::Mouse::Util TB2::Mouse::Util::TypeConstraints
+ Mouse TB2::Mouse::Role TB2::Mouse::Util TB2::Mouse::Util::TypeConstraints
Carp Scalar::Util List::Util
);
sub _get_method_body {
@@ -3762,7 +3818,7 @@ sub get_method_list {
return grep { $self->has_method($_) } keys %{ $self->namespace };
}
-sub _collect_methods { # TB2::Mouse specific, used for method modifiers
+sub _collect_methods { # Mouse specific, used for method modifiers
my($meta, @args) = @_;
my @methods;
@@ -3906,7 +3962,7 @@ sub create {
sub DESTROY{
my($self) = @_;
- return if $TB2::Mouse::Util::in_global_destruction;
+ return if TB2::Mouse::Util::in_global_destruction();
my $serial_id = $self->{anon_serial_id};
return if !$serial_id;
@@ -3936,7 +3992,8 @@ sub DESTROY{
}
-# Contents of Mouse::Meta::Role
+}
+BEGIN{ # lib/TB2/Mouse/Meta/Role.pm
package TB2::Mouse::Meta::Role;
use TB2::Mouse::Util qw(:meta); # enables strict and warnings
@@ -4061,7 +4118,8 @@ sub does_role {
return 0;
}
-# Contents of Mouse::Meta::Role::Application
+}
+BEGIN{ # lib/TB2/Mouse/Meta/Role/Application.pm
package TB2::Mouse::Meta::Role::Application;
use TB2::Mouse::Util qw(:meta);
@@ -4264,7 +4322,8 @@ sub _append_roles {
}
return;
}
-# Contents of Mouse::Meta::Role::Composite
+}
+BEGIN{ # lib/TB2/Mouse/Meta/Role/Composite.pm
package TB2::Mouse::Meta::Role::Composite;
use TB2::Mouse::Util; # enables strict and warnings
use TB2::Mouse::Meta::Role;
@@ -4273,7 +4332,7 @@ our @ISA = qw(TB2::Mouse::Meta::Role);
# FIXME: TB2::Mouse::Meta::Role::Composite does things in different way from Moose's
# Moose: creates a new class for the consumer, and applies roles to it.
-# TB2::Mouse: creates a coposite role and apply roles to the role,
+# Mouse: creates a coposite role and apply roles to the role,
# and then applies it to the consumer.
sub new {
@@ -4414,7 +4473,8 @@ sub apply_methods {
}
package TB2::Mouse::Meta::Role::Composite;
-# Contents of Mouse::Meta::Role::Method
+}
+BEGIN{ # lib/TB2/Mouse/Meta/Role/Method.pm
package TB2::Mouse::Meta::Role::Method;
use TB2::Mouse::Util; # enables strict and warnings
@@ -4431,18 +4491,26 @@ sub _new{
return $self;
}
-# Contents of Mouse::Object
+}
+BEGIN{ # lib/TB2/Mouse/Object.pm
package TB2::Mouse::Object;
use TB2::Mouse::Util qw(does dump meta); # enables strict and warnings
# all the stuff are defined in XS or PP
-# Contents of Mouse::Role
+
+sub DOES {
+ my($self, $class_or_role_name) = @_;
+ return $self->isa($class_or_role_name) || $self->does($class_or_role_name);
+}
+
+}
+BEGIN{ # lib/TB2/Mouse/Role.pm
package TB2::Mouse::Role;
use TB2::Mouse::Exporter; # enables strict and warnings
-our $VERSION = '0.87';
+our $VERSION = '1.08';
-use Carp qw(confess);
-use Scalar::Util qw(blessed);
+use Carp ();
+use Scalar::Util ();
use TB2::Mouse ();
@@ -4513,8 +4581,8 @@ sub around {
sub super {
- return if !defined $TB2::Mouse::TOP::SUPER_BODY;
- $TB2::Mouse::TOP::SUPER_BODY->(@TB2::Mouse::TOP::SUPER_ARGS);
+ return if !defined $TB2::Mouse::SUPER_BODY;
+ $TB2::Mouse::SUPER_BODY->(@TB2::Mouse::SUPER_ARGS);
}
sub override {
@@ -4558,14 +4626,15 @@ sub init_meta{
$metaclass->initialize(ref($_[0]) || $_[0]);
});
- # make a role type for each TB2::Mouse role
+ # make a role type for each Mouse role
TB2::Mouse::Util::TypeConstraints::role_type($class)
unless TB2::Mouse::Util::TypeConstraints::find_type_constraint($class);
return $meta;
}
-# Contents of Mouse::Util::MetaRole
+}
+BEGIN{ # lib/TB2/Mouse/Util/MetaRole.pm
package TB2::Mouse::Util::MetaRole;
use TB2::Mouse::Util; # enables strict and warnings
use Scalar::Util ();
@@ -4710,12 +4779,14 @@ sub _make_new_class {
)->name();
}
-;
-
-package TB2::Mouse;
+}
+END_OF_TINY
+ die $@ if $@;
+} # unless TB2/Mouse.pm is loaded
+package TB2::Mouse::Tiny;
-our $VERSION = '0.12';
+our $VERSION = '1.08';
-TB2::Mouse::Exporter->setup_import_methods(also => 'TB2::Mouse::TOP');
+TB2::Mouse::Exporter->setup_import_methods(also => 'TB2::Mouse');
1;
Please sign in to comment.
Something went wrong with that request. Please try again.