From: Matt S Trout <mst@shadowcat.co.uk>
Date: Mon, 3 Oct 2011 05:14:42 +0000 (+0000)
Subject: cleanup require usage so we don't trample on $@ and tweak the DEMOLISH code slightly
X-Git-Tag: v0.009011~4
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=59812c87b1b00da1098f22c77e02db83ff594f22;p=gitmo%2FRole-Tiny.git

cleanup require usage so we don't trample on $@ and tweak the DEMOLISH code slightly
---

diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm
index c5398cf..f8b1fbf 100644
--- a/lib/Method/Generate/Accessor.pm
+++ b/lib/Method/Generate/Accessor.pm
@@ -372,7 +372,7 @@ sub _generate_simple_set {
   my $simple = "${me}->{${name_str}} = ${value}";
 
   if ($spec->{weak_ref}) {
-    require Scalar::Util;
+    { local $@; require Scalar::Util; }
 
     # Perl < 5.8.3 can't weaken refs to readonly vars
     # (e.g. string constants). This *can* be solved by:
@@ -387,7 +387,7 @@ sub _generate_simple_set {
 
       eval { Scalar::Util::weaken($simple); 1 } or do {
         if( \$@ =~ /Modification of a read-only value attempted/) {
-          require Carp;
+          { local $@; require Carp; }
           Carp::croak( sprintf (
             'Reference to readonly value in "%s" can not be weakened on Perl < 5.8.3',
             $name_str,
diff --git a/lib/Method/Generate/Constructor.pm b/lib/Method/Generate/Constructor.pm
index 9190ea5..e4f7b1f 100644
--- a/lib/Method/Generate/Constructor.pm
+++ b/lib/Method/Generate/Constructor.pm
@@ -54,7 +54,7 @@ sub generate_method {
   $body .= '    my $new = '.$self->construction_string.";\n";
   $body .= $self->_assign_new($spec);
   if ($into->can('BUILD')) {
-    require Method::Generate::BuildAll;
+    { local $@; require Method::Generate::BuildAll; }
     $body .= Method::Generate::BuildAll->new->buildall_body_for(
       $into, '$new', '$args'
     );
diff --git a/lib/Moo.pm b/lib/Moo.pm
index d354bcc..122aca9 100644
--- a/lib/Moo.pm
+++ b/lib/Moo.pm
@@ -20,7 +20,7 @@ sub import {
     @{*{_getglob("${target}::ISA")}{ARRAY}} = @_;
   };
   *{_getglob("${target}::with")} = sub {
-    require Moo::Role;
+    { local $@; require Moo::Role; }
     die "Only one role supported at a time by with" if @_ > 1;
     Moo::Role->apply_role_to_package($target, $_[0]);
   };
@@ -28,7 +28,7 @@ sub import {
   *{_getglob("${target}::has")} = sub {
     my ($name, %spec) = @_;
     ($MAKERS{$target}{accessor} ||= do {
-      require Method::Generate::Accessor;
+      { local $@; require Method::Generate::Accessor; }
       Method::Generate::Accessor->new
     })->generate_method($target, $name, \%spec);
     $class->_constructor_maker_for($target)
@@ -36,14 +36,14 @@ sub import {
   };
   foreach my $type (qw(before after around)) {
     *{_getglob "${target}::${type}"} = sub {
-      require Class::Method::Modifiers;
+      { local $@; require Class::Method::Modifiers; }
       _install_modifier($target, $type, @_);
     };
   }
   {
     no strict 'refs';
     @{"${target}::ISA"} = do {
-      require Moo::Object; ('Moo::Object');
+      {; local $@; require Moo::Object; } ('Moo::Object');
     } unless @{"${target}::ISA"};
   }
 }
@@ -52,8 +52,11 @@ sub _constructor_maker_for {
   my ($class, $target, $select_super) = @_;
   return unless $MAKERS{$target};
   $MAKERS{$target}{constructor} ||= do {
-    require Method::Generate::Constructor;
-    require Sub::Defer;
+    {
+      local $@;
+      require Method::Generate::Constructor;
+      require Sub::Defer;
+    }
     my ($moo_constructor, $con);
 
     if ($select_super && $MAKERS{$select_super}) {
@@ -79,7 +82,7 @@ sub _constructor_maker_for {
       ->new(
         package => $target,
         accessor_generator => do {
-          require Method::Generate::Accessor;
+          { local $@; require Method::Generate::Accessor; }
           Method::Generate::Accessor->new;
         },
         construction_string => (
diff --git a/lib/Moo/Object.pm b/lib/Moo/Object.pm
index 06a86f9..fb7415d 100644
--- a/lib/Moo/Object.pm
+++ b/lib/Moo/Object.pm
@@ -3,6 +3,7 @@ package Moo::Object;
 use strictures 1;
 
 our %NO_BUILD;
+our %NO_DEMOLISH;
 our $BUILD_MAKER;
 our $DEMOLISH_MAKER;
 
@@ -41,43 +42,45 @@ sub BUILDARGS {
 sub BUILDALL {
   my $self = shift;
   $self->${\(($BUILD_MAKER ||= do {
-    require Method::Generate::BuildAll;
+    { local $@; require Method::Generate::BuildAll; }
     Method::Generate::BuildAll->new
   })->generate_method(ref($self)))}(@_);
 }
 
+sub DEMOLISHALL {
+  my $self = shift;
+  $self->${\(($DEMOLISH_MAKER ||= do {
+    { local $@; require Method::Generate::DemolishAll; }
+    Method::Generate::DemolishAll->new
+  })->generate_method(ref($self)))}(@_);
+}
+
 sub DESTROY {
-    my $self = shift;
+  my $self = shift;
 
-    return unless $self->can('DEMOLISH'); # short circuit
+  my $class = ref($self);
 
-    require Moo::_Utils;
+  $NO_DEMOLISH{$class} = !$class->can('DEMOLISH')
+    unless exists $NO_DEMOLISH{$class};
 
-    my $e = do {
-        local $?;
-        local $@;
-        eval {
-            # DEMOLISHALL
+  return if $NO_DEMOLISH{$class};
 
-            $self->DEMOLISHALL($Moo::_Utils::_in_global_destruction);
-        };
-        $@;
+  my $e = do {
+    local $?;
+    local $@;
+    require Moo::_Utils;
+    eval {
+      $self->DEMOLISHALL($Moo::_Utils::_in_global_destruction);
     };
+    $@;
+  };
 
-    no warnings 'misc';
-    die $e if $e; # rethrow
-}
-
-sub DEMOLISHALL {
-  my $self = shift;
-  $self->${\(($DEMOLISH_MAKER ||= do {
-    require Method::Generate::DemolishAll;
-    Method::Generate::DemolishAll->new
-  })->generate_method(ref($self)))}(@_);
+  no warnings 'misc';
+  die $e if $e; # rethrow
 }
 
 sub does {
-  require Role::Tiny;
+  { local $@; require Role::Tiny; }
   { no warnings 'redefine'; *does = \&Role::Tiny::does_role }
   goto &Role::Tiny::does_role;
 }
diff --git a/lib/Moo/Role.pm b/lib/Moo/Role.pm
index 5b3761f..0484277 100644
--- a/lib/Moo/Role.pm
+++ b/lib/Moo/Role.pm
@@ -17,7 +17,7 @@ sub import {
   *{_getglob "${target}::has"} = sub {
     my ($name, %spec) = @_;
     ($INFO{$target}{accessor_maker} ||= do {
-      require Method::Generate::Accessor;
+      { local $@; require Method::Generate::Accessor; }
       Method::Generate::Accessor->new
     })->generate_method($target, $name, \%spec);
     $INFO{$target}{attributes}{$name} = \%spec;
@@ -40,7 +40,7 @@ sub create_class_with_roles {
 
   return $new_name if $Role::Tiny::COMPOSED{class}{$new_name};
 
-  require Sub::Quote;
+  { local $@; require Sub::Quote; }
 
   $me->SUPER::create_class_with_roles($superclass, @roles);
 
diff --git a/lib/Moo/_Utils.pm b/lib/Moo/_Utils.pm
index 6b1a5b3..2ee545c 100644
--- a/lib/Moo/_Utils.pm
+++ b/lib/Moo/_Utils.pm
@@ -23,7 +23,7 @@ sub _install_modifier {
   my ($into, $type, $name, $code) = @_;
 
   if (my $to_modify = $into->can($name)) { # CMM will throw for us if not
-    require Sub::Defer;
+    { local $@; require Sub::Defer; }
     Sub::Defer::undefer_sub($to_modify);
   }
 
@@ -40,13 +40,14 @@ sub _load_module {
   # can't just ->can('can') because a sub-package Foo::Bar::Baz
   # creates a 'Baz::' key in Foo::Bar's symbol table
   return 1 if grep !/::$/, keys %{_getstash($_[0])||{}};
-  require "${proto}.pm";
+  { local $@; require "${proto}.pm"; }
   return 1;
 }
 
 sub _maybe_load_module {
   return $MAYBE_LOADED{$_[0]} if exists $MAYBE_LOADED{$_[0]};
   (my $proto = $_[0]) =~ s/::/\//g;
+  local $@;
   if (eval { require "${proto}.pm"; 1 }) {
     $MAYBE_LOADED{$_[0]} = 1;
   } else {
@@ -65,4 +66,20 @@ sub _get_linear_isa {
 our $_in_global_destruction = 0;
 END { $_in_global_destruction = 1 }
 
+sub STANDARD_DESTROY {
+  my $self = shift;
+
+  my $e = do {
+    local $?;
+    local $@;
+    eval {
+      $self->DEMOLISHALL($_in_global_destruction);
+    };
+    $@;
+  };
+
+  no warnings 'misc';
+  die $e if $e; # rethrow
+}
+
 1;
diff --git a/lib/Moo/_mro.pm b/lib/Moo/_mro.pm
index e599045..1cfa949 100644
--- a/lib/Moo/_mro.pm
+++ b/lib/Moo/_mro.pm
@@ -1,5 +1,7 @@
 package Moo::_mro;
 
+local $@;
+
 if ($] >= 5.010) {
   require mro;
 } else {
diff --git a/lib/Role/Tiny.pm b/lib/Role/Tiny.pm
index 98967e3..11f5778 100644
--- a/lib/Role/Tiny.pm
+++ b/lib/Role/Tiny.pm
@@ -18,7 +18,7 @@ sub _load_module {
   # can't just ->can('can') because a sub-package Foo::Bar::Baz
   # creates a 'Baz::' key in Foo::Bar's symbol table
   return 1 if grep !/::$/, keys %{_getstash($_[0])||{}};
-  require "${proto}.pm";
+  { local $@; require "${proto}.pm"; }
   return 1;
 }
 
@@ -32,7 +32,7 @@ sub import {
   # install before/after/around subs
   foreach my $type (qw(before after around)) {
     *{_getglob "${target}::${type}"} = sub {
-      require Class::Method::Modifiers;
+      { local $@; require Class::Method::Modifiers; }
       push @{$INFO{$target}{modifiers}||=[]}, [ $type => @_ ];
     };
   }
@@ -102,9 +102,9 @@ sub create_class_with_roles {
   }
 
   if ($] >= 5.010) {
-    require mro;
+    { local $@; require mro; }
   } else {
-    require MRO::Compat;
+    { local $@; require MRO::Compat; }
   }
 
   my @composable = map $me->_composable_package_for($_), reverse @roles;
@@ -142,8 +142,11 @@ sub _composable_package_for {
   ) {
     push @mod_base, "sub ${modified} { shift->next::method(\@_) }";
   }
-  eval(my $code = join "\n", "package ${base_name};", @mod_base);
-  die "Evaling failed: $@\nTrying to eval:\n${code}" if $@;
+  {
+    local $@;
+    eval(my $code = join "\n", "package ${base_name};", @mod_base);
+    die "Evaling failed: $@\nTrying to eval:\n${code}" if $@;
+  }
   $me->_install_modifiers($composed_name, $modifiers);
   $COMPOSED{role}{$composed_name} = 1;
   return $composed_name;
diff --git a/lib/Sub/Quote.pm b/lib/Sub/Quote.pm
index b3a3782..f75f79d 100644
--- a/lib/Sub/Quote.pm
+++ b/lib/Sub/Quote.pm
@@ -90,8 +90,11 @@ sub _unquote_all_outstanding {
     $ENV{SUB_QUOTE_DEBUG} && warn $assembled_code;
   }
   $assembled_code .= "\n1;";
-  unless (_clean_eval $assembled_code, \@assembled_captures) {
-    die "Eval went very, very wrong:\n\n${debug_code}\n\n$@";
+  {
+    local $@;
+    unless (_clean_eval $assembled_code, \@assembled_captures) {
+      die "Eval went very, very wrong:\n\n${debug_code}\n\n$@";
+    }
   }
   $ENV{SUB_QUOTE_DEBUG} && warn $debug_code;
   %QUOTE_OUTSTANDING = ();