Devel-Confess

 view release on metacpan or  search on metacpan

lib/Devel/Confess.pm  view on Meta::CPAN

no warnings 'once';

our $VERSION = '0.009004';
$VERSION = eval $VERSION;

use Carp ();
use Symbol ();
use Devel::Confess::_Util qw(
  blessed
  refaddr
  weaken
  longmess
  _str_val
  _in_END
  _can_stringify
  _can
  _isa
);
use Config ();
BEGIN {
  *_BROKEN_CLONED_DESTROY_REBLESS

lib/Devel/Confess.pm  view on Meta::CPAN

  my %id_map = map {
    my $ex = $EXCEPTIONS{$_};
    defined $ex ? ($_ => refaddr($ex)) : ();
  } keys %EXCEPTIONS;

  %EXCEPTIONS = map {; $id_map{$_} => $EXCEPTIONS{$_}} keys %id_map;
  %PACKAGES = map {; $id_map{$_} => $PACKAGES{$_}} keys %id_map;
  %MESSAGES = map {; $id_map{$_} => $MESSAGES{$_}} keys %id_map;
  %CLONED = map {; $_ => 1 } values %id_map
    if _BROKEN_CLONED_DESTROY_REBLESS || _BROKEN_CLONED_GLOB_UNDEF;
  weaken($_)
    for values %EXCEPTIONS;
}

sub _update_ex_refs {
  for my $id ( keys %EXCEPTIONS ) {
    next
      if defined $EXCEPTIONS{$id};
    delete $EXCEPTIONS{$id};
    delete $PACKAGES{$id};
    delete $MESSAGES{$id};

lib/Devel/Confess.pm  view on Meta::CPAN

        && _can($ex, 'isa')
        && $ex->isa($_)
        || $ex->$does($_)
      } keys %NoTrace
    ) {
      return @_;
    }

    $message ||= _stack_trace();

    weaken($EXCEPTIONS{$id} = $ex);
    $PACKAGES{$id} = $class;
    $MESSAGES{$id} = $message;

    my $newclass = __PACKAGE__ . '::__ANON_' . $PACK_SUFFIX++ . '__';

    {
      no strict 'refs';
      @{$newclass . '::ISA'} = ('Devel::Confess::_Attached', $class);
    }

    bless $ex, $newclass;
    return $ex;
  }
  elsif (ref($ex = $_[0])) {
    my $id = refaddr($ex);

    my $message = _stack_trace;

    weaken($EXCEPTIONS{$id} = $ex);
    $PACKAGES{$id} = undef;
    $MESSAGES{$id} ||= $message;

    return $ex;
  }

  my $out = join('', @_);

  if (caller(1) eq 'Carp') {
    my $long = longmess();

lib/Devel/Confess/_Util.pm  view on Meta::CPAN

use 5.006;
use strict;
use warnings FATAL => 'all';
no warnings 'once';

use Exporter (); BEGIN { *import = \&Exporter::import }

our @EXPORT = qw(
  blessed
  refaddr
  weaken
  longmess
  _str_val
  _in_END
  _can_stringify
  _can
  _isa
);

use Carp ();
use Carp::Heavy ();
use Scalar::Util qw(blessed refaddr reftype);

# fake weaken if it isn't available.  will cause leaks, but this
# is a brute force debugging tool, so we can deal with it.
*weaken = defined &Scalar::Util::weaken
  ? \&Scalar::Util::weaken
  : sub ($) { 0 };

*longmess = !Carp->VERSION ? eval q{
  package
    Carp;
  our (%CarpInternal, %Internal, $CarpLevel);
  $CarpInternal{Carp}++;
  $CarpInternal{warnings}++;
  $Internal{Exporter}++;
  $Internal{'Exporter::Heavy'}++;

t/leak.t  view on Meta::CPAN

use strict;
use warnings;
BEGIN {
  $ENV{DEVEL_CONFESS_OPTIONS} = '';
}
use Scalar::Util;
use Test::More
  defined &Scalar::Util::weaken ? (tests => 4)
    : (skip_all => "Can't prevent leaks without Scalar::Util::weaken");

use Devel::Confess;

my $gone = 0;
{
  package MyException;
  sub new {
    bless {}, __PACKAGE__;
  }
  sub throw {