1package DJabberd::XMLParser;
2use strict;
3use vars qw($VERSION @ISA);
4$VERSION = '1.00';
5use XML::LibXML;
6use XML::SAX::Base;
7use base qw(XML::SAX::Base);
8use Carp;
9use Scalar::Util ();
10
11our $instance_count = 0;
12
13sub new {
14    my ($class, @params) = @_;
15    my $self = $class->SUPER::new(@params);
16
17    # libxml mode:
18    if (1) {
19        my $libxml = XML::LibXML->new({
20            no_network => 1,
21            load_ext_dtd => 0,
22            expand_entities => 0,
23            expand_xinclude => 0,
24            ext_ent_handler => sub {
25                # my ($sys_id, $pub_id) = @_;
26                # warn "Received external entity: $sys_id:$pub_id";
27                "";
28            },
29        });
30        $libxml->set_handler($self);
31        $self->{LibParser} = $libxml;
32
33        # this buys nothing but less noise when using Devel::Cycle:
34        # make it a developer option?
35        # Scalar::Util::weaken($self->{LibParser});
36
37        $libxml->init_push;
38        $self->{CONTEXT} = $libxml->{CONTEXT};
39    }
40
41    # expat mode:
42    if (0) {
43        #use XML::SAX::Expat::Incremental;
44        my $parser = XML::SAX::Expat::Incremental->new(Handler => $self);
45        $self->{expat} = $parser;
46        $parser->parse_start;
47    }
48
49    $instance_count++;
50    return $self;
51}
52
53*parse_more = \&parse_chunk;
54sub parse_chunk {
55    #my ($self, $chunk) = @_;
56
57    # 'push' (wrapper around _push) without context also works,
58    # but _push (xs) is enough faster...
59    $_[0]->{LibParser}->_push($_[0]->{CONTEXT},
60                              $_[1]);
61
62    # expat version:
63    # $_[0]->{expat}->parse_more($_[1]);
64}
65
66sub parse_chunk_scalarref {
67    #my ($self, $chunk) = @_;
68
69    # 'push' (wrapper around _push) without context also works,
70    # but _push (xs) is enough faster...
71    $_[0]->{LibParser}->_push($_[0]->{CONTEXT},
72                              ${$_[1]});
73
74    # expat version:
75    # $_[0]->{expat}->parse_more(${$_[1]});
76}
77
78sub finish_push {
79    my $self = shift;
80    return 1 unless $self->{LibParser};
81    my $parser = delete $self->{LibParser};
82    eval { $parser->finish_push };
83    delete $self->{Handler};
84    delete $self->{CONTEXT};
85    return 1;
86}
87
88sub DESTROY {
89    my $self = shift;
90    $instance_count--;
91    bless $self, 'XML::SAX::Base';
92}
93