1# $Id: PerlSAX.pm,v 1.6 2000/02/28 10:40:21 matt Exp $
2
3package XML::XPath::PerlSAX;
4use XML::XPath::XMLParser;
5use strict;
6
7sub new {
8	my $class = shift;
9	my %args = @_;
10	bless \%args, $class;
11}
12
13sub parse {
14	my $self = shift;
15
16	die "XML::XPath::PerlSAX: parser instance ($self) already parsing\n"
17		if (defined $self->{ParseOptions});
18
19	# If there's one arg and it's an array ref, assume it's a node we're parsing
20	my $args;
21	if (@_ == 1 && ref($_[0]) =~ /^(text|comment|element|namespace|attribute|pi)$/) {
22#		warn "Parsing node\n";
23		my $node = shift;
24#		warn "PARSING: $node ", XML::XPath::XMLParser::as_string($node), "\n\n";
25		$args = { Source => { Node => $node } };
26	}
27	else {
28		$args = (@_ == 1) ? shift : { @_ };
29	}
30
31	my $parse_options = { %$self, %$args };
32	$self->{ParseOptions} = $parse_options;
33
34	# ensure that we have at least one source
35	if (!defined $parse_options->{Source} ||
36		!defined $parse_options->{Source}{Node}) {
37		die "XML::XPath::PerlSAX: no source defined for parse\n";
38	}
39
40	# assign default Handler to any undefined handlers
41	if (defined $parse_options->{Handler}) {
42		$parse_options->{DocumentHandler} = $parse_options->{Handler}
43			if (!defined $parse_options->{DocumentHandler});
44	}
45
46	# ensure that we have a DocumentHandler
47	if (!defined $parse_options->{DocumentHandler}) {
48		die "XML::XPath::PerlSAX: no Handler or DocumentHandler defined for parse\n";
49	}
50
51	# cache DocumentHandler in self for callbacks
52	$self->{DocumentHandler} = $parse_options->{DocumentHandler};
53
54	if ((ref($parse_options->{Source}{Node}) eq 'element') &&
55			!($parse_options->{Source}{Node}->[node_parent])) {
56		# Got root node
57		$self->{DocumentHandler}->start_document( { } );
58		$self->parse_node($parse_options->{Source}{Node});
59		return $self->{DocumentHandler}->end_document( { } );
60	}
61	else {
62		$self->parse_node($parse_options->{Source}{Node});
63	}
64
65	# clean up parser instance
66	delete $self->{ParseOptions};
67	delete $self->{DocumentHandler};
68
69}
70
71sub parse_node {
72	my $self = shift;
73	my $node = shift;
74#	warn "parse_node $node\n";
75	if (ref($node) eq 'element' && $node->[node_parent]) {
76		# bundle up attributes
77		my @attribs;
78		foreach my $attr (@{$node->[node_attribs]}) {
79			if ($attr->[node_prefix]) {
80				push @attribs, $attr->[node_prefix] . ":" . $attr->[node_key];
81			}
82			else {
83				push @attribs, $attr->[node_key];
84			}
85			push @attribs, $attr->[node_value];
86		}
87
88		$self->{DocumentHandler}->start_element(
89				{ Name => $node->[node_name],
90				  Attributes => \@attribs,
91				}
92			);
93		foreach my $kid (@{$node->[node_children]}) {
94			$self->parse_node($kid);
95		}
96		$self->{DocumentHandler}->end_element(
97				{
98					Name => $node->[node_name],
99				}
100			);
101	}
102	elsif (ref($node) eq 'text') {
103		$self->{DocumentHandler}->characters($node->[node_text]);
104	}
105	elsif (ref($node) eq 'comment') {
106		$self->{DocumentHandler}->comment($node->[node_comment]);
107	}
108	elsif (ref($node) eq 'pi') {
109		$self->{DocumentHandler}->processing_instruction(
110				{
111					Target => $node->[node_target],
112					Data => $node->[node_data]
113				}
114			);
115	}
116	elsif (ref($node) eq 'element') { # root node
117		# just do kids
118		foreach my $kid (@{$node->[node_children]}) {
119			$self->parse_node($kid);
120		}
121	}
122	else {
123		die "Unknown node type: '", ref($node), "' ", scalar(@$node), "\n";
124	}
125}
126
1271;
128
129__END__
130
131=head1 NAME
132
133XML::XPath::PerlSAX - A PerlSAX event generator for my wierd node structure
134
135=head1 SYNOPSIS
136
137	use XML::XPath;
138	use XML::XPath::PerlSAX;
139	use XML::DOM::PerlSAX;
140
141	my $xp = XML::XPath->new(filename => 'test.xhtml');
142	my $paras = $xp->find('/html/body/p');
143
144	my $handler = XML::DOM::PerlSAX->new();
145	my $generator = XML::XPath::PerlSAX->new( Handler => $handler );
146
147	foreach my $node ($paras->get_nodelist) {
148		my $domtree = $generator->parse($node);
149		# do something with $domtree
150	}
151
152=head1 DESCRIPTION
153
154This module generates PerlSAX events to pass to a PerlSAX handler such
155as XML::DOM::PerlSAX. It operates specifically on my wierd tree format.
156
157Unfortunately SAX doesn't seem to cope with namespaces, so these are
158lost completely. I believe SAX2 is doing namespaces.
159
160=head1 Other
161
162The XML::DOM::PerlSAX handler I tried was completely broken (didn't even
163compile before I patched it a bit), so I don't know how correct this
164is or how far it will work.
165
166This software may only be distributed as part of the XML::XPath package.
167