File Coverage

lib/Devel/WatchVars.pm

Criterion	Covered	Total	%
statement	39	39	100.0
branch	10	14	71.4
condition	4	6	66.6
subroutine	10	10	100.0
pod	2	2	100.0
total	65	71	91.5

package Devel::WatchVars;

=encoding utf8

=cut

use utf8;
use strict;
use warnings;
no overloading;

use Carp;
use Scalar::Util qw(weaken readonly reftype);

use namespace::clean;

###########################################################

our $VERSION = "v1.0.5";

use Exporter qw(import);
our @EXPORT = qw(watch unwatch);

###########################################################

my $TIE_PACKAGE = __PACKAGE__ . "::Tie::Scalar";
{
    local $@;
    die unless eval "require $TIE_PACKAGE; 1";
}

###########################################################

sub watch(\$;$) {
    my($sref, $name) = @_;
    my $reftype = ref($sref) && reftype($sref);

    $reftype =~ /^(?:SCALAR|REF)\z/ ||
        croak "You didn't pass a SCALAR (by reference), you passed a ",
              $reftype       ? "$reftype (by reference)"
            : defined($sref) ? "non-reference"
            :                  "undef";

    !readonly($$sref)           || croak "Can't watch a readonly scalar";

    my $value = $$sref;
    my $self  = tie $$sref, $TIE_PACKAGE, $name, $value;
    weaken($$self{sref} = $sref);
}

###########################################################

sub unwatch(\$) {
    my($tref) = @_;
    ref($tref) eq "SCALAR"      || croak "You didn't pass a scalar (by reference)";
    my $self = tied $$tref      || croak "Can't unwatch something that isn't tied";
    $self->isa($TIE_PACKAGE)    || croak "Can't unwatch something that isn't watched";
    my($sref, $value) = @$self{sref => "value"};
    undef $self;
    untie $$tref;
    $$sref = $value if ref($sref) eq "SCALAR";
}

###########################################################

1;

__END__