deprecated/buildtools/buildsystemtools/lib/XML/Handler/Subs.pm
author lorewang
Wed, 17 Nov 2010 11:24:29 +0800
changeset 685 39f7ecf8fbc7
parent 655 3f65fd25dfd4
permissions -rw-r--r--
pull from trunk
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
# Copyright (C) 1999 Ken MacLeod
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     3
# XML::Handler::XMLWriter is free software; you can redistribute it and/or
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     4
# modify it under the same terms as Perl itself.
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     5
#
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     6
# $Id: Subs.pm,v 1.2 1999/12/22 21:15:00 kmacleod Exp $
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     7
#
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     8
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
     9
use strict;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    10
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    11
package XML::Handler::Subs;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    12
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    13
use UNIVERSAL;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    14
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    15
use vars qw{ $VERSION };
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    16
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    17
# will be substituted by make-rel script
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    18
$VERSION = "0.07";
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    19
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    20
sub new {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    21
    my $type = shift;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    22
    my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ };
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    23
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    24
    return bless $self, $type;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    25
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    26
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    27
sub start_document {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    28
    my ($self, $document) = @_;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    29
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    30
    $self->{Names} = [];
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    31
    $self->{Nodes} = [];
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    32
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    33
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    34
sub end_document {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    35
    my ($self, $document) = @_;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    36
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    37
    delete $self->{Names};
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    38
    delete $self->{Nodes};
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    39
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    40
    return();
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    41
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    42
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    43
sub start_element {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    44
    my ($self, $element) = @_;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    45
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    46
    push @{$self->{Names}}, $element->{Name};
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    47
    push @{$self->{Nodes}}, $element;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    48
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    49
    my $el_name = "s_" . $element->{Name};
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    50
    $el_name =~ s/[^a-zA-Z0-9_]/_/g;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    51
    if ($self->can($el_name)) {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    52
	$self->$el_name($element);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    53
	return 1;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    54
    }
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    55
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    56
    return 0;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    57
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    58
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    59
sub end_element {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    60
    my ($self, $element) = @_;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    61
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    62
    my $called_sub = 0;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    63
    my $el_name = "e_" . $element->{Name};
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    64
    $el_name =~ s/[^a-zA-Z0-9_]/_/g;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    65
    if ($self->can(${el_name})) {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    66
	$self->$el_name($element);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    67
	$called_sub = 1;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    68
    }
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    69
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    70
    pop @{$self->{Names}};
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    71
    pop @{$self->{Nodes}};
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    72
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    73
    return $called_sub;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    74
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    75
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    76
sub in_element {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    77
    my ($self, $name) = @_;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    78
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    79
    return ($self->{Names}[-1] eq $name);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    80
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    81
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    82
sub within_element {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    83
    my ($self, $name) = @_;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    84
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    85
    my $count = 0;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    86
    foreach my $el_name (@{$self->{Names}}) {
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    87
	$count ++ if ($el_name eq $name);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    88
    }
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    89
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    90
    return $count;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    91
}
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    92
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    93
1;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    94
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    95
__END__
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    96
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    97
=head1 NAME
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    98
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
    99
XML::Handler::Subs - a PerlSAX handler base class for calling user-defined subs
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   100
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   101
=head1 SYNOPSIS
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   102
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   103
 use XML::Handler::Subs;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   104
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   105
 package MyHandlers;
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   106
 use vars qw{ @ISA };
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   107
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   108
 sub s_NAME { my ($self, $element) = @_ };
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   109
 sub e_NAME { my ($self, $element) = @_ };
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   110
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   111
 $self->{Names};    # an array of names
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   112
 $self->{Nodes};    # an array of $element nodes
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   113
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   114
 $handler = MyHandlers->new();
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   115
 $self->in_element($name);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   116
 $self->within_element($name);
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   117
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   118
=head1 DESCRIPTION
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   119
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   120
C<XML::Handler::Subs> is a base class for PerlSAX handlers.
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   121
C<XML::Handler::Subs> is subclassed to implement complete behavior and
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   122
to add element-specific handling.
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   123
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   124
Each time an element starts, a method by that name prefixed with `s_'
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   125
is called with the element to be processed.  Each time an element
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   126
ends, a method with that name prefixed with `e_' is called.  Any
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   127
special characters in the element name are replaced by underscores.
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   128
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   129
Subclassing XML::Handler::Subs in this way is similar to
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   130
XML::Parser's Subs style.
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   131
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   132
XML::Handler::Subs maintains a stack of element names,
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   133
`C<$self->{Names}', and a stack of element nodes, `C<$self->{Nodes}>'
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   134
that can be used by subclasses.  The current element is pushed on the
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   135
stacks before calling an element-name start method and popped off the
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   136
stacks after calling the element-name end method.  The
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   137
`C<in_element()>' and `C<within_element()>' calls use these stacks.
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   138
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   139
If the subclass implements `C<start_document()>', `C<end_document()>',
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   140
`C<start_element()>', and `C<end_element()>', be sure to use
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   141
`C<SUPER::>' to call the the superclass methods also.  See perlobj(1)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   142
for details on SUPER::.  `C<SUPER::start_element()>' and
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   143
`C<SUPER::end_element()>' return 1 if an element-name method is
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   144
called, they return 0 if no method was called.
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   145
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   146
XML::Handler::Subs does not implement any other PerlSAX handlers.
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   147
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   148
XML::Handler::Subs supports the following methods:
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   149
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   150
=over 4
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   151
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   152
=item new( I<OPTIONS> )
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   153
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   154
A basic `C<new()>' method.  `C<new()>' takes a list of key, value
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   155
pairs or a hash and creates and returns a hash with those options; the
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   156
hash is blessed into the subclass.
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   157
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   158
=item in_element($name)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   159
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   160
Returns true if `C<$name>' is equal to the name of the innermost
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   161
currently opened element.
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   162
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   163
=item within_element($name)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   164
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   165
Returns the number of times the `C<$name>' appears in Names.
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   166
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   167
=back
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   168
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   169
=head1 AUTHOR
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   170
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   171
Ken MacLeod, ken@bitsko.slc.ut.us
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   172
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   173
=head1 SEE ALSO
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   174
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   175
perl(1), PerlSAX.pod(3)
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   176
3f65fd25dfd4 sync up SVN codes
kelvzhu
parents:
diff changeset
   177
=cut