|
1 # |
|
2 # This PerlSAX handler prints out all the PerlSAX events/callbacks |
|
3 # it receives. Very useful when debugging. |
|
4 # |
|
5 |
|
6 package XML::Handler::PrintEvents; |
|
7 use strict; |
|
8 use XML::Filter::SAXT; |
|
9 |
|
10 my @EXTRA_HANDLERS = ( 'ignorable_whitespace' ); |
|
11 |
|
12 sub new |
|
13 { |
|
14 my ($class, %options) = @_; |
|
15 bless \%options, $class; |
|
16 } |
|
17 |
|
18 sub print_event |
|
19 { |
|
20 my ($self, $event_name, $event) = @_; |
|
21 |
|
22 printf "%-22s ", $event_name; |
|
23 if (defined $event) |
|
24 { |
|
25 print join (", ", map { "$_ => [" . |
|
26 (defined $event->{$_} ? $event->{$_} : "(undef)") |
|
27 . "]" } keys %$event); |
|
28 } |
|
29 print "\n"; |
|
30 } |
|
31 |
|
32 # |
|
33 # This generates the PerlSAX handler methods for PrintEvents. |
|
34 # They basically forward the event to print_event() while adding the callback |
|
35 # (event) name. |
|
36 # |
|
37 for my $cb (@EXTRA_HANDLERS, map { @{$_} } values %XML::Filter::SAXT::SAX_HANDLERS) |
|
38 { |
|
39 eval "sub $cb { shift->print_event ('$cb', \@_) }"; |
|
40 } |
|
41 |
|
42 1; # package return code |
|
43 |
|
44 __END__ |
|
45 |
|
46 =head1 NAME |
|
47 |
|
48 XML::Handler::PrintEvents - Prints PerlSAX events (for debugging) |
|
49 |
|
50 =head1 SYNOPSIS |
|
51 |
|
52 use XML::Handler::PrintEvents; |
|
53 |
|
54 my $pr = new XML::Handler::PrintEvents; |
|
55 |
|
56 =head1 DESCRIPTION |
|
57 |
|
58 This PerlSAX handler prints the PerlSAX events it receives to STDOUT. |
|
59 It can be useful when debugging PerlSAX filters. |
|
60 It supports all PerlSAX handler including ignorable_whitespace. |
|
61 |
|
62 =head1 AUTHOR |
|
63 |
|
64 Send bug reports, hints, tips, suggestions to Enno Derksen at |
|
65 <F<enno@att.com>>. |
|
66 |
|
67 =cut |