From: Peter Rabbitson Date: Tue, 24 Apr 2012 17:19:25 +0000 (+0200) Subject: initial spike towards sub naming to collaborate with namespace checks in DBIC X-Git-Tag: v0.091000~11 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=575ba24cb512a68d1c86bf1fdc3b7fead6075324;p=gitmo%2FMoo.git initial spike towards sub naming to collaborate with namespace checks in DBIC --- diff --git a/Changes b/Changes index 273687f..28f9525 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,4 @@ + - name subs if Sub::Name is available for better stracktraces - undefer all subs before creating a concrete Moose metaclass - fix bug in _load_module where global vars could cause mis-detection of the module already being loaded diff --git a/lib/Moo.pm b/lib/Moo.pm index 34be24e..ff1e20d 100644 --- a/lib/Moo.pm +++ b/lib/Moo.pm @@ -16,17 +16,17 @@ sub import { my $class = shift; strictures->import; return if $MAKERS{$target}; # already exported into this package - *{_getglob("${target}::extends")} = sub { + _install_coderef "${target}::extends" => sub { _load_module($_) for @_; # Can't do *{...} = \@_ or 5.10.0's mro.pm stops seeing @ISA @{*{_getglob("${target}::ISA")}{ARRAY}} = @_; }; - *{_getglob("${target}::with")} = sub { + _install_coderef "${target}::with" => sub { require Moo::Role; Moo::Role->apply_roles_to_package($target, $_[0]); }; $MAKERS{$target} = {}; - *{_getglob("${target}::has")} = sub { + _install_coderef "${target}::has" => sub { my ($name, %spec) = @_; ($MAKERS{$target}{accessor} ||= do { require Method::Generate::Accessor; @@ -36,7 +36,7 @@ sub import { ->register_attribute_specs($name, \%spec); }; foreach my $type (qw(before after around)) { - *{_getglob "${target}::${type}"} = sub { + _install_coderef "${target}::${type}" => sub { require Class::Method::Modifiers; _install_modifier($target, $type, @_); }; diff --git a/lib/Moo/Role.pm b/lib/Moo/Role.pm index 66a9948..914f2b7 100644 --- a/lib/Moo/Role.pm +++ b/lib/Moo/Role.pm @@ -14,7 +14,7 @@ sub import { return if $INFO{$target}; # already exported into this package # get symbol table reference my $stash = do { no strict 'refs'; \%{"${target}::"} }; - *{_getglob "${target}::has"} = sub { + _install_coderef "${target}::has" => sub { my ($name, %spec) = @_; ($INFO{$target}{accessor_maker} ||= do { require Method::Generate::Accessor; diff --git a/lib/Moo/_Utils.pm b/lib/Moo/_Utils.pm index a228805..047f6ca 100644 --- a/lib/Moo/_Utils.pm +++ b/lib/Moo/_Utils.pm @@ -5,12 +5,8 @@ no warnings 'once'; # guard against -w sub _getglob { \*{$_[0]} } sub _getstash { \%{"$_[0]::"} } -BEGIN { - *lt_5_8_3 = $] < 5.008003 - ? sub () { 1 } - : sub () { 0 } - ; -} +use constant lt_5_8_3 => ( $] < 5.008003 ) ? 1 : 0; +use constant can_haz_subname => eval { require Sub::Name }; use strictures 1; use Module::Runtime qw(require_module); @@ -19,7 +15,7 @@ use Moo::_mro; our @EXPORT = qw( _getglob _install_modifier _load_module _maybe_load_module - _get_linear_isa _getstash + _get_linear_isa _getstash _install_coderef _name_coderef ); sub _install_modifier { @@ -62,7 +58,15 @@ sub _maybe_load_module { } sub _get_linear_isa { - return mro::get_linear_isa($_[0]); + return mro::get_linear_isa($_[0]); +} + +sub _install_coderef { + *{_getglob($_[0])} = _name_coderef(@_); +} + +sub _name_coderef { + can_haz_subname ? Sub::Name::subname(@_) : $_[1]; } our $_in_global_destruction = 0; diff --git a/lib/Sub/Defer.pm b/lib/Sub/Defer.pm index 8202687..1d7b106 100644 --- a/lib/Sub/Defer.pm +++ b/lib/Sub/Defer.pm @@ -18,6 +18,9 @@ sub undefer_sub { # make sure the method slot has not changed since deferral time if (defined($target) && $deferred eq *{_getglob($target)}{CODE}||'') { no warnings 'redefine'; + + # I believe $maker already evals with the right package/name, so that + # _install_coderef calls are not necessary --ribasushi *{_getglob($target)} = $made; } push @{$DEFERRED{$made} = $DEFERRED{$deferred}}, $made; @@ -39,7 +42,7 @@ sub defer_sub { }; $deferred_string = "$deferred"; $DEFERRED{$deferred} = [ $target, $maker, \$undeferred ]; - *{_getglob $target} = $deferred if defined($target); + _install_coderef $target => $deferred if defined $target; return $deferred; }