ref: 38c0cf0737de03906729054ad7b7b011dd1ca475
dir: /appl/lib/xml.b/
implement Xml; # # Portions copyright © 2002 Vita Nuova Holdings Limited # # # Derived from saxparser.b Copyright © 2001-2002 by John Powers or his employer # # TO DO: # - provide a way of getting attributes out of <?...?> (process) requests, # so that we can process stylesheet requests given in that way. include "sys.m"; sys: Sys; include "bufio.m"; bufio: Bufio; Iobuf: import bufio; include "string.m"; str: String; include "hash.m"; hash: Hash; HashTable: import hash; include "xml.m"; Parcel: adt { pick { Start or Empty => name: string; attrs: Attributes; End => name: string; Text => ch: string; ws1, ws2: int; Process => target: string; data: string; Error => loc: Locator; msg: string; Doctype => name: string; public: int; params: list of string; Stylesheet => attrs: Attributes; EOF => } }; entinit := array[] of { ("AElig", "Æ"), ("OElig", "Œ"), ("aelig", "æ"), ("amp", "&"), ("apos", "\'"), ("copy", "©"), ("gt", ">"), ("ldquo", "``"), ("lt", "<"), ("mdash", "-"), # XXX ?? ("oelig", "œ"), ("quot", "\""), ("rdquo", "''"), ("rsquo", "'"), ("trade", "™"), ("nbsp", "\u00a0"), }; entdict: ref HashTable; init(): string { sys = load Sys Sys->PATH; bufio = load Bufio Bufio->PATH; if (bufio == nil) return sys->sprint("cannot load %s: %r", Bufio->PATH); str = load String String->PATH; if (str == nil) return sys->sprint("cannot load %s: %r", String->PATH); hash = load Hash Hash->PATH; if (hash == nil) return sys->sprint("cannot load %s: %r", Hash->PATH); entdict = hash->new(23); for (i := 0; i < len entinit; i += 1) { (key, value) := entinit[i]; entdict.insert(key, (0, 0.0, value)); } return nil; } blankparser: Parser; open(srcfile: string, warning: chan of (Locator, string), preelem: string): (ref Parser, string) { fd := bufio->open(srcfile, Bufio->OREAD); if(fd == nil) return (nil, sys->sprint("cannot open %s: %r", srcfile)); return fopen(fd, srcfile, warning, preelem); } fopen(fd: ref Bufio->Iobuf, name: string, warning: chan of (Locator, string), preelem: string): (ref Parser, string) { x := ref blankparser; x.in = fd; # ignore utf16 initialisation character (yuck) c := x.in.getc(); if (c != 16rfffe && c != 16rfeff) x.in.ungetc(); x.estack = nil; x.loc = Locator(1, name, ""); x.warning = warning; x.preelem = preelem; return (x, ""); } Parser.next(x: self ref Parser): ref Item { curroffset := x.fileoffset; currloc := x.loc; # read up until end of current item while (x.actdepth > x.readdepth) { pick p := getparcel(x) { Start => x.actdepth++; End => x.actdepth--; EOF => x.actdepth = 0; # premature EOF closes all tags Error => return ref Item.Error(curroffset, x.loc, x.errormsg); } } if (x.actdepth < x.readdepth) { x.fileoffset = int x.in.offset(); return nil; } gp := getparcel(x); item: ref Item; pick p := gp { Start => x.actdepth++; item = ref Item.Tag(curroffset, p.name, p.attrs); End => x.actdepth--; item = nil; EOF => x.actdepth = 0; item = nil; Error => x.actdepth = 0; # XXX is this the right thing to do? item = ref Item.Error(curroffset, currloc, x.errormsg); Text => item = ref Item.Text(curroffset, p.ch, p.ws1, p.ws2); Process => item = ref Item.Process(curroffset, p.target, p.data); Empty => item = ref Item.Tag(curroffset, p.name, p.attrs); Doctype => item = ref Item.Doctype(curroffset, p.name, p.public, p.params); Stylesheet => item = ref Item.Stylesheet(curroffset, p.attrs); } x.fileoffset = int x.in.offset(); return item; } Parser.atmark(x: self ref Parser, m: ref Mark): int { return int x.in.offset() == m.offset; } Parser.down(x: self ref Parser) { x.readdepth++; } Parser.up(x: self ref Parser) { x.readdepth--; } # mark is only defined after a next(), not after up() or down(). # this means that we don't have to record lots of state when going up or down levels. Parser.mark(x: self ref Parser): ref Mark { return ref Mark(x.estack, x.loc.line, int x.in.offset(), x.readdepth); } Parser.goto(x: self ref Parser, m: ref Mark) { x.in.seek(big m.offset, Sys->SEEKSTART); x.fileoffset = m.offset; x.eof = 0; x.estack = m.estack; x.loc.line = m.line; x.readdepth = m.readdepth; x.actdepth = len x.estack; } Mark.str(m: self ref Mark): string { # assume that neither the filename nor any of the tags contain spaces. # format: # offset readdepth linenum [tag...] # XXX would be nice if the produced string did not contain # any spaces so it could be treated as a word in other contexts. s := sys->sprint("%d %d %d", m.offset, m.readdepth, m.line); for (t := m.estack; t != nil; t = tl t) s += " " + hd t; return s; } Parser.str2mark(p: self ref Parser, s: string): ref Mark { (n, toks) := sys->tokenize(s, " "); if (n < 3) return nil; m := ref Mark(nil, p.loc.line, 0, 0); (m.offset, toks) = (int hd toks, tl toks); (m.readdepth, toks) = (int hd toks, tl toks); (m.line, toks) = (int hd toks, tl toks); m.estack = toks; return m; } getparcel(x: ref Parser): ref Parcel { { p: ref Parcel; while (!x.eof && p == nil) { c := getc(x); if (c == '<') p = element(x); else { ungetc(x); p = characters(x); } } if (p == nil) p = ref Parcel.EOF; return p; }exception e{ "sax:*" => return ref Parcel.Error(x.loc, x.errormsg); } } parcelstr(gi: ref Parcel): string { if (gi == nil) return "nil"; pick i := gi { Start => return sys->sprint("Start: %s", i.name); Empty => return sys->sprint("Empty: %s", i.name); End => return "End"; Text => return "Text"; Doctype => return sys->sprint("Doctype: %s", i.name); Stylesheet => return "Stylesheet"; Error => return "Error: " + i.msg; EOF => return "EOF"; * => return "Unknown"; } } element(x: ref Parser): ref Parcel { # <tag ...> elemname := xmlname(x); c: int; if (elemname != "") { attrs := buildattrs(x); skipwhite(x); c = getc(x); isend := 0; if (c == '/') isend = 1; else ungetc(x); expect(x, '>'); if (isend) return ref Parcel.Empty(elemname, attrs); else { startelement(x, elemname); return ref Parcel.Start(elemname, attrs); } # </tag> } else if ((c = getc(x)) == '/') { elemname = xmlname(x); if (elemname != "") { expect(x, '>'); endelement(x, elemname); return ref Parcel.End(elemname); } else error(x, sys->sprint("illegal beginning of tag: '%c'", c)); # <?tag ... ?> } else if (c == '?') { elemname = xmlname(x); if (elemname != "") { # this special case could be generalised if there were many # processing instructions that took attributes like this. if (elemname == "xml-stylesheet") { attrs := buildattrs(x); balancedstring(x, "?>"); return ref Parcel.Stylesheet(attrs); } else { data := balancedstring(x, "?>"); return ref Parcel.Process(elemname, data); } } } else if (c == '!') { c = getc(x); case c { '-' => # <!-- comment --> if(getc(x) == '-'){ balancedstring(x, "-->"); return nil; } '[' => # <![CDATA[...]] s := xmlname(x); if(s == "CDATA" && getc(x) == '['){ data := balancedstring(x, "]]>"); return ref Parcel.Text(data, 0, 0); } * => # <!declaration ungetc(x); s := xmlname(x); case s { "DOCTYPE" => # <!DOCTYPE name (SYSTEM "filename" | PUBLIC "pubid" "uri"?)? ("[" decls "]")?> skipwhite(x); name := xmlname(x); if(name == nil) break; id := ""; uri := ""; public := 0; skipwhite(x); case sort := xmlname(x) { "SYSTEM" => id = xmlstring(x, 1); "PUBLIC" => public = 1; id = xmlstring(x, 1); skipwhite(x); c = getc(x); ungetc(x); if(c == '"' || c == '\'') uri = xmlstring(x, 1); * => error(x, sys->sprint("unknown DOCTYPE: %s", sort)); return nil; } skipwhite(x); if(getc(x) == '['){ error(x, "cannot handle DOCTYPE with declarations"); return nil; } ungetc(x); skipwhite(x); if(getc(x) == '>') return ref Parcel.Doctype(name, public, id :: uri :: nil); "ELEMENT" or "ATTRLIST" or "NOTATION" or "ENTITY" => # don't interpret internal DTDs # <!ENTITY name ("value" | SYSTEM "filename")> s = gets(x, '>'); if(s == nil || s[len s-1] != '>') error(x, "end of file in declaration"); return nil; * => error(x, sys->sprint("unknown declaration: %s", s)); } } error(x, "invalid XML declaration"); } else error(x, sys->sprint("illegal beginning of tag: %c", c)); return nil; } characters(x: ref Parser): ref Parcel { p: ref Parcel; content := gets(x, '<'); if (len content > 0) { if (content[len content - 1] == '<') { ungetc(x); content = content[0:len content - 1]; } ws1, ws2: int; if (x.ispre) { content = substituteentities(x, content); ws1 = ws2 = 0; } else (content, ws1, ws2) = substituteentities_sp(x, content); if (content != nil || ws1) p = ref Parcel.Text(content, ws1, ws2); } return p; } startelement(x: ref Parser, name: string) { x.estack = name :: x.estack; if (name == x.preelem) x.ispre++; } endelement(x: ref Parser, name: string) { if (x.estack != nil && name == hd x.estack) { x.estack = tl x.estack; if (name == x.preelem) x.ispre--; } else { starttag := ""; if (x.estack != nil) starttag = hd x.estack; warning(x, sys->sprint("<%s></%s> mismatch", starttag, name)); # invalid XML but try to recover anyway to reduce turnaround time on fixing errors. # loop back up through the tag stack to see if there's a matching tag, in which case # jump up in the stack to that, making some rude assumptions about the # way Parcels are handled at the top level. n := 0; for (t := x.estack; t != nil; (t, n) = (tl t, n + 1)) if (hd t == name) break; if (t != nil) { x.estack = tl t; x.actdepth -= n; } } } buildattrs(x: ref Parser): Attributes { attrs: list of Attribute; attr: Attribute; for (;;) { skipwhite(x); attr.name = xmlname(x); if (attr.name == nil) break; skipwhite(x); c := getc(x); if(c != '='){ ungetc(x); attr.value = nil; }else attr.value = xmlstring(x, 1); attrs = attr :: attrs; } return Attributes(attrs); } xmlstring(x: ref Parser, dosub: int): string { skipwhite(x); s := ""; delim := getc(x); if (delim == '\"' || delim == '\'') { s = gets(x, delim); n := len s; if (n == 0 || s[n-1] != delim) error(x, "unclosed string at end of file"); s = s[0:n-1]; # TO DO: avoid copy if(dosub) s = substituteentities(x, s); } else error(x, sys->sprint("illegal string delimiter: %c", delim)); return s; } xmlname(x: ref Parser): string { name := ""; ch := getc(x); case ch { '_' or ':' or 'a' to 'z' or 'A' to 'Z' or 16r100 to 16rd7ff or 16re000 or 16rfffd => name[0] = ch; loop: for (;;) { case ch = getc(x) { '_' or '-' or ':' or '.' or 'a' to 'z' or '0' to '9' or 'A' to 'Z' or 16r100 to 16rd7ff or 16re000 to 16rfffd => name[len name] = ch; * => break loop; } } } ungetc(x); return name; } substituteentities(x: ref Parser, buff: string): string { i := 0; while (i < len buff) { if (buff[i] == '&') { (t, j) := translateentity(x, buff, i); # XXX could be quicker buff = buff[0:i] + t + buff[j:]; i += len t; } else i++; } return buff; } # subsitute entities, squashing whitespace along the way. substituteentities_sp(x: ref Parser, buf: string): (string, int, int) { firstwhite := 0; # skip initial white space for (i := 0; i < len buf; i++) { c := buf[i]; if (c != ' ' && c != '\t' && c != '\n' && c != '\r') break; firstwhite = 1; } lastwhite := 0; s := ""; for (; i < len buf; i++) { c := buf[i]; if (c == ' ' || c == '\t' || c == '\n' || c == '\r') lastwhite = 1; else { if (lastwhite) { s[len s] = ' '; lastwhite = 0; } if (c == '&') { # should &x20; count as whitespace? (ent, j) := translateentity(x, buf, i); i = j - 1; s += ent; } else s[len s] = c; } } return (s, firstwhite, lastwhite); } translateentity(x: ref Parser, s: string, i: int): (string, int) { i++; for (j := i; j < len s; j++) if (s[j] == ';') break; ent := s[i:j]; if (j == len s) { if (len ent > 10) ent = ent[0:11] + "..."; warning(x, sys->sprint("missing ; at end of entity (&%s)", ent)); return (nil, i); } j++; if (ent == nil) { warning(x, "empty entity"); return ("", j); } if (ent[0] == '#') { n: int; rem := ent; if (len ent >= 3 && ent[1] == 'x') (n, rem) = str->toint(ent[2:], 16); else if (len ent >= 2) (n, rem) = str->toint(ent[1:], 10); if (rem != nil) { warning(x, sys->sprint("unrecognized entity (&%s)", ent)); return (nil, j); } ch: string = nil; ch[0] = n; return (ch, j); } hv := entdict.find(ent); if (hv == nil) { warning(x, sys->sprint("unrecognized entity (&%s)", ent)); return (nil, j); } return (hv.s, j); } balancedstring(x: ref Parser, eos: string): string { s := ""; instring := 0; quote: int; for (i := 0; i < len eos; i++) s[len s] = ' '; skipwhite(x); while ((c := getc(x)) != Bufio->EOF) { s[len s] = c; if (instring) { if (c == quote) instring = 0; } else if (c == '\"' || c == '\'') { quote = c; instring = 1; } else if (s[len s - len eos : len s] == eos) return s[len eos : len s - len eos]; } error(x, sys->sprint("unexpected end of file while looking for \"%s\"", eos)); return ""; } skipwhite(x: ref Parser) { while ((c := getc(x)) == ' ' || c == '\t' || c == '\n' || c == '\r') ; ungetc(x); } expectwhite(x: ref Parser) { if ((c := getc(x)) != ' ' && c != '\t' && c != '\n' && c != '\r') error(x, "expecting white space"); skipwhite(x); } expect(x: ref Parser, ch: int) { skipwhite(x); c := getc(x); if (c != ch) error(x, sys->sprint("expecting %c", ch)); } getc(x: ref Parser): int { if (x.eof) return Bufio->EOF; ch := x.in.getc(); if (ch == Bufio->EOF) x.eof = 1; else if (ch == '\n') x.loc.line++; x.lastnl = ch == '\n'; return ch; } gets(x: ref Parser, delim: int): string { if (x.eof) return ""; s := x.in.gets(delim); for (i := 0; i < len s; i++) if (s[i] == '\n') x.loc.line++; if (s == "") x.eof = 1; else x.lastnl = s[len s - 1] == '\n'; return s; } ungetc(x: ref Parser) { if (x.eof) return; x.in.ungetc(); x.loc.line -= x.lastnl; } Attributes.all(al: self Attributes): list of Attribute { return al.attrs; } Attributes.get(attrs: self Attributes, name: string): string { for (a := attrs.attrs; a != nil; a = tl a) if ((hd a).name == name) return (hd a).value; return nil; } warning(x: ref Parser, msg: string) { if (x.warning != nil) x.warning <-= (x.loc, msg); } error(x: ref Parser, msg: string) { x.errormsg = msg; raise "sax:error"; }