Ajout du module ZincTraceErrors qui trappe les erreurs Zinc et affiche

pour chaque erreur l'instruction et le message d'erreur.
Factorisation de code dans ZincTraceUtils.pm

1 files changed, 90 insertions, 0 deletions

diff --git a/Perl/debug/ZincTraceUtils.pm b/Perl/debug/ZincTraceUtils.pm
new file mode 100644
index 0000000..60628a8
--- /dev/null
+++ b/Perl/debug/ZincTraceUtils.pm
@@ -0,0 +1,90 @@
+package ZincTraceUtils;
+
+use Tk;
+use strict;
+use Tk::Font;
+use Tk::Photo;
+use vars qw(@EXPORT);
+@EXPORT = qw(printItem printArray printList);
+
+
+### to print something
+sub printItem {
+    my ($value) = @_;
+    my $ref = ref($value);
+#    print "VALUE=$value REF=$ref\n";
+    if ($ref eq 'ARRAY') {
+	printArray ( @{$value} );
+    }
+    elsif ($ref eq 'CODE') {
+	print "{CODE}";
+    }
+    elsif ($ref eq 'Tk::Photo') {
+#	print " **** $value ***** ";
+	print "Tk::Photo(\"". scalar $value->cget('-file') . "\")";
+    }
+    elsif ($ref eq 'Tk::Font') {
+	print "'$value'";
+    }
+    elsif ($ref eq '') {  # scalar 
+	if (defined $value) {
+	    if ($value eq '') {
+		print  "''";
+	    } elsif ($value =~ /\s/
+		     or $value =~ /^[a-zA-Z]/
+		     or $value =~ /^[\W]$/ ) {
+		print "'$value'";
+	    }  else {
+		print $value;
+	    }
+	}
+	else {
+	    print "undef";
+	}
+    }
+    else { # some  class instance
+	return $value;
+    }
+    
+} # end printitem
+
+
+### to print a list of something
+sub printArray {
+    my (@values) = @_;
+    if (! scalar @values) {
+	print "[]";
+    }
+    else {  # the list is not empty
+	my @res;
+	print "[";
+	while (@values) {
+	    my $value = shift @values;
+	    &printItem ($value);
+	    print ", " if (@values);
+	}
+	print "]" ;
+    }
+    
+} # end printArray
+
+
+sub printList {
+    print "(";
+    while (@_) {
+	my $v = shift @_;
+	printItem $v;
+	if ($v =~ /^-\w+/) {
+	    print " => ";
+	} elsif (@_) {
+	    print ", ";
+	}
+    }
+    print ")";
+    
+} # end printList
+
+1;
+
+
+