diff options
Diffstat (limited to 'Perl/Zinc/Trace.pm')
| -rw-r--r-- | Perl/Zinc/Trace.pm | 227 |
1 files changed, 0 insertions, 227 deletions
diff --git a/Perl/Zinc/Trace.pm b/Perl/Zinc/Trace.pm deleted file mode 100644 index f115171..0000000 --- a/Perl/Zinc/Trace.pm +++ /dev/null @@ -1,227 +0,0 @@ -# -# Copyright (c) 1992-1994 The Regents of the University of California. -# Copyright (c) 1994 Sun Microsystems, Inc. -# Copyright (c) 1995-1999 Nick Ing-Simmons. All rights reserved. -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself, subject -# to additional disclaimer in Tk/license.terms due to partial -# derivation from Tk8.0 sources. -# -# Copyright (c) 2002 CENA, C.Mertz <mert@cena.fr> to trace all -# Tk::Zinc methods calls as well as the args in a human readable -# form. Updated by D.Etienne. -# -# This package overloads the Tk::Methods function in order to trace -# every Tk::Zinc method call in your application. -# -# This may be very usefull when your application segfaults and -# when you have no idea where this happens in your code. -# -# $Id$ -# -# To trap Tk::Zinc errors, use rather the Tk::Zinc::TraceErrors package. -# -# for using this file do some thing like : -# perl -MTk::Zinc::Trace myappli.pl - -package Tk::Zinc::Trace; - -use vars qw( $VERSION ); -($VERSION) = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/); - -use vars qw( $ForReplay ); - -use Tk; -use strict; -use Tk::Zinc::TraceUtils; - -my $WidgetMethodfunction; -my %moduleOptions; - - -BEGIN { - if (defined $ZincTraceErrors::on && $ZincTraceErrors::on == 1) { - print STDERR "Tk::Zinc::Trace: incompatible package Tk::Zinc::TraceErrors is already ". - "loaded (exit 1)\n"; - exit 1; - } - print "## Tk::Zinc::Trace ON\n"; - $ZincTrace::on = 1; - require Getopt::Long; - Getopt::Long::Configure('pass_through'); - Getopt::Long::GetOptions(\%moduleOptions, 'code'); - $ForReplay=1 if defined $moduleOptions{code} ; - select STDOUT; $|=1; ## for flushing the trace output - # save current Tk::Zinc::InitObject function; it will be invoked in - # overloaded one (see below) - use Tk; - use Tk::Zinc; - $WidgetMethodfunction = Tk::Zinc->can('WidgetMethod'); - -} - -print "## following trace should be very close to a replay-script code\n" if $ForReplay; - -my $ZincCounter= ""; -my %ZincHash; - -#sub Tk::Zinc { -# print "CREATING Zinc : @_"; -# &$ZincCreationMethodfunction; -#} - -sub Tk::Zinc::WidgetMethod { - my ($zinc, $name, @args) = @_; - if (defined $Tk::Zinc::Trace::off and $Tk::Zinc::Trace::off > 0) { - return &$WidgetMethodfunction(@_) if $WidgetMethodfunction; - } - my ($package, $filename, $line) = caller(1); - $package="" unless defined $package; - $filename="" unless defined $filename; - $line="" unless defined $line; - my $widget; - if (defined $ZincHash{$zinc}) { - $widget = $ZincHash{$zinc}; - } elsif ($ZincCounter) { - $ZincHash{$zinc} = '$zinc'.$ZincCounter; - $widget = '$zinc'.$ZincCounter; - $ZincCounter++; - } else { - $ZincHash{$zinc} = '$zinc'; - $widget = '$zinc'; - $ZincCounter=1; # for the next zinc - } - - if ($ForReplay) { - print "$widget->$name"; - } else { - print "TRACE: $filename line $line $name"; - } - - &printList(@args); - # invoke function possibly overloaded in other modules - if (wantarray()) { - my @res = &$WidgetMethodfunction(@_) if $WidgetMethodfunction; - if ($ForReplay) { - print ";\n"; - } else { - print " RETURNS "; - &printList (@res); - print "\n"; - } - $zinc->update; - return @res; - } else { - my $res = &$WidgetMethodfunction(@_) if $WidgetMethodfunction; - if ($ForReplay) { - print ";\n"; - } else { - print " RETURNS "; - &printItem ($res); - print "\n"; - } - $zinc->update; - return $res; - } -} - -1; - - -__END__ - -=head1 NAME - -Tk::Zinc::Trace - A module to trace all Tk::Zinc method calls - -=head1 SYNOPSIS - -use Tk::Zinc::Trace; -$Tk::Zinc::Trace:ForReplay = 1; - -or - -perl -MTk::Zinc::Trace YourZincBasedScript.pl [--code] - -=head1 DESCRIPTION - -When loaded, this module overloads a Tk mechanism so that every -Tk::Zinc method call will be traced. Every call will also be followed by a -$zinc->update() so that the method call will be effectively treated. - -This module can be very effective for debugging when Tk::Zinc -core dumps and you have no clue which method call can be responsible for. If -you just want to trace Tk::Zinc errors when calling a method you -should rather use the Tk::Zinc::TraceErrors module - -The global variable $Tk::Zinc::Trace:off can be used to trace some specific blocks. If set to 1, traces are deactivated, if set to 0, traces are reactivated. - -If the global variable $Tk::Zinc::Trace:ForReplay is set or if the --code -option is set in the second form, the printout will be very close to re-executable -code, like this: - - ## following trace should be very close to a replay-script code - $zinc->configure(-relief => 'sunken', -borderwidth => 3, - -width => 700, -font => 10x20, -height => 600); - $zinc->add('rectangle', 1, [10, 10, 100, 50], - -fillcolor => 'green', -filled => 1, -linewidth => 10, - -relief => 'roundridge', -linecolor => 'darkgreen'); - $zinc->add('text', 1, -font => -adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-* => - -text => 'A filled rectangle with a "roundridge" relief border of 10 pixels.', - -anchor => 'nw', -position => [120, 20]); - $zinc->add('track', 1, 6, - -labelformat => 'x82x60+0+0 x60a0^0^0 x32a0^0>1 a0a0>2>1 x32a0>3>1 a0a0^0>2', - -position => [20, 120], -speedvector => [40, -10], -speedvectormark => 1, -speedvectorticks => 1); - $zinc->coords(4, [20, 120]); - - -If not (the default), the printout will be more informtative, giving -the following information: - -=over 6 - -=item * the source filename where the method has been invoked - -=item * the line number in the source file - -=item * the TkZinc method name - -=item * the list of arguments in a human-readable form - -=item * the returned value - -=back - -The trace will look like: - - ## Tk::Zinc::Trace ON - TRACE: /usr/lib/perl5/Tk/Widget.pm line 196 configure(-relief => 'sunken', -borderwidth => 3, -width => 700, -font => 10x20, -height => 600) RETURNS undef - TRACE: Perl/demos/demos/zinc_lib/items.pl line 21 add('rectangle', 1, [10, 10, 100, 50], -fillcolor => 'green', -filled => 1, -linewidth => 10, -relief => 'roundridge', -linecolor => 'darkgreen') RETURNS 2 - TRACE: Perl/demos/demos/zinc_lib/items.pl line 25 add('text', 1, -font => -adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-* => -text => 'A filled rectangle with a "roundridge" relief border of 10 pixels.', -anchor => 'nw', -position => [120, 20]) RETURNS 3 - TRACE: Perl/demos/demos/zinc_lib/items.pl line 36 add('track', 1, 6, -labelformat => 'x82x60+0+0 x60a0^0^0 x32a0^0>1 a0a0>2>1 x32a0>3>1 a0a0^0>2', -position => [20, 120], -speedvector => [40, -10], -speedvectormark => 1, -speedvectorticks => 1) RETURNS 4 - -=head1 AUTHOR - -C.Mertz <mertz@cena.fr> and D.Etienne <etienne@cena.fr> - -=head1 CAVEATS and BUGS - -This module cannot be used when Tk::Zinc::TraceErrors is already in use. - -As every Tk::Zinc method call is followed by an ->update call, this may -dramatically slowdown an application. The trade-off is between application -run-time and developper debug-time. - -When using an output "code-like" they are still part of the output which is -not executable code. However, the ouptut could be easily and manually -edited to be executable perl code. - -=head1 COPYRIGHT - -See Tk::Zinc copyright; LGPL - -=head1 SEE ALSO - -L<Tk::Zinc(3pm)>, L<Tk::Zinc::TraceErrors(3pm)>. L<Tk::Zinc::Debug(3pm)>. - -=cut |