Devel::Canary 

package Devel::Canary;

use 5.018;
use strict;
use warnings;
use autodie;

use Carp          qw(confess);
use Scalar::Util  qw(refaddr reftype);
use PadWalker     qw(peek_my);

$Carp::CarpInternal{'Devel::Canary'}++;
$Carp::CarpInternal{'Devel::Canary::Hash'}++;

sub new_hashref {
    my $ref = {};
    tie %$ref, 'Devel::Canary::Hash', $ref;
    return $ref;
}

sub throw_error {
    my($self, $format) = @_;

    my $var_name = '$devel_canary';
    my $pad = peek_my(2);
    foreach my $key (keys %$pad) {
        my $var_ref = $pad->{$key};
        next unless reftype($var_ref) eq 'REF';
        if(my $addr = refaddr($$var_ref)) {
            if($addr == $$self) {
                $var_name = $key;
                last;
            }
        }
    }
    confess sprintf("Fatal attempt to $format", $var_name);
}


package Devel::Canary::Hash;

use parent 'Devel::Canary';

sub TIEHASH {
    my($class, $ref) = @_;
    my $addr = Scalar::Util::refaddr($ref);
    return bless \$addr, $class;
}

sub FETCH    { shift->throw_error('access %s->{'      . shift . '}'); }
sub STORE    { shift->throw_error('assign to %s->{'   . shift . '}'); }
sub EXISTS   { shift->throw_error('call exists %s->{' . shift . '}'); }
sub DELETE   { shift->throw_error('delete %s->{'      . shift . '}'); }
sub CLEAR    { shift->throw_error('clear hashref %s'); }
sub FIRSTKEY { shift->throw_error('iterate hashref %s'); }

1;