aboutsummaryrefslogtreecommitdiff
path: root/Perl/debug/ZincTraceUtils.pm
blob: 60628a848bbbd9f2bcdd749304ce761854d72645 (plain)
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
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;