void
get_end_subs( pkg )
char *	pkg
  PREINIT:
    CV *cv_end ;
  PPCODE:
    if ( PL_endav ) {
      long i ;
      SV **svp = av_fetch(PL_endav , 0 , FALSE) ;
      long lng = av_len( PL_endav ) ;
      EXTEND(SP, lng + 1 ) ;
      for( i = 0 ; i <= lng ; ++i ) {
        cv_end = (CV *) svp[i] ;
        if ( !strcmp( HvNAME(CvSTASH(cv_end)) , pkg) ) {
          PUSHs( newRV_inc( cv_end ) );
        }
      }
    }


void
undef_end_subs( pkg )
char *	pkg
  PREINIT:
    CV *cv_end ;
    CV *cv_null ;
  PPCODE:
    if ( PL_endav ) {
      long i ;
      SV **svp = av_fetch(PL_endav , 0 , FALSE) ;
      long lng = av_len( PL_endav ) ;
      cv_null = get_cv("Safe::World::NULL_END_SUB" , TRUE) ;
      for( i = 0 ; i <= lng ; ++i ) {
        cv_end = (CV *) svp[i] ;
        if ( !strcmp( HvNAME(CvSTASH(cv_end)) , pkg) ) {
          cv_undef( cv_end ) ;
          svp[i] = cv_null ;
          SvREFCNT_inc( cv_null ) ;
        }
      }
    }

##</code><code>##

  my $packname = 'foo::bar' ;

  foreach my $end_i ( get_end_subs($packname) ) {
    eval{ &$end_i() if $end_i ; } ;
  }

  undef_end_subs($packname) ;

##</code><code>##

use B;

sub B::exec_ENDs {
  my $pkg = caller;

  $_->object_2svref->()
    for grep { $_->GV->STASH->NAME eq $pkg } B::end_av->ARRAY;
}

{
  package foo;

  sub pretend_to_leave {
    B->exec_ENDs();
    print "I'll go get my coat ...\n";
  }

  END { print "... another END block\n"   }
  END { print "foo: this will be followed by " }
}

foo->pretend_to_leave();

END { print "main: Right, I'm outta here\n" }

__output__

foo: this will be followed by ... another END block
I'll go get my coat ...
main: Right, I'm outta here
foo: this will be followed by ... another END block