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