simple expat based xml parser

The other day I needed a small xml parser to convert an xml document into a different format. First I tried xml-light. This is a simple parser all written in ocaml that stores the parser xml document in an ocaml data structure. This data structure can be user to access various fields of the xml document. It does not offer a dom-like interface, but actually I consider this a feature. Unfortunately xml-light is terribly slow. To parse 30K-plus lines of xml it takes far too long to be considered for my application.

The next logic choice was to try Expat, that is a event-based parser and it is extremely fast. Since using an event based parser can be a bit cumbersome (and I already had written of bit of code using xml-light), I decided to write a small wrapper around expat to provide a xml-light interface to it.

The code is pretty simple and the main idea is taken from the cduce xml loader.

First we provide a small data structure to hold the xml document as we examine it. Nothing deep here. Notice that we use Start and String as we descend the tree and Element we we unwind the stack.

type stack =
  | Element of (Xml.xml * stack)
  | Start of (string * (string * string) list * stack)
  | String of (string * t * stack)
  | Empty
and t =
  | PCData
  | CData

Then we need to provide expat handlers to store xml fragments on the stack as we go down. Note that we have an handler for cdata, but not an handler for pcdata as it is the default.

let pcdata buff = (Xml.PCData buff)
let cdata buff = (Xml.CData buff)

let rec create_elt acc = function
  | String (s,CData, st) -> create_elt (L.push (cdata s) acc) st
  | String (s,PCData, st) -> create_elt (L.push (pcdata s) acc) st
  | Element (x,st) -> create_elt (L.push x acc) st
  | Start (tag,attrlst,st) -> stack := Element(Xml.Element(tag,attrlst,acc),st)
  | Empty -> assert false

let start_cdata_handler () = txt.cdata <- true ;;

let start_element_handler tag attrlst =
  if not (only_ws txt.buffer txt.pos) then begin
    let str = String.sub txt.buffer 0 txt.pos in
    if txt.cdata then
      stack := String (str, CData, !stack)
    else
      stack := String (str, PCData, !stack)
  end
  ;
  txt.pos <- 0;
  txt.cdata <- false;
  stack := Start (tag,attrlst,!stack)
;;

let end_element_handler _ =
  let acc =
    if only_ws txt.buffer txt.pos then L.empty
    else
      let str = String.sub txt.buffer 0 txt.pos in
      if txt.cdata then L.one (cdata str)
      else L.one (pcdata str)
  in
  txt.pos <- 0;
  txt.cdata <- false;
  create_elt acc !stack
;;

let character_data_handler = add_string txt ;;

At the end we just register all handlers with the expat parser and we return the root of the xml document.

let parse_string str =
  let p = Expat.parser_create None in
  Expat.set_start_element_handler p start_element_handler ;
  Expat.set_end_element_handler p end_element_handler ;
  Expat.set_start_cdata_handler p start_cdata_handler ;
  Expat.set_character_data_handler p character_data_handler ;
  ignore (Expat.set_param_entity_parsing p Expat.ALWAYS);
  Expat.parse p str;
  Expat.final p;
  match !stack with
  |Element (x,Empty) -> (stack := Empty; x)
  | _ -> assert false

I’ve copied the xml-light methods and to access the document in a different file. I’ve also made everything lazy to save a bit of computing time if it is only necessary to access a part of a huge xml document.

The complete code can be found here: git clone https://www.mancoosi.org/~abate/repos/xmlparser.git

UPDATE

The other that I was made aware that this parser has a serious bug when used on a 32 bit machine. The problem is that the maximal string size on a 32bit machine is equal to Sys.max_string_length that is roughly 16Mb . If we read and parse a bit document document at once with IO.read_all , we immediately get an exception. The solution is to parse the document incrementally using the new function parser_ch below that get a channel instead of a string and run the expat parser incrementally :

let parser_aux f =
  let p = Expat.parser_create None in
  Expat.set_start_element_handler p start_element_handler ;
  Expat.set_end_element_handler p end_element_handler ;

  Expat.set_start_cdata_handler p start_cdata_handler ;

  Expat.set_character_data_handler p character_data_handler ;
  ignore (Expat.set_param_entity_parsing p Expat.ALWAYS);
  f p;
  match !stack with
  |Element (x,Empty) -> (stack := Empty; x)
  | _ -> assert false

let parse_str str =
  let f p =
    Expat.parse p str;
    Expat.final p;
  in
  parser_aux f

let parse_ch ch =
  let f p =
    try while true do
      Expat.parse p (IO.nread ch 10240)
    done with IO.No_more_input -> Expat.final p ;
  in
  parser_aux f