1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
#
# 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) 2003 CENA, D.Etienne <etienne@cena.fr> to trace all
# Tk::Zinc errors.
#
# This package overloads the Tk::Zinc::WidgetMethods function in order to
# to trap errors by calling every Tk::Zinc method in an eval() block.
#
# This may be very usefull when your application encounters errors such as
# "error .... at /usr/lib/perl5/Tk.pm line 228". With ZincTraceErrors, the
# module name, the line number and the complete error messages are reported
# for each error.
#
# $Id$
#
# When you have no idea where this happens in your code or when your
# application segfaults, use the Tk::Zinc::Trace package which traces every
# Tk::Zinc method call.
#
# for using this file do some thing like :
# perl -MTk::Zinc::TraceErrors myappli.pl
package Tk::Zinc::TraceErrors;
use vars qw( $VERSION );
($VERSION) = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/);
use Tk;
use strict;
use Tk::Zinc::TraceUtils;
my $WidgetMethodfunction;
my $bold = "[1m";
my $_bold = "[m";
BEGIN {
my $bold = "[1m";
my $_bold = "[m";
if (defined $ZincTrace::on and $ZincTrace::on == 1) {
print STDERR $bold."Tk::Zinc::TraceErrors: incompatible package Tk::Zinc::Trace is already ".
"loaded".$_bold." (exit 1)\n";
exit 1;
}
print $bold."Tk::Zinc::TraceErrors is ON".$_bold."\n";
$ZincTraceErrors::on = 1;
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');
}
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;
# invoke function possibly overloaded in other modules
my ($res, @res);
if (wantarray()) {
eval {@res = &$WidgetMethodfunction(@_) if $WidgetMethodfunction;};
} else {
eval {$res = &$WidgetMethodfunction(@_) if $WidgetMethodfunction;};
}
if ($@) {
print $bold."error:".$_bold." $filename line $line $name";
&printList (@args);
my $msg = $@;
$msg =~ s/at .*//g;
print " ".$bold."returns".$_bold." $msg\n";
}
if (wantarray()) {
return @res;
} else {
return $res;
}
}
1;
__END__
=head1 NAME
Tk::Zinc::TraceErrors - A module to trace all Tk::Zinc method calls which generate an error
=head1 SYNOPSIS
use Tk::Zinc::TraceErrors;
or
perl -MTk::Zinc::TraceErrors YourZincBasedScript.pl
=head1 DESCRIPTION
When loaded, this module overloads a Tk mechanism so that every
Tk::Zinc method call will be traced if it provokes an error. The execution
will then continue.
This module can be very effective for debugging and application, specially
when Tk gives an unusuable error message such as ".... errors in Tk.pm line 228"
=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 error message
=back
=head1 AUTHOR
D.Etienne <etienne@cena.fr> and C.Mertz <mertz@cena.fr>
=head1 CAVEAT
This module cannot be used when Tk::Zinc::Trace is already in use.
=head1 COPYRIGHT
See Tk::Zinc copyright; LGPL
=head1 SEE ALSO
L<Tk::Zinc(3pm)>, L<Tk::Zinc::Trace(3pm)>. L<Tk::Zinc::Debug(3pm)>.
=cut
|
