| Variable-Watcher documentation | Contained in the Variable-Watcher distribution. |
Variable::Watcher -- Keep track of changes on my variables
### 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;
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.
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;
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).
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.
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.
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.
Returns the mutation log as a printable string, optionally filterd on
the criteria as described in the stack method.
Flushes the logs of all mutations that have occurred so far. Returns
the stack, like the stack method would, without filtering.
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.
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.
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.
This module by Jos Boumans <kane@cpan.org>.
This module is copyright (c) 2005 Jos Boumans <kane@cpan.org>. All rights reserved.
This library is free software; you may redistribute and/or modify it under the same terms as Perl itself.
| 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: