|
Packit |
d27c7e |
#
|
|
Packit |
d27c7e |
# Copyright (C) 1999 Ken MacLeod
|
|
Packit |
d27c7e |
# XML::Handler::XMLWriter is free software; you can redistribute it and/or
|
|
Packit |
d27c7e |
# modify it under the same terms as Perl itself.
|
|
Packit |
d27c7e |
#
|
|
Packit |
d27c7e |
# $Id: Subs.pm,v 1.2 1999/12/22 21:15:00 kmacleod Exp $
|
|
Packit |
d27c7e |
#
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
use strict;
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
package XML::Handler::Subs;
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
use UNIVERSAL;
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
use vars qw{ $VERSION };
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
# will be substituted by make-rel script
|
|
Packit |
d27c7e |
$VERSION = "0.08";
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
sub new {
|
|
Packit |
d27c7e |
my $type = shift;
|
|
Packit |
d27c7e |
my $self = ($#_ == 0) ? { %{ (shift) } } : { @_ };
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
return bless $self, $type;
|
|
Packit |
d27c7e |
}
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
sub start_document {
|
|
Packit |
d27c7e |
my ($self, $document) = @_;
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
$self->{Names} = [];
|
|
Packit |
d27c7e |
$self->{Nodes} = [];
|
|
Packit |
d27c7e |
}
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
sub end_document {
|
|
Packit |
d27c7e |
my ($self, $document) = @_;
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
delete $self->{Names};
|
|
Packit |
d27c7e |
delete $self->{Nodes};
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
return();
|
|
Packit |
d27c7e |
}
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
sub start_element {
|
|
Packit |
d27c7e |
my ($self, $element) = @_;
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
push @{$self->{Names}}, $element->{Name};
|
|
Packit |
d27c7e |
push @{$self->{Nodes}}, $element;
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
my $el_name = "s_" . $element->{Name};
|
|
Packit |
d27c7e |
$el_name =~ s/[^a-zA-Z0-9_]/_/g;
|
|
Packit |
d27c7e |
if ($self->can($el_name)) {
|
|
Packit |
d27c7e |
$self->$el_name($element);
|
|
Packit |
d27c7e |
return 1;
|
|
Packit |
d27c7e |
}
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
return 0;
|
|
Packit |
d27c7e |
}
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
sub end_element {
|
|
Packit |
d27c7e |
my ($self, $element) = @_;
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
my $called_sub = 0;
|
|
Packit |
d27c7e |
my $el_name = "e_" . $element->{Name};
|
|
Packit |
d27c7e |
$el_name =~ s/[^a-zA-Z0-9_]/_/g;
|
|
Packit |
d27c7e |
if ($self->can(${el_name})) {
|
|
Packit |
d27c7e |
$self->$el_name($element);
|
|
Packit |
d27c7e |
$called_sub = 1;
|
|
Packit |
d27c7e |
}
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
pop @{$self->{Names}};
|
|
Packit |
d27c7e |
pop @{$self->{Nodes}};
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
return $called_sub;
|
|
Packit |
d27c7e |
}
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
sub in_element {
|
|
Packit |
d27c7e |
my ($self, $name) = @_;
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
return ($self->{Names}[-1] eq $name);
|
|
Packit |
d27c7e |
}
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
sub within_element {
|
|
Packit |
d27c7e |
my ($self, $name) = @_;
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
my $count = 0;
|
|
Packit |
d27c7e |
foreach my $el_name (@{$self->{Names}}) {
|
|
Packit |
d27c7e |
$count ++ if ($el_name eq $name);
|
|
Packit |
d27c7e |
}
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
return $count;
|
|
Packit |
d27c7e |
}
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
1;
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
__END__
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
=head1 NAME
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
XML::Handler::Subs - a PerlSAX handler base class for calling user-defined subs
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
=head1 SYNOPSIS
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
use XML::Handler::Subs;
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
package MyHandlers;
|
|
Packit |
d27c7e |
use vars qw{ @ISA };
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
sub s_NAME { my ($self, $element) = @_ };
|
|
Packit |
d27c7e |
sub e_NAME { my ($self, $element) = @_ };
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
$self->{Names}; # an array of names
|
|
Packit |
d27c7e |
$self->{Nodes}; # an array of $element nodes
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
$handler = MyHandlers->new();
|
|
Packit |
d27c7e |
$self->in_element($name);
|
|
Packit |
d27c7e |
$self->within_element($name);
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
=head1 DESCRIPTION
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
C<XML::Handler::Subs> is a base class for PerlSAX handlers.
|
|
Packit |
d27c7e |
C<XML::Handler::Subs> is subclassed to implement complete behavior and
|
|
Packit |
d27c7e |
to add element-specific handling.
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
Each time an element starts, a method by that name prefixed with `s_'
|
|
Packit |
d27c7e |
is called with the element to be processed. Each time an element
|
|
Packit |
d27c7e |
ends, a method with that name prefixed with `e_' is called. Any
|
|
Packit |
d27c7e |
special characters in the element name are replaced by underscores.
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
Subclassing XML::Handler::Subs in this way is similar to
|
|
Packit |
d27c7e |
XML::Parser's Subs style.
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
XML::Handler::Subs maintains a stack of element names,
|
|
Packit |
d27c7e |
`C<$self->{Names}', and a stack of element nodes, `C<$self->{Nodes}>'
|
|
Packit |
d27c7e |
that can be used by subclasses. The current element is pushed on the
|
|
Packit |
d27c7e |
stacks before calling an element-name start method and popped off the
|
|
Packit |
d27c7e |
stacks after calling the element-name end method. The
|
|
Packit |
d27c7e |
`C<in_element()>' and `C<within_element()>' calls use these stacks.
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
If the subclass implements `C<start_document()>', `C<end_document()>',
|
|
Packit |
d27c7e |
`C<start_element()>', and `C<end_element()>', be sure to use
|
|
Packit |
d27c7e |
`C<SUPER::>' to call the the superclass methods also. See perlobj(1)
|
|
Packit |
d27c7e |
for details on SUPER::. `C<SUPER::start_element()>' and
|
|
Packit |
d27c7e |
`C<SUPER::end_element()>' return 1 if an element-name method is
|
|
Packit |
d27c7e |
called, they return 0 if no method was called.
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
XML::Handler::Subs does not implement any other PerlSAX handlers.
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
XML::Handler::Subs supports the following methods:
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
=over 4
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
=item new( I<OPTIONS> )
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
A basic `C<new()>' method. `C<new()>' takes a list of key, value
|
|
Packit |
d27c7e |
pairs or a hash and creates and returns a hash with those options; the
|
|
Packit |
d27c7e |
hash is blessed into the subclass.
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
=item in_element($name)
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
Returns true if `C<$name>' is equal to the name of the innermost
|
|
Packit |
d27c7e |
currently opened element.
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
=item within_element($name)
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
Returns the number of times the `C<$name>' appears in Names.
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
=back
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
=head1 AUTHOR
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
Ken MacLeod, ken@bitsko.slc.ut.us
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
=head1 SEE ALSO
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
perl(1), PerlSAX.pod(3)
|
|
Packit |
d27c7e |
|
|
Packit |
d27c7e |
=cut
|