- fun registry fname ->
- let xml_root =
- create_element_node ~valcheck:false PxpHelmConf.pxp_spec dtd
- "helm_registry" []
- in
- Hashtbl.iter
- (fun key value ->
- let sections, key =
- let hd, tl =
- match List.rev (Str.split dot_RE key) with
- | hd :: tl -> hd, tl
- | _ -> assert false
- in
- List.rev tl, hd
- in
- add_key_node xml_root sections key value)
- registry;
- let outfile = open_out fname in
- Unix.lockf (Unix.descr_of_out_channel outfile) Unix.F_LOCK 0; (* blocks *)
- if
- Unix.system "xmllint --version &> /dev/null" = Unix.WEXITED 0
- then begin
- let (xmllint_in, xmllint_out) =
- Unix.open_process "xmllint --format --encode utf8 -"
- in
- xml_root#write (`Out_channel xmllint_out) `Enc_utf8;
- close_out xmllint_out;
- try
- while true do
- output_string outfile (input_line xmllint_in ^ "\n")
- done
- with End_of_file ->
- close_in xmllint_in;
- ignore (Unix.close_process (xmllint_in, xmllint_out))
- end else
- xml_root#write (`Out_channel outfile) `Enc_utf8;
- Unix.lockf (Unix.descr_of_out_channel outfile) Unix.F_ULOCK 0;
- close_out outfile
-
-let load_from_absolute =
- let config = PxpHelmConf.pxp_config in
- let entry = `Entry_document [ `Extend_dtd_fully; `Parse_xml_decl ] in
- let fold_key key_stack key =
- match key_stack with
- | [] -> key
- | _ -> String.concat "." key_stack ^ "." ^ key
+ Hashtbl.fold
+ (fun k v tree -> add_key ((Str.split dot_RE k)) v tree)
+ registry
+ (Element (root_tag, [], []))
+
+let rec stream_of_xml_tree = function
+ | Cdata s -> Xml.xml_cdata s
+ | Element (name, attrs, children) ->
+ Xml.xml_nempty name
+ (List.map (fun (n, v) -> (None, n, v)) attrs)
+ (stream_of_xml_trees children)
+and stream_of_xml_trees = function
+ | [] -> [< >]
+ | hd :: tl -> [< stream_of_xml_tree hd; stream_of_xml_trees tl >]
+
+let save_to registry fname =
+ let token_stream = stream_of_xml_tree (xml_tree_of_registry registry) in
+ let oc = open_out fname in
+ Xml.pp_to_outchan token_stream oc;
+ close_out oc
+
+let rec load_from_absolute ?path registry fname =
+ let _path = ref (match path with None -> [] | Some p -> p)in
+ (* <section> elements entered so far *)
+ let in_key = ref false in (* have we entered a <key> element? *)
+ let cdata = ref "" in (* collected cdata (inside <key> *)
+ let push_path name = _path := name :: !_path in
+ let pop_path () = _path := List.tl !_path in
+ let start_element tag attrs =
+ match tag, attrs with
+ | "section", ["name", name] -> push_path name
+ | "key", ["name", name] -> in_key := true; push_path name
+ | "helm_registry", _ -> ()
+ | "include", ["href", fname] ->
+ debug_print (lazy ("including file " ^ fname));
+ load_from_absolute ~path:!_path registry fname
+ | tag, _ ->
+ raise (Parse_error (fname, ~-1, ~-1,
+ (sprintf "unexpected element <%s> or wrong attribute set" tag)))