Commit 8aee8f64 authored by Pietro Abate's avatar Pietro Abate

[r2005-04-03 12:39:22 by afrisch] Empty log message

Original author: afrisch
Date: 2005-04-03 12:39:22+00:00
parent dec5fb42
open Ident
open Encodings
open Value
type stack =
| Element of Value.t * stack
| Start of Ns.table * Ns.qname * (Ns.qname * Utf8.t) list * Ns.table * stack
| String of string * stack
| Empty
type t = {
mutable stack : stack;
mutable ns_table : Ns.table;
mutable buffer : string;
mutable pos : int;
mutable length : int;
keep_ns: bool
}
let make keep_ns =
{ stack = Empty;
ns_table = Ns.empty_table;
buffer = String.create 1024;
pos = 0;
length = 1024;
keep_ns = keep_ns }
let get loader =
match loader.stack with
| Element (x,Empty) -> loader.stack <- Empty; x
| _ -> failwith' "No XML stream to parse"
let resize loader n =
let new_len = loader.length * 2 + n in
let new_buf = String.create new_len in
String.unsafe_blit loader.buffer 0 new_buf 0 loader.pos;
loader.buffer <- new_buf;
loader.length <- new_len
let text loader s =
let len = String.length s in
let new_pos = loader.pos + len in
if new_pos > loader.length then resize loader len;
String.unsafe_blit s 0 loader.buffer loader.pos len;
loader.pos <- new_pos
let rec only_ws s i =
(i = 0) ||
(let i = pred i in match (String.unsafe_get s i) with
| ' ' | '\t' | '\n' | '\r' -> only_ws s i
| _ -> false)
let string s q =
let s = Utf8.mk s in
String_utf8 (Utf8.start_index s,Utf8.end_index s, s, q)
let attrib att =
let att = List.map (fun (n,v) -> LabelPool.mk n, string_utf8 v) att in
LabelMap.from_list
(fun _ _ -> failwith "Invalid XML document: uniqueness of attributes") att
let elem keep_ns ns (tag_ns,tag) att child =
if keep_ns then
XmlNs (Atom (Atoms.V.mk tag_ns tag), Record (attrib att), child, ns)
else
Xml (Atom (Atoms.V.mk tag_ns tag), Record (attrib att), child)
let rec create_elt loader accu = function
| String (s,st) -> create_elt loader (string s accu) st
| Element (x,st) -> create_elt loader (Pair (x,accu)) st
| Start (ns,name,att,old_table,st) ->
loader.stack <- Element (elem loader.keep_ns ns name att accu, st);
loader.ns_table <- old_table
| Empty -> assert false
let start_elem loader name att =
if not (only_ws loader.buffer loader.pos) then
loader.stack <-
String (String.sub loader.buffer 0 loader.pos, loader.stack);
loader.pos <- 0;
let (table,name,att) = Ns.process_start_tag loader.ns_table name att in
loader.stack <- Start (table,name,att,loader.ns_table, loader.stack);
loader.ns_table <- table
let end_elem loader _ =
let accu =
if only_ws loader.buffer loader.pos
then nil
else string (String.sub loader.buffer 0 loader.pos) nil in
loader.pos <- 0;
create_elt loader accu loader.stack
type t
val make: bool -> t
val get: t -> Value.t
val start_elem: t -> string -> (string * string) list -> unit
val end_elem: t -> 'a -> unit
val text: t -> string -> unit
(* All the strings must be UTF-8 encoded *)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment