Variable::Watcher - Keep track of changes on C<my> variables


Variable-Watcher documentation Contained in the Variable-Watcher distribution.

Index


Code Index:

NAME

Top

Variable::Watcher -- Keep track of changes on my variables

SYNOPSIS

Top

    ### keep track of scalar changes
    my $scalar : Watch(s) = 1;

    ### keep track of array changes
    my @list : Watch(l) = (1);

    ### keep track of hash changes
    my %hash : Watch(h) = (1 => 2);




    ### retrieve individual mutations:
    my @stack = Variable::Watcher->stack;

    ### retrieve the mutation as a printable string
    my $string = Variable::Watcher->stack_as_string;

    ### flush the logs of all the mutations so far
    Variable::Watcher->flush;

    ### Set the default reporting filehandle (defaults to STDERR 
    ### -- see the C<GLOBAL VARIABLES> section
    $Variable::Watcher::REPORT_FH = \*MY_FH;

    ### Make Variable::Watcher not print to REPORT_FH when running
    ### You will have to use the stack/stack_as_string method to
    ### retrieve the logs. See the C<GLOBAL VARIABLES> section
    $Variable::Watcher::VERBOSE = 0;




DESCRIPTION

Top

Variable::Watcher allows you to keep track of mutations on my variables. It will record every mutation you do to a variable that is being Watched. You can retrieve these mutations as a list or as a big printable string, filtered by a regex if you like.

This is a useful debugging tool when you find your my variables in a state you did not expect.

See the CAVEATS section for the limitations of this approach.

Attributes

Top

my $var : Watch([NAME])

In order to start Watching a variable, you must tag it as being Watched at declaration time. You can optionally give it a name to be used in the logs, rather than it's memory address (this is much recommended).

You can do this for perls three basic variable types;

SCALAR

To keep track of a scalar, and it's mutations, you could for example, do somethign like this:

    my $scalar : Watch(s) = 1;
    $scalar++;




The resulting output would be much like this:

   [Variable::Watcher s -> STORE] Performing 'STORE' on s passing 
   '1' at z.pl line 6
   [Variable::Watcher s -> FETCH] Performing 'FETCH' on s at z.pl 
   line 7
   [Variable::Watcher s -> STORE] Performing 'STORE' on s passing 
   '2' at z.pl line 7

Showing you when you did the first STORE, when you retrieved the value (FETCH) and when you stored the increment (STORE).

ARRAY

To keep track of an array, and it's mutation, you could for example, do something like this:

    my @list : Watch(l) = (1);
    push @list, 2;
    pop @list;

The resulting output would be much like this:

   [Variable::Watcher l -> CLEAR] Performing 'CLEAR' on l at z2.pl
   line 6
   [Variable::Watcher l -> EXTEND] Performing 'EXTEND' on l 
   passing '1' at z2.pl line 6
   [Variable::Watcher l -> STORE] Performing 'STORE' on l passing 
   '0 1' at z2.pl line 6
   [Variable::Watcher l -> PUSH] Performing 'PUSH' on l passing 
   '2' at z2.pl line 7
   [Variable::Watcher l -> FETCHSIZE] Performing 'FETCHSIZE' on l 
   at z2.pl line 7
   [Variable::Watcher l -> POP] Performing 'POP' on l at z2.pl 
   line 8

Showing you that you initialized an empty array (CLEAR), and extended it's size (EXTEND) to fit your first assignment (STORE), followed by the PUSH which adds another value to your list. Then we attempt to remove the last value, showing us how perl fetches its size (FETCHSIZE) and POPs the last value off.

HASH

To keep track of a hash, and it's mutation, you could for example, do something like this:

    my %hash : Watch(h) = (1 => 2);
    $hash{3} = 4;
    delete $hash{3};

The resulting output would be much like this:

   [Variable::Watcher h -> CLEAR] Performing 'CLEAR' on h at z3.pl
   line 6
   [Variable::Watcher h -> STORE] Performing 'STORE' on h passing 
   '1 2' at z3.pl line 6
   [Variable::Watcher h -> STORE] Performing 'STORE' on h passing 
   '3 4' at z3.pl line 7
   [Variable::Watcher h -> DELETE] Performing 'DELETE' on h 
   passing '3' at z3.pl line 8

Showing you that you initialized an empty hash (CLEAR), and STOREd it's first key/value pair. Then we STORE the second key/value pair, followed by a DELETE of the key 3.

CLASS METHODS

Top

@stack = Variable::Watcher->stack( [name => $name, action => $action] );

Retrieves a list of Log::Message::Item objects describing the mutations of the Watched variables.

The optional name argument lets you filter based on the name you have given the variables to be Watched.

The optional action argument lets you filter on the type of action you want to retrieve (STORE or FETCH, etc).

Refer to the Log::Message manpage for details on how to work with Log::Message::Item objects.

$string = Variable::Watcher->stack_as_string( [name => $name, action => $action] );

Returns the mutation log as a printable string, optionally filterd on the criteria as described in the stack method.

@stack = Variable::Watcher->flush;

Flushes the logs of all mutations that have occurred so far. Returns the stack, like the stack method would, without filtering.

GLOBAL VARIABLES

Top

$Variable::Watcher::REPORT_FH

This is the filehandle that all mutations are printed to. It defaults to STDERR but you can change it to any (open!) filehandle you wish.

$Variable::Watcher::VERBOSE

By default, all the mutation are printed to REPORT_FH when they occur. You can silence Variable::Watcher by setting this variable to false. Note you will then have to retrieve mutation logs via the stack or stack_as_string methods.

CAVEATS

Top

