1 package XML::XQL::Debug; |
|
2 |
|
3 # Replaces the filepath separator if necessary (i.e for Macs and Windows/DOS) |
|
4 sub filename |
|
5 { |
|
6 my $name = shift; |
|
7 |
|
8 if ((defined $^O and |
|
9 $^O =~ /MSWin32/i || |
|
10 $^O =~ /Windows_95/i || |
|
11 $^O =~ /Windows_NT/i) || |
|
12 (defined $ENV{OS} and |
|
13 $ENV{OS} =~ /MSWin32/i || |
|
14 $ENV{OS} =~ /Windows_95/i || |
|
15 $ENV{OS} =~ /Windows_NT/i)) |
|
16 { |
|
17 $name =~ s!/!\\!g; |
|
18 } |
|
19 elsif ((defined $^O and $^O =~ /MacOS/i) || |
|
20 (defined $ENV{OS} and $ENV{OS} =~ /MacOS/i)) |
|
21 { |
|
22 $name =~ s!/!:!g; |
|
23 $name = ":$name"; |
|
24 } |
|
25 $name; |
|
26 } |
|
27 |
|
28 sub dump |
|
29 { |
|
30 new XML::XQL::Debug::Dump->pr (@_); |
|
31 } |
|
32 |
|
33 sub str |
|
34 { |
|
35 my $dump = new XML::XQL::Debug::Dump; |
|
36 $dump->pr (@_); |
|
37 $dump->{Str} =~ tr/\012/\n/; # for MacOS where '\012' != '\n' |
|
38 $dump->{Str}; |
|
39 } |
|
40 |
|
41 package XML::XQL::Debug::Dump; |
|
42 |
|
43 sub new |
|
44 { |
|
45 my ($class, %args) = @_; |
|
46 $args{Indent} = 0; |
|
47 $args{Str} = ""; |
|
48 bless \%args, $class; |
|
49 } |
|
50 |
|
51 sub indent |
|
52 { |
|
53 $_[0]->p (" " x $_[0]->{Indent}); |
|
54 } |
|
55 |
|
56 sub ip |
|
57 { |
|
58 my $self = shift; |
|
59 $self->indent; |
|
60 $self->p (@_); |
|
61 } |
|
62 |
|
63 sub pr |
|
64 { |
|
65 my ($self, $x) = @_; |
|
66 if (ref($x)) |
|
67 { |
|
68 if (ref($x) eq "ARRAY") |
|
69 { |
|
70 if (@$x == 0) |
|
71 { |
|
72 $self->ip ("<array/>\n"); |
|
73 return; |
|
74 } |
|
75 |
|
76 $self->ip ("<array>\n"); |
|
77 $self->{Indent}++; |
|
78 |
|
79 for (my $i = 0; $i < @$x; $i++) |
|
80 { |
|
81 $self->ip ("<item index='$i'>\n"); |
|
82 $self->{Indent}++; |
|
83 |
|
84 $self->pr ($x->[$i]); |
|
85 |
|
86 $self->{Indent}--; |
|
87 $self->ip ("</item>\n"); |
|
88 } |
|
89 $self->{Indent}--; |
|
90 $self->ip ("</array>\n"); |
|
91 } |
|
92 else |
|
93 { |
|
94 $self->ip ("<obj type='" . ref($x) . "'>"); |
|
95 |
|
96 if ($x->isa ('XML::XQL::PrimitiveType')) |
|
97 { |
|
98 $self->p ($x->xql_toString); |
|
99 } |
|
100 else |
|
101 { |
|
102 $self->p ("\n"); |
|
103 $self->{Indent}++; |
|
104 |
|
105 if ($x->isa ("XML::DOM::Node")) |
|
106 { |
|
107 # print node plus subnodes as XML |
|
108 $self->p ($x->toString); |
|
109 } |
|
110 $self->p ("\n"); |
|
111 |
|
112 $self->{Indent}--; |
|
113 $self->indent; |
|
114 } |
|
115 $self->p ("</obj>\n"); |
|
116 } |
|
117 } |
|
118 elsif (defined $x) |
|
119 { |
|
120 $self->indent; |
|
121 $self->p ("<str>$x<str/>\n"); |
|
122 } |
|
123 else |
|
124 { |
|
125 $self->indent; |
|
126 $self->p ("<undef/>\n"); |
|
127 } |
|
128 } |
|
129 |
|
130 sub p |
|
131 { |
|
132 my $self = shift; |
|
133 |
|
134 if ($self->{Dump}) |
|
135 { |
|
136 print @; |
|
137 } |
|
138 else |
|
139 { |
|
140 $self->{Str} .= join ("", @_); |
|
141 } |
|
142 } |
|
143 |
|
144 1; |
|