package Sub::Op;

use 5.010;

use strict;
use warnings;

our ($VERSION, @ISA);

sub dl_load_flags { 0x01 }

BEGIN {
 $VERSION = '0.01';
 require DynaLoader;
 push @ISA, 'DynaLoader';
 __PACKAGE__->bootstrap($VERSION);
}

use B::Hooks::EndOfScope;
use Variable::Magic 0.08;

my $placeholder;
BEGIN {
 $placeholder = sub { require Carp; Carp::croak('PLACEHOLDER') };
 _placeholder($placeholder);
}

my $sw = Variable::Magic::wizard(
 data  => sub { +{ guard => 0, pkg => $_[1], map => $_[2] } },
 fetch => sub {
  my ($var, $data, $name) = @_;

  return if $data->{guard};
  local $data->{guard} = 1;

  return unless $data->{map}->{$name};

  my $pkg = $data->{pkg};
  my $fqn = join '::', $pkg, $name;

  _incoming($name, $pkg);

  no strict 'refs';
  *$fqn = $placeholder unless exists &$fqn;

  return;
 },
);

sub _map {
 my ($pkg) = @_;

 my $data = do {
  no strict 'refs';
  Variable::Magic::getdata(%{"${pkg}::"}, $sw);
 };

 defined $data ? $data->{map} : undef;
}

sub _cast {
 my ($pkg, $name) = @_;

 no strict 'refs';
 Variable::Magic::cast(%{"${pkg}::"}, $sw, $pkg, { $name => 1 });
}

sub _dispell {
 my ($pkg) = @_;

 no strict 'refs';
 Variable::Magic::dispell(%{"${pkg}::"}, $sw);
}

sub enable {
 my $name = shift;

 my $pkg = @_ > 0 ? $_[0] : caller;
 my $fqn = "${pkg}::$name";

 my $map = _map($pkg);

 if (defined $map) {
  $map->{$name} = 1;
 } else {
  _cast($pkg, $name);
 }

 $^H |= 0x00020000;
 $^H{+(__PACKAGE__)} = 1;

 on_scope_end { disable($name, $pkg) };

 return;
}

sub disable {
 my $name = shift;

 my $pkg = @_ > 0 ? $_[0] : caller;
 my $fqn = "${pkg}::$name";

 my $map = _map($pkg);

 if (defined $map) {
  delete $map->{$name};
  unless (keys %$map) {
   _dispell($pkg);
  }
 }

 return;
}

sub _inject {
 my ($pkg, $inject) = @_;

 my $stash = do { no strict 'refs'; \%{"${pkg}::"} };

 while (my ($meth, $code) = each %$inject) {
  next if exists $stash->{$meth} and (*{$stash->{$meth}}{CODE} // 0) == $code;
  no strict 'refs';
  *{"${pkg}::$meth"} = $code;
 }
}

{
 my $injector;
 BEGIN {
  $injector = Variable::Magic::wizard(
   data  => sub { +{ guard => 0, pkg => $_[1], subs => $_[2] } },
   store => sub {
    my ($stash, $data, $key) = @_;

    return if $data->{guard};
    local $data->{guard} = 1;

    _inject($data->{pkg}, $data->{subs});

    return;
   },
  );
 }

 sub _monkeypatch {
  my %B_OP_inject;

  $B_OP_inject{first} = sub {
   if (defined _custom_name($_[0])) {
    $_[0] = bless $_[0], 'B::UNOP' unless $_[0]->isa('B::UNOP');
    goto $_[0]->can('first') || die 'oops';
   }
   require Carp;
   Carp::confess('Calling B::OP->first for something that isn\'t a custom op');
  };

  $B_OP_inject{can} = sub {
   my ($obj, $meth) = @_;
   if ($meth eq 'first') {
    return undef unless defined _custom_name($obj);
   }
   $obj->SUPER::can($meth);
  };

  if (%B:: and %B::OP:: and *B::OP::type{CODE}) {
   _inject('B::OP', \%B_OP_inject);
  } else {
   Variable::Magic::cast %B::OP::, $injector, 'B::OP', \%B_OP_inject;
  }

  my $B_Deparse_inject = {
   pp_custom => sub {
    my ($self, $op, $cx) = @_;
    my $name = _custom_name($op);
    die 'unhandled custom op' unless defined $name;
    if ($op->flags & 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) {
      push @exprs, $self->deparse($kid, 6);
     }
     my $args = join(", ", @exprs);
     return "$name($args)";
    } else {
     return $name;
    }
   },
  };

  if (%B:: and %B::Deparse:: and *B::Deparse::pp_entersub{CODE}) {
   _inject('B::Deparse', $B_Deparse_inject);
  } else {
   Variable::Magic::cast %B::Deparse::, $injector, 'B::Deparse', $B_Deparse_inject;
  }
 }
}

BEGIN { _monkeypatch() }

1; # End of Sub::Op
