view release on metacpan or  search on metacpan

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

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__

=head1 NAME

Devel::WatchVars - trace access to scalar variables

=head1 SYNOPSIS

    use Devel::WatchVars qw(watch unwatch);

Start tracing:

    watch $some_var,    '$some_var'; # single quotes so it knows its name
    watch $nums[2],     'element[2] of the @nums array';
    watch $color{blue}, 'the blue element of the %color hash';

    ######################################
    # Do things that access those, then...
    ######################################

End tracing:

    unwatch $color{blue};
    unwatch $nums[2];
    unwatch $some_var;

=head1 DESCRIPTION

The C<Devel::WatchVars> module provides simple tracing of scalars.
The C<watch> function takes the scalar you want traced followed by 
the descriptive string to use as its name in traces.

Here's a simple illustration using a short program, here named F<examples/simple>:

     1	#!/usr/bin/env perl
     2	use v5.10;
     3	use strict;
     4	use warnings;
     5	
     6	use Devel::WatchVars;
     7	sub twice { return 2 * shift  }