Vivify less packages and symbols in B:: land

[perl/modules/Sub-Op.git] / lib / Sub / Op.pm

diff --git a/lib/Sub/Op.pm b/lib/Sub/Op.pm
index 8c8f6c87a4df667033ccba09f8a57db8b118221f..0085cb1eadd14bb8ba4d68ab1a8fc2b645cde6bc 100644 (file)
--- 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;
   }
  }
 }