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