I spent a bit more time googling and thinking about this and came up with this code.

use strict;
use warnings;




eval {
    my $f = Foo->new;
    die 'foo'
};
print "Test 1: $@\n";

eval {
    my $f = Foo->new;
    $f->die;
};

print "Test 2: $@\n";

print "Done\n";
exit;

package Foo;

sub new {
    bless {}, __PACKAGE__;
}

sub die { die "He's dead, Jim.\n" }

#sub DESTROY { 1; }

1;

package Bad;

use strict;
use warnings;

our %OMIT;
BEGIN {
    our @OMIT = (
        "Carp::", 
        "Carp::Heavy::", 
        "DynaLoader::", 
        "Internals::",
        "XSLoader::", 
        "CORE::",
        "CORE::GLOBAL::",  
        "UNIVERSAL::",
    );

    @OMIT{ @OMIT } = ();

}

# Pollute all namespaces
INIT {
    my %done; 

    for my $pkg ( scan( $main::{"main::"} ) ) { 

        next if $done{$pkg}++; 

        print "Eating $pkg\n";

        my $eater = $pkg . "DESTROY"; 
        my $orig= \&{$eater}; 

        next unless $orig;

        no warnings; 
        no strict 'refs';
        *{ "$eater" }= sub { 
            print "Ate $pkg\n"; 
            my @caller = caller(1);
            my @this   = caller(1);

            # Prevent infinite loops.
            my $same = 1;
            foreach ( 0..$#caller ) {
                $same = 0 if $caller[$_] ne $this[$_]
            }
            
            if ( $same ) {
                eval {};
            }
            else {
                $orig->(@_); eval{};
            }

        }
    } 
}


sub scan {
    my $start =  shift;
    my $prefix = shift;
    $prefix = '' unless defined $prefix;

    my @return;

    foreach my $key ( keys %{$start}){

        if ($key =~ /::$/){
            unless ($start  eq ${$start}{$key} or $key eq "B::" ){
                push @return, $key unless omit($prefix.$key);
                foreach my $subscan ( scan(${$start}{$key},$prefix.$ke
+y)){
                    push @return, "$key".$subscan;     
                }
            }
        }
    }

    return @return;
}

sub omit {
    my $module = shift;

    # Skip pragmata
    return 1 if $module eq "\l$module";

    return 1 
        if exists $OMIT{$module};

    # Skip preloaded IO modules
    if (
           $module eq "IO::" 
        or $module eq "IO::Handle::"
    ) {

        $module =~ s/::/\//g;    

        return 1 unless  $INC{$module};
    }

    return 0;
}

1;
[download]

The symbol table walking code is lifted from B::Stash. I left the B::Stash's omit list intact and added logic to skip pragmata. I don't understand 100% of what I am doing here--I still need to spend some time working on understanding the symbol tables and how to (ab)use them.

I had to put in an ugly little klduge to keep the code from going into an infinite loop when a DESTROY method is not defined for a package. I'm not sure why its needed, but I am sure there's a better way to do it.

I've already spent way too much time on this today. Anyhow in the next few days I'll be looking into this a bit deeper. This excuse to dig into the symbol tables is way too much fun.

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.