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.$key)){
                    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;