10 sub dl_load_flags { 0x01 }
15 push @ISA, 'DynaLoader';
16 __PACKAGE__->bootstrap($VERSION);
19 use B::Hooks::EndOfScope;
20 use Variable::Magic 0.08;
24 $placeholder = sub { require Carp; Carp::croak('PLACEHOLDER') };
25 _placeholder($placeholder);
28 my $sw = Variable::Magic::wizard(
29 data => sub { +{ guard => 0, pkg => $_[1], map => $_[2] } },
31 my ($var, $data, $name) = @_;
33 return if $data->{guard};
34 local $data->{guard} = 1;
36 return unless $data->{map}->{$name};
38 my $pkg = $data->{pkg};
39 my $fqn = join '::', $pkg, $name;
41 _incoming($name, $pkg);
44 *$fqn = $placeholder unless exists &$fqn;
55 Variable::Magic::getdata(%{"${pkg}::"}, $sw);
58 defined $data ? $data->{map} : undef;
62 my ($pkg, $name) = @_;
65 Variable::Magic::cast(%{"${pkg}::"}, $sw, $pkg, { $name => 1 });
72 Variable::Magic::dispell(%{"${pkg}::"}, $sw);
78 my $pkg = @_ > 0 ? $_[0] : caller;
79 my $fqn = "${pkg}::$name";
90 $^H{+(__PACKAGE__)} = 1;
92 on_scope_end { disable($name, $pkg) };
100 my $pkg = @_ > 0 ? $_[0] : caller;
101 my $fqn = "${pkg}::$name";
103 my $map = _map($pkg);
106 delete $map->{$name};
107 unless (keys %$map) {
116 my ($pkg, $inject) = @_;
118 my $stash = do { no strict 'refs'; \%{"${pkg}::"} };
120 while (my ($meth, $code) = each %$inject) {
121 next if exists $stash->{$meth} and (*{$stash->{$meth}}{CODE} // 0) == $code;
123 *{"${pkg}::$meth"} = $code;
130 $injector = Variable::Magic::wizard(
131 data => sub { +{ guard => 0, pkg => $_[1], subs => $_[2] } },
133 my ($stash, $data, $key) = @_;
135 return if $data->{guard};
136 local $data->{guard} = 1;
138 _inject($data->{pkg}, $data->{subs});
148 $B_OP_inject{first} = sub {
149 if (defined _custom_name($_[0])) {
150 $_[0] = bless $_[0], 'B::UNOP' unless $_[0]->isa('B::UNOP');
151 goto $_[0]->can('first') || die 'oops';
154 Carp::confess('Calling B::OP->first for something that isn\'t a custom op');
157 $B_OP_inject{can} = sub {
158 my ($obj, $meth) = @_;
159 if ($meth eq 'first') {
160 return undef unless defined _custom_name($obj);
162 $obj->SUPER::can($meth);
165 if (%B:: and %B::OP:: and *B::OP::type{CODE}) {
166 _inject('B::OP', \%B_OP_inject);
168 Variable::Magic::cast %B::OP::, $injector, 'B::OP', \%B_OP_inject;
171 my $B_Deparse_inject = {
173 my ($self, $op, $cx) = @_;
174 my $name = _custom_name($op);
175 die 'unhandled custom op' unless defined $name;
176 if ($op->flags & B::OPf_STACKED()) {
177 my $kid = $op->first;
178 $kid = $kid->first->sibling; # skip ex-list, pushmark
180 for (; not B::Deparse::null($kid); $kid = $kid->sibling) {
181 push @exprs, $self->deparse($kid, 6);
183 my $args = join(", ", @exprs);
184 return "$name($args)";
191 if (%B:: and %B::Deparse:: and *B::Deparse::pp_entersub{CODE}) {
192 _inject('B::Deparse', $B_Deparse_inject);
194 Variable::Magic::cast %B::Deparse::, $injector, 'B::Deparse', $B_Deparse_inject;
199 BEGIN { _monkeypatch() }