655
|
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
|