You could try storing the flag outside of the object itself:

package whatever;

my %customDestroy;

sub new {
    my( $class, $flag, ... ) = @_;
    my $self = {};
    ...
    $customDestroy{ $self } = 1 if $flag;
    return bless $self, $slass;
}

...

sub DESTROY {
    my $self = shift;
    if( $customDestroy{ $self } ) {
        ## special behaviour
    }
    else {
        ## normal behaviour
    }
}
[download]

I think package lexicals should persist long enough to outlive instances, though I haven't tested the hypothesis.

See update and Corion’s thread. It was unfortunately a really stupid PEBKAC involving messing around with //= and defining the $self->{no_DESTROY} to a non-undef value beforehand — thus never actually setting it to 1 :( I must have been quite tired on Friday.

This surprises me. $self and the hash referenced by it should always be valid, even when global destruction sets in. What might have gone already are objects referenced by %$self.

At least for plain hash-based objects, I don't know of failure cases like you describe. Can you please post a short example that (sometimes) exhibits the problem you describe? I understand that it is hard to reduce a large program where global destruction happens to a small example that condenses the problem to a few lines.

As a workaround, you can prevent your objects falling prey to global destructions by releasing them earlier, through strategically undeffing the referencing variables:

my $master= My::Master::Object->new();

...

undef $master; # release object tree before global destruction sets in
# end of source code
[download]

If you already try to be clever and use Scalar::Util::weaken, maybe you are accessing a weakened reference somewhere, which has rightfully lost its grip onto the object data already?

Reduced the code, something is truly messing with me, because this thing runs perfectly:

package Foo;

sub new {
  my ($class, $params) = @_;
  my $self = {};
  
  $self->{no_DESTROY} = $params->{no_DESTROY} // 0;
  
  bless($self, $class);
  
  return $self;
}

sub DESTROY {
  my $self = shift;
  print "in DESTROY, no_DESTROY is $self->{no_DESTROY}\n";
  return if $self->{no_DESTROY};
  print "DESTROY body is running!\n";
}

package main;

my $foo = Foo->new({ no_DESTROY => 1 });
[download]

Argh. I messed with this most of Friday and it wouldn’t budge, now the mock-up code Just Works (as actually expected, too).

To track this down better, maybe you can dump the object(s) in question at strategic places of the lifetime of your program. Maybe you get lucky and find that no_DESTROY gets reset/lost somewhere or a place where another object holds on too long to the object in question.

Note that closures are notorious for holding on surprisingly long to objects:

sub make_frobnitzer {
    my( $self )= @_;

    $self->{on_error}= sub {
        $self->error_on_frobnitz( @_ );
    }
}
[download]

In the above case, $self will live until global destruction, because the on_error subroutine closes over $self.

See update and Corion’s thread.