#!/usr/bin/perl 
use warnings; use strict;

{ package pkg;  use warnings; use strict;
  our $cnt=0;

  sub new     { my $p = shift; my $c = ref $p || $p;
                printf STDERR "pkg %s created\n", ++$cnt; 
                $p = bless { cnt => $cnt, fnc => 
                     sub { my $p2 = ref $_[0] ? shift : __PACKAGE__;
                           printf STDERR "fnc %d calling %s\n", $cnt, $p2->FUNC;
                           undef;
                         } }, $c;
              }
  
  sub destroy { printf STDERR "pkg %s(%s) destroyed\n", $cnt, $_[0]->{cnt}; undef }
  sub DESTROY { goto &destroy }
}

package main;

sub callfunc(;$$);  #silence warn about proto not ready
sub callfunc (;$$) {
  my $p = pkg->new;
  my ($callfunc, $recur) = @_;
  $callfunc||=0; $recur||=0;
  local * FUNC = sub () { printf STDERR "In FUNC, cnt=%s\n", $p->{cnt}; undef };
  FUNC() if $callfunc;
  callfunc($callfunc, $recur) if $recur && $recur--;
}

callfunc;
callfunc 1;

callfunc 0,1;
callfunc 1,1;

pkg::destroy


##</code><code>##

pkg 1 created
pkg 1(1) destroyed
pkg 2 created
In FUNC, cnt=2
pkg 2(2) destroyed
pkg 3 created
pkg 4 created
Subroutine main::FUNC redefined at /tmp/tst2.pl line 27.
pkg 4(4) destroyed
pkg 4(3) destroyed
pkg 5 created
In FUNC, cnt=5
pkg 6 created
Subroutine main::FUNC redefined at /tmp/tst2.pl line 27.
In FUNC, cnt=6
pkg 6(6) destroyed
pkg 6(5) destroyed
Use of uninitialized value in printf at /tmp/tst2.pl line 16.
pkg 6() destroyed