From: Vincent Pit <vince@profvince.com>
Date: Sun, 3 Jan 2010 17:00:35 +0000 (+0100)
Subject: Vivify less packages and symbols in B:: land
X-Git-Tag: v0.02~12
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FSub-Op.git;a=commitdiff_plain;h=bef3694f4167eacd3fe677e5f72228aa3023686b

Vivify less packages and symbols in B:: land
---

diff --git a/lib/Sub/Op.pm b/lib/Sub/Op.pm
index 8c8f6c8..0085cb1 100644
--- a/lib/Sub/Op.pm
+++ b/lib/Sub/Op.pm
@@ -324,6 +324,18 @@ sub _inject {
  }
 }
 
+sub _defined_sub {
+ my ($fqn) = @_;
+ my @parts = split /::/, $fqn;
+ my $name  = pop @parts;
+ my $pkg   = '';
+ for (@parts) {
+  $pkg .= $_ . '::';
+  return 0 unless do { no strict 'refs'; %$pkg };
+ }
+ return do { no strict 'refs'; defined &{"$pkg$name"} };
+}
+
 {
  my $injector;
  BEGIN {
@@ -362,10 +374,11 @@ sub _inject {
    $obj->SUPER::can($meth);
   };
 
-  if (%B:: and %B::OP:: and *B::OP::type{CODE}) {
+  if (_defined_sub('B::OP::type')) {
    _inject('B::OP', \%B_OP_inject);
   } else {
-   Variable::Magic::cast %B::OP::, $injector, 'B::OP', \%B_OP_inject;
+   no strict 'refs';
+   Variable::Magic::cast %{'B::OP::'}, $injector, 'B::OP', \%B_OP_inject;
   }
 
   my $B_Deparse_inject = {
@@ -373,12 +386,13 @@ sub _inject {
     my ($self, $op, $cx) = @_;
     my $name = _custom_name($op);
     die 'unhandled custom op' unless defined $name;
-    if ($op->flags & B::OPf_STACKED()) {
+    if ($op->flags & do { no strict 'refs'; &{'B::OPf_STACKED'}() }) {
      my $kid = $op->first;
      $kid = $kid->first->sibling; # skip ex-list, pushmark
      my @exprs;
-     for (; not B::Deparse::null($kid); $kid = $kid->sibling) {
+     while (not do { no strict 'refs'; &{'B::Deparse::null'}($kid) }) {
       push @exprs, $self->deparse($kid, 6);
+      $kid = $kid->sibling;
      }
      my $args = join(", ", @exprs);
      return "$name($args)";
@@ -388,10 +402,11 @@ sub _inject {
    },
   };
 
-  if (%B:: and %B::Deparse:: and *B::Deparse::pp_entersub{CODE}) {
+  if (_defined_sub('B::Deparse::pp_entersub')) {
    _inject('B::Deparse', $B_Deparse_inject);
   } else {
-   Variable::Magic::cast %B::Deparse::, $injector, 'B::Deparse', $B_Deparse_inject;
+   no strict 'refs';
+   Variable::Magic::cast %{'B::Deparse::'}, $injector, 'B::Deparse', $B_Deparse_inject;
   }
  }
 }
diff --git a/t/21-monkeypatch.t b/t/21-monkeypatch.t
index faaf83a..5c08a22 100644
--- a/t/21-monkeypatch.t
+++ b/t/21-monkeypatch.t
@@ -15,15 +15,19 @@ BEGIN {
 
 use Sub::Op;
 
+sub stash_keys {
+ my ($pkg) = @_;
+
+ no strict 'refs';
+ keys %{"${pkg}::"};
+}
+
 BEGIN {
- is_deeply [ sort keys %B:: ], [ sort
+ is_deeply [ sort +stash_keys 'B' ], [ sort
   qw/OP:: Deparse:: Hooks::/,
-  qw/OPf_STACKED/,
   qw/svref_2object/,
  ], 'No extra symbols in B::';
- is_deeply [ sort keys %B::Deparse:: ], [ sort
-  qw/null pp_entersub/
- ], 'No extra symbols in B::Deparse';
+ is_deeply [ sort +stash_keys 'B::Deparse' ], [ ], 'No symbols in B::Deparse';
 }
 
 use B;