1# $Id: DocType.pm,v 1.1.1.1 2004/05/20 17:59:56 jpetri Exp $
2
3package XML::SAX::PurePerl;
4
5use strict;
6use XML::SAX::PurePerl::Productions qw($PubidChar);
7
8sub doctypedecl {
9    my ($self, $reader) = @_;
10
11    if ($reader->match_string('<!DOCTYPE')) {
12        $self->skip_whitespace($reader) ||
13            $self->parser_error("No whitespace after doctype declaration", $reader);
14
15        my $root_name = $self->Name($reader) ||
16            $self->parser_error("Doctype declaration has no root element name", $reader);
17
18        if ($self->skip_whitespace($reader)) {
19            # might be externalid...
20            my %dtd = $self->ExternalID($reader);
21            # TODO: Call SAX event
22        }
23
24        $self->skip_whitespace($reader);
25
26        $self->InternalSubset($reader);
27
28        $reader->match('>') ||
29                $self->parser_error("Doctype not closed", $reader);
30
31        return 1;
32    }
33
34    return 0;
35}
36
37sub ExternalID {
38    my ($self, $reader) = @_;
39
40    if ($reader->match_string('SYSTEM')) {
41        $self->skip_whitespace($reader) ||
42            $self->parser_error("No whitespace after SYSTEM identifier", $reader);
43        return (SYSTEM => $self->SystemLiteral($reader));
44    }
45    elsif ($reader->match_string('PUBLIC')) {
46        $self->skip_whitespace($reader) ||
47            $self->parser_error("No whitespace after PUBLIC identifier", $reader);
48
49        my $quote = $self->quote($reader) ||
50            $self->parser_error("Not a quote character in PUBLIC identifier", $reader);
51
52        $reader->consume(qr/[^$quote]/);
53        my $pubid = $reader->consumed;
54        if ($pubid !~ /^($PubidChar)+$/) {
55            $self->parser_error("Invalid characters in PUBLIC identifier", $reader);
56        }
57
58        $reader->match($quote) ||
59            $self->parser_error("Invalid quote character ending PUBLIC identifier", $reader);
60        $self->skip_whitespace($reader) ||
61            $self->parser_error("Not whitespace after PUBLIC ID in DOCTYPE", $reader);
62
63        return (PUBLIC => $pubid,
64                SYSTEM => $self->SystemLiteral($reader));
65    }
66    else {
67        return;
68    }
69
70    return 1;
71}
72
73sub SystemLiteral {
74    my ($self, $reader) = @_;
75
76    my $quote = $self->quote($reader);
77
78    $reader->consume(qr/[^$quote]/);
79    my $systemid = $reader->consumed;
80
81    $reader->match($quote) ||
82        $self->parser_error("Invalid token in System Literal", $reader);
83    return $systemid;
84}
85
86sub InternalSubset {
87    my ($self, $reader) = @_;
88
89    if ($reader->match('[')) {
90
91        1 while $self->IntSubsetDecl($reader);
92
93        $reader->match(']') ||
94            $self->parser_error("No close bracket on internal subset", $reader);
95        $self->skip_whitespace($reader);
96        return 1;
97    }
98
99    return 0;
100}
101
102sub IntSubsetDecl {
103    my ($self, $reader) = @_;
104
105    return $self->DeclSep($reader) || $self->markupdecl($reader);
106}
107
108sub DeclSep {
109    my ($self, $reader) = @_;
110
111    if ($self->skip_whitespace($reader)) {
112        return 1;
113    }
114
115    if ($self->PEReference($reader)) {
116        return 1;
117    }
118
119#    if ($self->ParsedExtSubset($reader)) {
120#        return 1;
121#    }
122
123    return 0;
124}
125
126sub PEReference {
127    my ($self, $reader) = @_;
128
129    if ($reader->match('%')) {
130        my $peref = $self->Name($reader) ||
131            $self->parser_error("PEReference did not find a Name", $reader);
132        # TODO - load/parse the peref
133
134        $reader->match(';') ||
135            $self->parser_error("Invalid token in PEReference", $reader);
136        return 1;
137    }
138
139    return 0;
140}
141
142sub markupdecl {
143    my ($self, $reader) = @_;
144
145    if ($self->elementdecl($reader) ||
146        $self->AttlistDecl($reader) ||
147        $self->EntityDecl($reader) ||
148        $self->NotationDecl($reader) ||
149        $self->PI($reader) ||
150        $self->Comment($reader))
151    {
152        return 1;
153    }
154
155    return 0;
156}
157
1581;
159