This module can only operate on the three standard perl data types; SCALAR, ARRAY, HASH, and only Watches the first level of a variable, but not nested ones; ie, a variable within a variable is not Watched.

AUTHOR

Top

This module by Jos Boumans <kane@cpan.org>.

COPYRIGHT

Top


Variable-Watcher documentation Contained in the Variable-Watcher distribution.
package Variable::Watcher;

require v5.6.0;

use strict;
use vars qw[$VERSION $AUTOLOAD $REPORT_FH $TRACE $VERBOSE];

use Attribute::Handlers;
use Carp;
use Data::Dumper;
use Log::Message    private => 1;
use Params::Check   qw[check allow];

use Tie::Scalar;
use Tie::Array;
use Tie::Hash;

$VERSION        = '0.01';
$VERBOSE        = 1;
$TRACE          = 1;

### file handles to print to
local $| = 1;
$REPORT_FH  = \*STDERR;

### list of names to use for the variables we're watching
my %Names   = ();

### log::message object to store actions in
my $Log     = new Log::Message;

### list of mappings of bless classes to tie classes
my %Map = (
    SCALAR  => 'Tie::StdScalar',
    ARRAY   => 'Tie::StdArray',
    HASH    => 'Tie::StdHash',
);


### add ourselves to the callers @INC, so we can use attributes that
### that are inherited.
sub import {
    my $self    = shift;
    my $class   = [caller]->[0];

    {   no strict 'refs';
        push @{"${class}::ISA"}, __PACKAGE__;
    }
}

sub Watch : ATTR {
    my ($package, $symbol, $ref, $attr, $data, $phase) = @_;
    my $reftype = ref $ref;

    my $obj;
    ### do we support this type of ref?
    unless( $Map{ $reftype } ) {

        ### report from the callers perspective, not from attribute.pm
        ### or attribute::handlers perspective
        local $Carp::CarpLevel += 2;

        carp("Cannot watch variable of type: '$reftype'" );
        return;

    ### if so, tie it to the appropriate class
    ### note that '$ref' is not the same as '$obj'!
    } elsif ( $reftype eq 'SCALAR' ) {
        tie $$ref, __PACKAGE__ .'::'. $reftype;
        $obj = tied $$ref;

    } elsif ( $reftype eq 'ARRAY' ) {
        tie @$ref, __PACKAGE__ .'::'. $reftype;
        $obj = tied @$ref;

    } elsif ( $reftype eq 'HASH' ) {
        tie %$ref,  __PACKAGE__ .'::'. $reftype;
        $obj = tied %$ref;
    }

    ### store the name which we will call this variable in the
    ### pretty print output
    $Names{ $obj } = ($data || "$obj");

    return 1;
}

sub AUTOLOAD {
    my $self = shift;
    my $ref  = tied $self;

    ### figure out the method called, and the class we're
    ### blessed into
    my ($class,$method) = $AUTOLOAD =~ /::([^:]+)::([^:]+)$/;

    ### XXX we won't have a name yet at TIEFOO stage, but don't
    ### bother reporting that either
    if( my $name = $Names{ $self } ) {
        my $msg = "Performing '$method' on $name";
        $msg .= " passing '@_'" if @_;

        ### skip the call frames that are private to this module
        local $Carp::CarpLevel += 1;

        $Log->store(
                message => Carp::shortmess($msg),
                tag     => __PACKAGE__ . " $name -> $method",
                level   => 'report',
                extra   => [@_]
        );
    }

    ### get the coderef to the correpsonding function in
    ### the tie class
    my $func = $Map{$class}->can( $method );

    ### called the tie function, with ourselves as primary
    ### argument, and the rest of the args after that
    $func->($self, @_);
}


### tie packages, which inherit straight from base
{   package Variable::Watcher::SCALAR;
    use base 'Variable::Watcher';

    package Variable::Watcher::ARRAY;
    use base 'Variable::Watcher';

    package Variable::Watcher::HASH;
    use base 'Variable::Watcher';
}

### report stack retrieval and manipulation
sub stack {
    my $self = shift;
    my %hash = @_;

    my($name,$action);
    my $tmpl = {
        name    => { default => '', store => \$name },
        action  => { default => '', store => \$action },
    };

    check( $tmpl, \%hash ) or return;

    my @rv;
    my $re = __PACKAGE__ . '\s(.+?)\s->\s(.+?)$';

    for my $item ( $Log->retrieve( chrono => 1 ) ) {
        my ($tagname,$tagaction) = $item->tag =~ /$re/;

        ### you want to do name based retrieving?
        if( $name ) {
            next unless allow( $tagname, $name );
        }

        ### you want to do action based retrieving?
        if( $action ) {
            next unless allow( $tagaction, $action);
        }

        push @rv, $item;
    }

    return @rv;
}

sub stack_as_string {
    my $class = shift;
    my @stack = $class->stack( @_ );

    return join '', map {
                    '[' . $_->tag . '] ' . $_->message;
                } @stack
}


sub flush {
    return reverse $Log->flush;
}

### the function that pretty prints the actions performed on variables
{   package Log::Message::Handlers;
    use Carp ();

    sub report {
        my $self    = shift;

        ### so you don't want us to print the msg? ###
        return unless $Variable::Watcher::VERBOSE;

        ### store the old filehandle, select the one the user wants us
        ### to print to
        my $old_fh = select $Variable::Watcher::REPORT_FH;
        print '['. $self->tag (). '] ' . $self->message;

        ### restore the old filehandle
        select $old_fh;

        return;
    }
}

1;

__END__


# Local variables:
# c-indentation-style: bsd
# c-basic-offset: 4
# indent-tabs-mode: nil
# End:
# vim: expandtab shiftwidth=4: