Final version of Trace.pm, please try it ... 
Author Message
 Final version of Trace.pm, please try it ...

Well, I've received a grand total of 0 responses RE the original
trace.  Here's the last version, using objects.

Synopsis from the pod:

 use Trace;





 %vinfo = $trace->Info;
 $trace->Delete;

Bugs:

. tied arrays are crippled (;
. can't seem to get DESTROY called for arrays and hashes, only scalars

Thanks

Here is Trace.pm, followed by a test program:
------------------------------Trace.pm--------------------------------------
package Trace;

use Carp;
use English;

$DEBUG = 0;

=head1 NAME

 Trace() - a class module that traces Perl variables as they are accessed.

=head1 SYNOPSIS

 use Trace;





 %vinfo = $trace->Info;
 $trace->Delete;

=head1 DESCRIPTION

 This class module binds a subroutine of your devising to a Perl variable; the
 callback is invoked when the variable is read, written, or both.  The callback
 code can pass the value of the variable through unchanged, or modify it on
 the fly.  You cannot have more than one callback per Perl variable, so it must
 be coded to handle read and write operations if 'rw' mode is selected.  It is
 passed at least three arguments:

 my $callback = sub {

     # Callback to uppercase write values.


     print "op=$op, val=", ($val ? "'$val'" : 'undefined'),
         ", new_val=", ($new_val ? "'$new_val'" : 'undefined'),

     return ($op =~ /r/ ? $val : uc $new_val);
 };

 $op is either 'r' or 'w', $val is the variable's current value, $new_val is
 the variable's new value if the operation is a write (else it's the same as

 the Trace->new() method. The return value from the callback becomes the
 variable's new value.  

 This example simply uppercases $new_val on a write.  To implement a read-only
 variable simply return $val on a write.  Note that one callback works for
 scalar, array or hash variables.

=head1 METHODS


  $reference = a *reference* to a scalar, array or hash variable.  If you
               specify a string, it's the name of a scalar variable.

  $operation = 'r' to trace reads, 'w' to trace writes, or 'rw' to trace
               both reads and writes.

  $callback  = a code reference pointing to the subroutine to handle the
               trace activity.


=head2 %vinfo = $trace->Info;

 Returns a hash detailing the internals of the Trace object, with these keys:

 %vinfo = {
     tref      =>  SCALAR(0x200737f8)
     operation =>  'rw'
     callback  =>  CODE(0x200b2778)

     value     =>  'HELLO SCALAR'
     legible   =>  above data formatted as a list of string, for printing
 }

 For array and hash Trace objects, the 'value' key is replaced with a 'ptr'
 key which is a reference to the array or hash.

=head2 $trace->Delete;

 Stop tracing the variable.  To delete the Trace object use undef($trace).

=head1 AUTHORS



=head1 HISTORY


  . Original version 1.0 release, based on the Trace module from Hans Mulder.

=head1 COPYRIGHT

 Copyright (C) 1996 - 1996 Stephen O. Lidie. All rights reserved.

 This program is free software; you can redistribute it and/or modify it under
 the same terms as Perl itself.

=cut

sub new {

    # Trace constructor.  The *real* constructor is Trace->BaseTrace(),
    # inherited and invoked by methods in other Trace packages, depending
    # upon the variable's type.


    croak "Trace() operation must be 'r', 'w' or 'rw'." if $op =~ /[^rw]/;
    $tref = (caller) . "::$tref" unless ($tref =~ /::|'/ or ref $tref);

    my($type, $trace_obj) = (ref $tref, undef);
    if ($type =~ /SCALAR/) {

    } elsif ($type =~ /ARRAY/) {

    } elsif ($type =~ /HASH/) {

    } else { # assume symbolic reference

    }
    return $trace_obj;

Quote:
} # end new, Trace constructor

sub Delete {

    # Stop tracing a variable by untie()-ing it.


    my $tref = $self->{tref};
    $tref = (caller) . "::$tref" unless ($tref =~ /::|'/ or ref $tref);

    my $type = ref $tref;
    if ($type =~ /SCALAR/) {
        untie $$tref;
    } elsif ($type =~ /ARRAY/) {

    } elsif ($type =~ /HASH/) {
        untie %$tref;
    } else { # assume symbolic reference
        untie $$tref;
    }

Quote:
}

sub Info {

    # Info() method subclassed by other Trace modules.







    %vinfo = (
        'tref'      => $self->{tref},
        'operation' => $self->{op},
        'callback'  => $self->{cb},
        'arguments' => $self->{args},

    );
    return %vinfo;

Quote:
}

# Trace private methods.

sub BaseTrace {

    # Trace base class constructor inherited by other Trace modules.


    my $trace_obj = {
        'tref' => $tref,
        'op'   => $op,
        'cb'   => $cb,

    };
    return bless $trace_obj, $class;

Quote:
}

sub Say {

    # For debugging.


    defined $val ? "'$val'" : "undefined";

Quote:
}

package TraceScalar;


sub TIESCALAR {



    $trace_obj->{value} = $$tref;
    return bless $trace_obj, $class;

Quote:
}

sub Info {

    my %vinfo = $self->SUPER::Info;

    $vinfo{value} = $self->{value};
    return %vinfo;

Quote:
}

sub DESTROY {

    print "TraceScalar: $self->{tref} destructor, final value was ",
                $self->Say($self->{value}), ".\n" if $Trace::DEBUG;
    undef %$self;

Quote:
}

sub FETCH {

    my $val = $self->{value};
    my $new_val = $val;
    print "TraceScalar: $self->{tref} returned ",
                $self->Say($val), ".\n" if $Trace::DEBUG;
    if ($self->{'op'} =~ /r/) {

    }
    return $self->{value} = $new_val;

Quote:
}

sub STORE {

    my $val = $self->{value};
    print "TraceScalar: $self->{tref} changed from ",
                $self->Say($val), " to ",
                $self->Say($new_val), ".\n" if $Trace::DEBUG;
    if ($self->{'op'} =~ /w/) {

    }
    return $self->{value} = $new_val;

Quote:
}

package TraceArray;


sub TIEARRAY {



    $trace_obj->{ptr} = [];
    return bless $trace_obj, $class;

Quote:
}

sub Info {

    my %vinfo = $self->SUPER::Info;

    $vinfo{ptr} = $self->{ptr};
    return %vinfo;

Quote:
}

sub DESTROY {

    print "TraceArray: $self->{tref} destructor.\n" if $Trace::DEBUG;
    undef %$self;

Quote:
}

sub FETCH {

    my $val = $self->{ptr}->[$key];
    my $new_val = $val;
    print "TraceArray: $self->{tref}", "[$key] returned ",
                $self->Say($val), ".\n" if $Trace::DEBUG;
    if ($self->{'op'} =~ /r/) {

    }
    return $self->{ptr}->[$key] = $new_val;

Quote:
}

sub STORE {

    my $val = $self->{ptr}->[$key];
    print "TraceArray: $self->{tref}", "[$key] changed from ",
                $self->Say($val), " to ",
                $self->Say($new_val), ".\n" if $Trace::DEBUG;
    if ($self->{'op'} =~ /w/) {

    }
    return $self->{ptr}->[$key] = $new_val;

Quote:
}

package TraceHash;


sub TIEHASH {



    $trace_obj->{ptr} = {};
    return bless $trace_obj, $class;

Quote:
}

sub CLEAR {

    $self->{ptr} = ();

Quote:
}

sub DELETE {

    delete $self->{ptr}->{$key};

Quote:
}

sub DESTROY {

    print "TraceHash: $self->{tref} destructor.\n" if $Trace::DEBUG;
    undef %$self;

Quote:
}

sub EXISTS {

    return exists $self->{ptr}->{$key};

Quote:
}

sub FETCH {

    my $val = $self->{ptr}->{$key};
    my $new_val = $val;
    print "TraceHash: $self->{tref}", "{$key} returned ",
                $self->Say($val), ".\n" if $Trace::DEBUG;
    if ($self->{'op'} =~ /r/) {

    }
    return
...

read more »



Thu, 19 Nov 1998 03:00:00 GMT  
 Final version of Trace.pm, please try it ...

Quote:
> ># Complete documentation on Trace is a pod in the module file.  Trace works on
> ># plain scalars, arrays, or hashes.  Do *NOT* trace Tk widgets!  But Trace does

> Hmm... haven't yet had a close look - is this (inability to Trace Tk widgets)
> because of Dynaloading?

Tk widgets are just blessed hashes, and the Tk core read/writes them
constantly - it's best to leave them alone so you don't mess them up (;

This is one reason I wanted some feedback - I might have a composite of my own
design that needs this trace capability, so logically the traced variable
should be part of the object.  This isn't possible with the current scheme
since all the trace callback gets is a hash value, but not it's *key*.

Hmm, the more I think about it I think this design change is needed....
But now one needs *separate* callbacks for scalars vs. arrays/hashes!

Quote:
> [..snip..]

> >use Tk;
> >my $MW = MainWindow->new;
> >my $e = $MW->Entry->pack;
> >$e->bind('<Return>' => sub {$foo = $e->get});
> >$e->focus;
> >my $d = $MW->Button(-text => 'Debug', -command => sub {$Trace::DEBUG = 1});
> >$d->pack;
> >my $u = $MW->Button(-text => 'Untrace $foo', -command => sub {
> >    $t_scalar->Delete;
> >})->pack;
> >my $l = $MW->Button(-text => 'Quit', -command => \&exit)->pack;
> >MainLoop;

> Ok - with the GUI running I type "test0" and get on STDOUT:

> op=w, val='HELLO SCALAR', new_val='test0', args=Mon Jun  3 01:05:28 EDT 1996!

Good, the demo had left the scalar $foo with the value 'HELLO SCALAR', so when
you typed  "test0" and hit return in the Entry widget the write callback was
invoked with the old and (proposed) new variable values, which it printed
above.

As you continue to enter data the write callback keeps getting called.

Quote:
> Now I press the $u Button and - nothing happens at all. The $d Button will only
> spit something out when I press the $l Button. Without having had time to look
> at the 'Untrace $foo' code - what was I supposed to have seen when I pressed
> the center Button?

The $u button is labelled Untrace, and it does just that:  it stops tracing
the variable, so the write callback is never invoked and you stop seeing the
debug print statements.  Here again is the callback:

my $callback = sub {

    # Callback to uppercase write values.


    print "op=$op, val=", ($val ? "'$val'" : 'undefined'),
        ", new_val=", ($new_val ? "'$new_val'" : 'undefined'),

    return ($op =~ /r/ ? $val : uc $new_val);

Quote:
};

Did that make any sense?

Thanks for testing driving trace.
==========================================================================
This message was posted through the Stanford campus mailing list
server.  If you wish to unsubscribe from this mailing list, send the

--




Fri, 20 Nov 1998 03:00:00 GMT  
 Final version of Trace.pm, please try it ...


Quote:
>> ># Complete documentation on Trace is a pod in the module file.  Trace works on
>> ># plain scalars, arrays, or hashes.  Do *NOT* trace Tk widgets!  But Trace does

>> Hmm... haven't yet had a close look - is this (inability to Trace Tk widgets)
>> because of Dynaloading?

>Tk widgets are just blessed hashes, and the Tk core read/writes them
>constantly - it's best to leave them alone so you don't mess them up (;

_Currently_ Tk widgets are blessed hashes. They may become (blessed)
tied hashes at some time. That is You will still be able to say

$widget->{Something} = "Whatever";

But that may in fact use perl's tie mechanism rather than native hash.
My code actually trys this as an attempt to reduce memory usage by
tie'ing to a Tk hash rather than a perl HV. (Did not help as it happens
and 5.002_02 is expected to have a better solution.)

The reason this matters is that there is only one level of 'magic' available
(normally) so if hash is already tied you can't do it again...

Quote:

>This is one reason I wanted some feedback - I might have a composite of my own
>design that needs this trace capability, so logically the traced variable
>should be part of the object.  This isn't possible with the current scheme
>since all the trace callback gets is a hash value, but not it's *key*.

>Hmm, the more I think about it I think this design change is needed....
>But now one needs *separate* callbacks for scalars vs. arrays/hashes!

==========================================================================
This message was posted through the Stanford campus mailing list
server.  If you wish to unsubscribe from this mailing list, send the

--




Fri, 20 Nov 1998 03:00:00 GMT  
 Final version of Trace.pm, please try it ...

Quote:
> >Tk widgets are just blessed hashes, and the Tk core read/writes them
> >constantly - it's best to leave them alone so you don't mess them up (;

> _Currently_ Tk widgets are blessed hashes. They may become (blessed)
> tied hashes at some time. That is You will still be able to say

> $widget->{Something} = "Whatever";

> But that may in fact use perl's tie mechanism rather than native hash.

Won't that be a lot of extra call/return overhead?

Quote:
> My code actually trys this as an attempt to reduce memory usage by
> tie'ing to a Tk hash rather than a perl HV. (Did not help as it happens
> and 5.002_02 is expected to have a better solution.)

Gurusamy's shared hash keys?

Quote:
> The reason this matters is that there is only one level of 'magic' available
> (normally) so if hash is already tied you can't do it again...

That would be a problem for tracing a Tk widget (see below)...

Quote:
> >This is one reason I wanted some feedback - I might have a composite of my own
> >design that needs this trace capability, so logically the traced variable
> >should be part of the object.  This isn't possible with the current scheme
> >since all the trace callback gets is a hash value, but not it's *key*.

I've just changed Trace to pass the array/hash key to the read/write callback,
so it's possible to trace a Tk widget without damaging it by mistake (;

So Simon's Statusbar composite can now use a special hash key as a trace
variable, and lose the after code which it currently uses...
==========================================================================
This message was posted through the Stanford campus mailing list
server.  If you wish to unsubscribe from this mailing list, send the

--




Fri, 20 Nov 1998 03:00:00 GMT  
 Final version of Trace.pm, please try it ...


Quote:
>> >Tk widgets are just blessed hashes, and the Tk core read/writes them
>> >constantly - it's best to leave them alone so you don't mess them up (;

>> _Currently_ Tk widgets are blessed hashes. They may become (blessed)
>> tied hashes at some time. That is You will still be able to say

>> $widget->{Something} = "Whatever";

>> But that may in fact use perl's tie mechanism rather than native hash.

>Won't that be a lot of extra call/return overhead?

More yes. But if core 'thing' that was tied to (C level)
was more compact and faster to access you might get net gain.
Calling C-defined FETCH/STORE is about the same as calling C defined
'configure' which we already do a lot.

Quote:

>> My code actually trys this as an attempt to reduce memory usage by
>> tie'ing to a Tk hash rather than a perl HV. (Did not help as it happens
>> and 5.002_02 is expected to have a better solution.)

>Gurusamy's shared hash keys?

Yes.

Quote:

>> The reason this matters is that there is only one level of 'magic' available
>> (normally) so if hash is already tied you can't do it again...

>That would be a problem for tracing a Tk widget (see below)...

Which is why I mentioned it.
Note to though that if you tie the widgets hash you impose extra FETCH
overhead on all operations.

Quote:

>> >This is one reason I wanted some feedback - I might have a composite of my own
>> >design that needs this trace capability, so logically the traced variable
>> >should be part of the object.  This isn't possible with the current scheme
>> >since all the trace callback gets is a hash value, but not it's *key*.

>I've just changed Trace to pass the array/hash key to the read/write callback,
>so it's possible to trace a Tk widget without damaging it by mistake (;

>So Simon's Statusbar composite can now use a special hash key as a trace
>variable, and lose the after code which it currently uses...

==========================================================================
This message was posted through the Stanford campus mailing list
server.  If you wish to unsubscribe from this mailing list, send the

--




Fri, 20 Nov 1998 03:00:00 GMT  
 Final version of Trace.pm, please try it ...

Quote:
> Note to though that if you tie the widgets hash you impose extra FETCH
> overhead on all operations.

Yep, one reason I suggested to not trace a Tk widget.  But there's
even a better reason ...

Quote:
> >So Simon's Statusbar composite can now use a special hash key as a trace
> >variable, and lose the after code which it currently uses...

... I just re-remembered that tracing via tie means that a *parallel*
array/hash is kept, else one recurses forever.  So writes to a traced Tk
widget are stored, not in the widget itself, but elsewhere - the widget's
state gets hosed!

So I take it back - you cannot trace a Tk widget, and I'm reverting back to
the orignal Trace.pm.  No array/hash key is passed to the read/write callback.
==========================================================================
This message was posted through the Stanford campus mailing list
server.  If you wish to unsubscribe from this mailing list, send the

--




Fri, 20 Nov 1998 03:00:00 GMT  
 
 [ 6 post ] 

 Relevant Pages 

1. ANNOUNCE: Debug::Trace 0.04 -- tracing subroutine calls

2. pTk 8.4.24 patch - Trace.pm, move methods into Tk::Widget

3. Gtk module - failes compile (tried all versions)

4. trying it again... please help ;-(

5. try out my program please...

6. trying to upload file with perl CGI - help please

7. help please, trying to sort a multidimensional array

8. Please help - trying to get an Apache script to work on IIS

9. PLEASE TRY THIS OUT !!!

10. Error when trying to use dbmopen - Please help

11. Trying to install on Win 98 ... Please help

12. trying to find POSIX.pm

 

 
Powered by phpBB® Forum Software