- man page (pod) added

- output trace can now be optionnaly formated as perl
  executable code

1 files changed, 148 insertions, 7 deletions

diff --git a/Perl/Zinc/Trace.pm b/Perl/Zinc/Trace.pm
index fcd595f..ad219e6 100644
--- a/Perl/Zinc/Trace.pm
+++ b/Perl/Zinc/Trace.pm
@@ -29,19 +29,28 @@ 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 ($ZincTraceErrors::on == 1) {
+    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 is ON\n";
+    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)
@@ -51,25 +60,63 @@ BEGIN {
     
 }
 
+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) = @_;
     my ($package, $filename, $line) = caller(1);
     $package="" unless defined $package;
     $filename="" unless defined $filename;
     $line="" unless defined $line;
-    print "TRACE: $filename line $line $name";
+    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;
-	print "  RETURNS ";
-	&printList (@res); print "\n";
+	if ($ForReplay) {
+	    print ";\n";
+	} else {
+	    print "  RETURNS ";
+	    &printList (@res);
+	    print "\n";
+	}
 	$zinc->update;
 	return @res;
     } else {
 	my $res = &$WidgetMethodfunction(@_) if $WidgetMethodfunction;
-	print "  RETURNS ";
-	&printItem ($res); print "\n";
+	if ($ForReplay) {
+	    print ";\n";
+	} else {
+	    print "  RETURNS ";
+	    &printItem ($res);
+	    print "\n";
+	}
 	$zinc->update;
 	return $res;
     }
@@ -78,4 +125,98 @@ sub Tk::Zinc::WidgetMethod {
 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
+
+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