From: Stevan Little Date: Mon, 19 May 2008 01:31:54 +0000 (+0000) Subject: no more XS mah! X-Git-Tag: 0_55~165 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1b2aea393ea1e336731ca6831f57e17615f769d9;p=gitmo%2FMoose.git no more XS mah! --- diff --git a/Changes b/Changes index 5356b09..10fdfef 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,18 @@ Revision history for Perl extension Moose 0.45 + * Moose + - Because of work in Class::MOP 0.56, all + XS based functionality is now optional + and a Pure Perl version is supplied + - the CLASS_MOP_NO_XS environment variable + can now be used to force non-XS versions + to always be used + - several of the packages have been tweaked + to take care of this, mostly we added + support for the package_name and name + variables in all the Method metaclasses + * Moose::Meta::Class - added same 'add_package_symbol' fix as in Class::MOP 0.56 diff --git a/Makefile.PL b/Makefile.PL index 27b778b..2353770 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -13,7 +13,6 @@ my $win32 = !! ( $^O eq 'Win32' or $^O eq 'cygwin' ); requires 'Scalar::Util' => $win32 ? '1.17' : '1.18'; requires 'Carp'; requires 'Class::MOP' => '0.56'; -requires 'Sub::Name' => '0.02'; requires 'Sub::Exporter' => '0.972'; # only used by oose.pm, not Moose.pm :P diff --git a/README b/README index a8f5ab2..8bbb2df 100644 --- a/README +++ b/README @@ -19,7 +19,6 @@ This module requires these other modules and libraries: Class::MOP Scalar::Util Carp - Sub::Name Sub::Exporter B diff --git a/lib/Moose.pm b/lib/Moose.pm index 6dac490..cf00150 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -9,12 +9,11 @@ our $AUTHORITY = 'cpan:STEVAN'; use Scalar::Util 'blessed', 'reftype'; use Carp 'confess', 'croak', 'cluck'; -use Sub::Name 'subname'; use Sub::Exporter; use MRO::Compat; -use Class::MOP; +use Class::MOP 0.56; use Moose::Meta::Class; use Moose::Meta::TypeConstraint; @@ -80,7 +79,7 @@ use Moose::Util (); my %exports = ( extends => sub { my $class = $CALLER; - return subname 'Moose::extends' => sub (@) { + return Class::MOP::subname('Moose::extends' => sub (@) { confess "Must derive at least one class" unless @_; my @supers = @_; @@ -93,64 +92,64 @@ use Moose::Util (); # of sync when the classes are being built my $meta = $class->meta->_fix_metaclass_incompatability(@supers); $meta->superclasses(@supers); - }; + }); }, with => sub { my $class = $CALLER; - return subname 'Moose::with' => sub (@) { + return Class::MOP::subname('Moose::with' => sub (@) { Moose::Util::apply_all_roles($class->meta, @_) - }; + }); }, has => sub { my $class = $CALLER; - return subname 'Moose::has' => sub ($;%) { + return Class::MOP::subname('Moose::has' => sub ($;%) { my $name = shift; croak 'Usage: has \'name\' => ( key => value, ... )' if @_ == 1; my %options = @_; my $attrs = ( ref($name) eq 'ARRAY' ) ? $name : [ ($name) ]; $class->meta->add_attribute( $_, %options ) for @$attrs; - }; + }); }, before => sub { my $class = $CALLER; - return subname 'Moose::before' => sub (@&) { + return Class::MOP::subname('Moose::before' => sub (@&) { my $code = pop @_; my $meta = $class->meta; $meta->add_before_method_modifier( $_, $code ) for @_; - }; + }); }, after => sub { my $class = $CALLER; - return subname 'Moose::after' => sub (@&) { + return Class::MOP::subname('Moose::after' => sub (@&) { my $code = pop @_; my $meta = $class->meta; $meta->add_after_method_modifier( $_, $code ) for @_; - }; + }); }, around => sub { my $class = $CALLER; - return subname 'Moose::around' => sub (@&) { + return Class::MOP::subname('Moose::around' => sub (@&) { my $code = pop @_; my $meta = $class->meta; $meta->add_around_method_modifier( $_, $code ) for @_; - }; + }); }, super => sub { # FIXME can be made into goto, might break caller() for existing code - return subname 'Moose::super' => sub { return unless our $SUPER_BODY; $SUPER_BODY->(our @SUPER_ARGS) } + return Class::MOP::subname('Moose::super' => sub { return unless our $SUPER_BODY; $SUPER_BODY->(our @SUPER_ARGS) }) }, #next => sub { # return subname 'Moose::next' => sub { @_ = our @SUPER_ARGS; goto \&next::method }; #}, override => sub { my $class = $CALLER; - return subname 'Moose::override' => sub ($&) { + return Class::MOP::subname('Moose::override' => sub ($&) { my ( $name, $method ) = @_; $class->meta->add_override_method_modifier( $name => $method ); - }; + }); }, inner => sub { - return subname 'Moose::inner' => sub { + return Class::MOP::subname('Moose::inner' => sub { my $pkg = caller(); our ( %INNER_BODY, %INNER_ARGS ); @@ -162,22 +161,22 @@ use Moose::Util (); } else { return; } - }; + }); }, augment => sub { my $class = $CALLER; - return subname 'Moose::augment' => sub (@&) { + return Class::MOP::subname('Moose::augment' => sub (@&) { my ( $name, $method ) = @_; $class->meta->add_augment_method_modifier( $name => $method ); - }; + }); }, make_immutable => sub { my $class = $CALLER; - return subname 'Moose::make_immutable' => sub { + return Class::MOP::subname('Moose::make_immutable' => sub { cluck "The make_immutable keyword has been deprecated, " . "please go back to __PACKAGE__->meta->make_immutable\n"; $class->meta->make_immutable(@_); - }; + }); }, confess => sub { return \&Carp::confess; @@ -237,7 +236,6 @@ use Moose::Util (); # make sure it is from Moose my ($pkg_name) = Class::MOP::get_code_info($keyword); - next if $@; next if $pkg_name ne 'Moose'; # and if it is from Moose then undef the slot diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index 0b4af49..1707392 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -6,10 +6,9 @@ use warnings; use Scalar::Util 'blessed', 'weaken', 'reftype'; use Carp 'confess'; -use Sub::Name 'subname'; use overload (); -our $VERSION = '0.23'; +our $VERSION = '0.24'; our $AUTHORITY = 'cpan:STEVAN'; use Moose::Meta::Method::Accessor; @@ -524,7 +523,7 @@ sub install_accessors { next if $class_name->isa("Moose::Object") and $handle =~ /^BUILD|DEMOLISH$/ || Moose::Object->can($handle); if ((reftype($method_to_call) || '') eq 'CODE') { - $associated_class->add_method($handle => subname $name, $method_to_call); + $associated_class->add_method($handle => Class::MOP::subname($name, $method_to_call)); } else { # NOTE: @@ -537,13 +536,13 @@ sub install_accessors { # delegation being actually represented # in the stack trace. # - SL - $associated_class->add_method($handle => subname $name, sub { + $associated_class->add_method($handle => Class::MOP::subname($name, sub { my $proxy = (shift)->$accessor(); (defined $proxy) || confess "Cannot delegate $handle to $method_to_call because " . "the value of " . $self->name . " is not defined"; $proxy->$method_to_call(@_); - }); + })); } } } diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index 2514d5b..6f55997 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -4,12 +4,12 @@ package Moose::Meta::Class; use strict; use warnings; -use Class::MOP; +use Class::MOP 0.56; use Carp 'confess'; use Scalar::Util 'weaken', 'blessed', 'reftype'; -our $VERSION = '0.22'; +our $VERSION = '0.23'; our $AUTHORITY = 'cpan:STEVAN'; use Moose::Meta::Method::Overriden; @@ -201,12 +201,16 @@ sub get_method_map { #next unless $self->does_role($role); } else { - next if ($pkg || '') ne $class_name && - ($name || '') ne '__ANON__'; + next if ($pkg || '') ne $class_name || + (($name || '') ne '__ANON__' && ($pkg || '') ne $class_name); } - $map->{$symbol} = $method_metaclass->wrap($code); + $map->{$symbol} = $method_metaclass->wrap( + $code, + package_name => $class_name, + name => $symbol + ); } return $map; diff --git a/lib/Moose/Meta/Method/Augmented.pm b/lib/Moose/Meta/Method/Augmented.pm index 0ef4d34..0e93e7a 100644 --- a/lib/Moose/Meta/Method/Augmented.pm +++ b/lib/Moose/Meta/Method/Augmented.pm @@ -3,15 +3,13 @@ package Moose::Meta::Method::Augmented; use strict; use warnings; -our $VERSION = '0.01'; +use Carp 'confess'; + +our $VERSION = '0.02'; our $AUTHORITY = 'cpan:STEVAN'; use base 'Moose::Meta::Method'; -use Sub::Name; - -use Carp qw(confess); - sub new { my ( $class, %args ) = @_; @@ -50,7 +48,11 @@ sub new { }; # FIXME store additional attrs - $class->wrap($body); + $class->wrap( + $body, + package_name => $meta->name, + name => $name + ); } 1; diff --git a/lib/Moose/Meta/Method/Constructor.pm b/lib/Moose/Meta/Method/Constructor.pm index 04f335b..5261e43 100644 --- a/lib/Moose/Meta/Method/Constructor.pm +++ b/lib/Moose/Meta/Method/Constructor.pm @@ -7,7 +7,7 @@ use warnings; use Carp 'confess'; use Scalar::Util 'blessed', 'weaken', 'looks_like_number'; -our $VERSION = '0.10'; +our $VERSION = '0.11'; our $AUTHORITY = 'cpan:STEVAN'; use base 'Moose::Meta::Method', @@ -20,9 +20,14 @@ sub new { (exists $options{options} && ref $options{options} eq 'HASH') || confess "You must pass a hash of options"; + ($options{package_name} && $options{name}) + || confess "You must supply the package_name and name parameters"; + my $self = bless { # from our superclass - '&!body' => undef, + '&!body' => undef, + '$!package_name' => $options{package_name}, + '$!name' => $options{name}, # specific to this subclass '%!options' => $options{options}, '$!meta_instance' => $options{metaclass}->get_meta_instance, diff --git a/lib/Moose/Meta/Method/Destructor.pm b/lib/Moose/Meta/Method/Destructor.pm index 481a85c..77a439b 100644 --- a/lib/Moose/Meta/Method/Destructor.pm +++ b/lib/Moose/Meta/Method/Destructor.pm @@ -7,7 +7,7 @@ use warnings; use Carp 'confess'; use Scalar::Util 'blessed', 'weaken'; -our $VERSION = '0.02'; +our $VERSION = '0.03'; our $AUTHORITY = 'cpan:STEVAN'; use base 'Moose::Meta::Method', @@ -19,10 +19,15 @@ sub new { (exists $options{options} && ref $options{options} eq 'HASH') || confess "You must pass a hash of options"; + + ($options{package_name} && $options{name}) + || confess "You must supply the package_name and name parameters"; my $self = bless { # from our superclass - '&!body' => undef, + '&!body' => undef, + '$!package_name' => $options{package_name}, + '$!name' => $options{name}, # ... '%!options' => $options{options}, '$!associated_metaclass' => $options{metaclass}, diff --git a/lib/Moose/Meta/Method/Overriden.pm b/lib/Moose/Meta/Method/Overriden.pm index 9ac4d95..344f804 100644 --- a/lib/Moose/Meta/Method/Overriden.pm +++ b/lib/Moose/Meta/Method/Overriden.pm @@ -3,15 +3,13 @@ package Moose::Meta::Method::Overriden; use strict; use warnings; -our $VERSION = '0.01'; +use Carp 'confess'; + +our $VERSION = '0.02'; our $AUTHORITY = 'cpan:STEVAN'; use base 'Moose::Meta::Method'; -use Sub::Name; - -use Carp qw(confess); - sub new { my ( $class, %args ) = @_; @@ -42,7 +40,11 @@ sub new { # subname "${_super_package}::${name}", $method; # FIXME store additional attrs - $class->wrap($body); + $class->wrap( + $body, + package_name => $args{class}->name, + name => $name + ); } 1; diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm index d7270ca..1d0d8bc 100644 --- a/lib/Moose/Meta/Role.pm +++ b/lib/Moose/Meta/Role.pm @@ -5,11 +5,10 @@ use strict; use warnings; use metaclass; -use Sub::Name 'subname'; use Carp 'confess'; use Scalar::Util 'blessed', 'reftype'; -our $VERSION = '0.12'; +our $VERSION = '0.13'; our $AUTHORITY = 'cpan:STEVAN'; use Moose::Meta::Class; @@ -311,11 +310,15 @@ sub get_method_map { next unless $self->does_role($role); } else { - next if ($pkg || '') ne $role_name && - ($name || '') ne '__ANON__'; + next if ($pkg || '') ne $role_name || + (($name || '') ne '__ANON__' && ($pkg || '') ne $role_name); } - $map->{$symbol} = $method_metaclass->wrap($code); + $map->{$symbol} = $method_metaclass->wrap( + $code, + package_name => $role_name, + name => $name + ); } return $map; diff --git a/lib/Moose/Meta/Role/Composite.pm b/lib/Moose/Meta/Role/Composite.pm index 281e9dc..ba719e1 100644 --- a/lib/Moose/Meta/Role/Composite.pm +++ b/lib/Moose/Meta/Role/Composite.pm @@ -7,7 +7,7 @@ use metaclass; use Carp 'confess'; use Scalar::Util 'blessed', 'reftype'; -our $VERSION = '0.01'; +our $VERSION = '0.02'; our $AUTHORITY = 'cpan:STEVAN'; use base 'Moose::Meta::Role'; @@ -54,8 +54,11 @@ sub alias_method { # make sure to bless the # method if nessecary - $method = $self->method_metaclass->wrap($method) - if !blessed($method); + $method = $self->method_metaclass->wrap( + $method, + package_name => $self->name, + name => $method_name + ) if !blessed($method); $self->get_method_map->{$method_name} = $method; } diff --git a/lib/Moose/Meta/TypeConstraint.pm b/lib/Moose/Meta/TypeConstraint.pm index cc12df9..34bc437 100644 --- a/lib/Moose/Meta/TypeConstraint.pm +++ b/lib/Moose/Meta/TypeConstraint.pm @@ -8,11 +8,10 @@ use metaclass; use overload '""' => sub { shift->name }, # stringify to tc name fallback => 1; -use Sub::Name 'subname'; use Carp 'confess'; use Scalar::Util qw(blessed refaddr); -our $VERSION = '0.12'; +our $VERSION = '0.13'; our $AUTHORITY = 'cpan:STEVAN'; __PACKAGE__->meta->add_attribute('name' => (reader => 'name')); @@ -189,23 +188,23 @@ sub _compile_subtype { # then we compile them to run without # having to recurse as we did before - return subname $self->name => sub { + return Class::MOP::subname($self->name => sub { local $_ = $_[0]; foreach my $parent (@parents) { return undef unless $parent->($_[0]); } return undef unless $check->($_[0]); 1; - }; + }); } sub _compile_type { my ($self, $check) = @_; - return subname $self->name => sub { + return Class::MOP::subname($self->name => sub { local $_ = $_[0]; return undef unless $check->($_[0]); 1; - }; + }); } ## other utils ... diff --git a/lib/Moose/Role.pm b/lib/Moose/Role.pm index 062de31..c6d4b33 100644 --- a/lib/Moose/Role.pm +++ b/lib/Moose/Role.pm @@ -6,12 +6,11 @@ use warnings; use Scalar::Util 'blessed'; use Carp 'confess'; -use Sub::Name 'subname'; use Data::OptList; use Sub::Exporter; -our $VERSION = '0.08'; +our $VERSION = '0.09'; our $AUTHORITY = 'cpan:STEVAN'; use Moose (); @@ -49,83 +48,83 @@ use Moose::Util::TypeConstraints; my %exports = ( extends => sub { my $meta = _find_meta(); - return subname 'Moose::Role::extends' => sub { + return Class::MOP::subname('Moose::Role::extends' => sub { confess "Moose::Role does not currently support 'extends'" - }; + }); }, with => sub { my $meta = _find_meta(); - return subname 'Moose::Role::with' => sub (@) { + return Class::MOP::subname('Moose::Role::with' => sub (@) { Moose::Util::apply_all_roles($meta, @_) - }; + }); }, requires => sub { my $meta = _find_meta(); - return subname 'Moose::Role::requires' => sub (@) { + return Class::MOP::subname('Moose::Role::requires' => sub (@) { confess "Must specify at least one method" unless @_; $meta->add_required_methods(@_); - }; + }); }, excludes => sub { my $meta = _find_meta(); - return subname 'Moose::Role::excludes' => sub (@) { + return Class::MOP::subname('Moose::Role::excludes' => sub (@) { confess "Must specify at least one role" unless @_; $meta->add_excluded_roles(@_); - }; + }); }, has => sub { my $meta = _find_meta(); - return subname 'Moose::Role::has' => sub ($;%) { + return Class::MOP::subname('Moose::Role::has' => sub ($;%) { my ($name, %options) = @_; $meta->add_attribute($name, %options) - }; + }); }, before => sub { my $meta = _find_meta(); - return subname 'Moose::Role::before' => sub (@&) { + return Class::MOP::subname('Moose::Role::before' => sub (@&) { my $code = pop @_; $meta->add_before_method_modifier($_, $code) for @_; - }; + }); }, after => sub { my $meta = _find_meta(); - return subname 'Moose::Role::after' => sub (@&) { + return Class::MOP::subname('Moose::Role::after' => sub (@&) { my $code = pop @_; $meta->add_after_method_modifier($_, $code) for @_; - }; + }); }, around => sub { my $meta = _find_meta(); - return subname 'Moose::Role::around' => sub (@&) { + return Class::MOP::subname('Moose::Role::around' => sub (@&) { my $code = pop @_; $meta->add_around_method_modifier($_, $code) for @_; - }; + }); }, # see Moose.pm for discussion super => sub { - return subname 'Moose::Role::super' => sub { return unless $Moose::SUPER_BODY; $Moose::SUPER_BODY->(@Moose::SUPER_ARGS) } + return Class::MOP::subname('Moose::Role::super' => sub { return unless $Moose::SUPER_BODY; $Moose::SUPER_BODY->(@Moose::SUPER_ARGS) }) }, #next => sub { # return subname 'Moose::Role::next' => sub { @_ = @Moose::SUPER_ARGS; goto \&next::method }; #}, override => sub { my $meta = _find_meta(); - return subname 'Moose::Role::override' => sub ($&) { + return Class::MOP::subname('Moose::Role::override' => sub ($&) { my ($name, $code) = @_; $meta->add_override_method_modifier($name, $code); - }; + }); }, inner => sub { my $meta = _find_meta(); - return subname 'Moose::Role::inner' => sub { + return Class::MOP::subname('Moose::Role::inner' => sub { confess "Moose::Role cannot support 'inner'"; - }; + }); }, augment => sub { my $meta = _find_meta(); - return subname 'Moose::Role::augment' => sub { + return Class::MOP::subname('Moose::Role::augment' => sub { confess "Moose::Role cannot support 'augment'"; - }; + }); }, confess => sub { return \&Carp::confess; diff --git a/lib/Moose/Util.pm b/lib/Moose/Util.pm index b8c5f0f..e63222b 100644 --- a/lib/Moose/Util.pm +++ b/lib/Moose/Util.pm @@ -6,9 +6,9 @@ use warnings; use Sub::Exporter; use Scalar::Util 'blessed'; use Carp 'confess'; -use Class::MOP (); +use Class::MOP 0.56; -our $VERSION = '0.05'; +our $VERSION = '0.06'; our $AUTHORITY = 'cpan:STEVAN'; my @exports = qw[ diff --git a/lib/oose.pm b/lib/oose.pm index e7cc8d0..188c659 100644 --- a/lib/oose.pm +++ b/lib/oose.pm @@ -3,9 +3,9 @@ package oose; use strict; use warnings; -use Class::MOP; +use Class::MOP 0.56; -our $VERSION = '0.03'; +our $VERSION = '0.04'; our $AUTHORITY = 'cpan:STEVAN'; BEGIN {