viewcvs.cgi/schema/schema_xml.ml

(*open Pxp_ev_parser
open Pxp_tree_parser
*)

open Encodings
open Schema_pcre

type node =
  ('a Pxp_document.node Pxp_document.extension as 'a) Pxp_document.node

module Node = struct
  type t = node
  let compare = Pxp_document.compare
end

let start_with s pr =
  let s = Utf8.get_str s in
  (String.length s >= String.length pr) &&
    (String.sub s 0 (String.length pr) = pr)

let has_xsd_prefix s = start_with s "xsd:"

let xsd_namespace = Utf8.mk "http://www.w3.org/2001/XMLSchema"
let xsi_namespace = Utf8.mk "http://www.w3.org/2001/XMLSchema-instance"
let xsd_prefix = Utf8.mk "xsd"
let xsi_prefix = Utf8.mk "xsi"

let schema_ns_prefixes =
  [ xsd_prefix, xsd_namespace; xsi_prefix, xsi_namespace ]

let spec = Pxp_tree_parser.default_namespace_spec
let new_xsd_config () =
  let ns_manager = new Pxp_dtd.namespace_manager in
  List.iter
    (fun (p, ns) -> ns_manager#add_namespace (Utf8.get_str p) (Utf8.get_str ns))
    schema_ns_prefixes;
  { Pxp_types.default_namespace_config with
      Pxp_types.enable_namespace_processing = Some ns_manager
  }

let node_of src =
  Pxp_tree_parser.parse_wfcontent_entity (new_xsd_config ()) src spec

let wrap_err f x =
  try f x
  with exn -> raise (Location.Generic (Pxp_types.string_of_exn exn))

let node_of_file =
  wrap_err (fun fname -> node_of (Pxp_types.from_file fname))

let node_of_string =
  wrap_err (fun s -> node_of (Pxp_types.from_string s))


let _may_attr name n =
  try
    match n#attribute name with
      | Pxp_types.Value v -> Some (Utf8.mk v)
      | _ -> None
  with Not_found -> None
    
let _is_attr name n v =
  try
    match n#attribute name with
      | Pxp_types.Value v' -> v = v'
      | _ -> false
  with Not_found -> false
    
let _attr name n =
  match n#attribute name with
    | Pxp_types.Value v -> Utf8.mk v
    | _ -> raise Not_found
        
let _may_elem e (n: node) =
  try Some (Pxp_document.find_element e n) with Not_found -> None
    
let _elems e n = Pxp_document.find_all_elements e n
  
let _line n = match n#position with (_,l,_) -> l
  
let _iter_nodes n f = n#iter_nodes f
  
let _iter_elems n f = n#iter_nodes
  (fun n ->
     match n#node_type with
       | Pxp_document.T_element s -> f n s
       | _ -> ()
  )
  
let _tag n =
  match n#node_type with
    | Pxp_document.T_element s -> s
    | _ -> assert false
        
let _has_tag n f =
  match n#node_type with
    | Pxp_document.T_element s -> f s
    | _ -> false
        
let _namespaces n =
  List.map 
    (fun n ->
       (match n#node_type with 
            Pxp_document.T_namespace p -> p | _ -> assert false),
       n#data
    )
    n#namespaces_as_nodes
    
let _find p n = Pxp_document.find p n
1	(*open Pxp_ev_parser
2	open Pxp_tree_parser
3	*)
4
5	open Encodings
6	open Schema_pcre
7
8	type node =
9	('a Pxp_document.node Pxp_document.extension as 'a) Pxp_document.node
10
11	module Node = struct
12	type t = node
13	let compare = Pxp_document.compare
14	end
15
16	let start_with s pr =
17	let s = Utf8.get_str s in
18	(String.length s >= String.length pr) &&
19	(String.sub s 0 (String.length pr) = pr)
20
21	let has_xsd_prefix s = start_with s "xsd:"
22
23	let xsd_namespace = Utf8.mk "http://www.w3.org/2001/XMLSchema"
24	let xsi_namespace = Utf8.mk "http://www.w3.org/2001/XMLSchema-instance"
25	let xsd_prefix = Utf8.mk "xsd"
26	let xsi_prefix = Utf8.mk "xsi"
27
28	let schema_ns_prefixes =
29	[ xsd_prefix, xsd_namespace; xsi_prefix, xsi_namespace ]
30
31	let spec = Pxp_tree_parser.default_namespace_spec
32	let new_xsd_config () =
33	let ns_manager = new Pxp_dtd.namespace_manager in
34	List.iter
35	(fun (p, ns) -> ns_manager#add_namespace (Utf8.get_str p) (Utf8.get_str ns))
36	schema_ns_prefixes;
37	{ Pxp_types.default_namespace_config with
38	Pxp_types.enable_namespace_processing = Some ns_manager
39	}
40
41	let node_of src =
42	Pxp_tree_parser.parse_wfcontent_entity (new_xsd_config ()) src spec
43
44	let wrap_err f x =
45	try f x
46	with exn -> raise (Location.Generic (Pxp_types.string_of_exn exn))
47
48	let node_of_file =
49	wrap_err (fun fname -> node_of (Pxp_types.from_file fname))
50
51	let node_of_string =
52	wrap_err (fun s -> node_of (Pxp_types.from_string s))
53
54
55	let _may_attr name n =
56	try
57	match n#attribute name with
58	\| Pxp_types.Value v -> Some (Utf8.mk v)
59	\| _ -> None
60	with Not_found -> None
61
62	let _is_attr name n v =
63	try
64	match n#attribute name with
65	\| Pxp_types.Value v' -> v = v'
66	\| _ -> false
67	with Not_found -> false
68
69	let _attr name n =
70	match n#attribute name with
71	\| Pxp_types.Value v -> Utf8.mk v
72	\| _ -> raise Not_found
73
74	let _may_elem e (n: node) =
75	try Some (Pxp_document.find_element e n) with Not_found -> None
76
77	let _elems e n = Pxp_document.find_all_elements e n
78
79	let _line n = match n#position with (_,l,_) -> l
80
81	let _iter_nodes n f = n#iter_nodes f
82
83	let _iter_elems n f = n#iter_nodes
84	(fun n ->
85	match n#node_type with
86	\| Pxp_document.T_element s -> f n s
87	\| _ -> ()
88	)
89
90	let _tag n =
91	match n#node_type with
92	\| Pxp_document.T_element s -> s
93	\| _ -> assert false
94
95	let _has_tag n f =
96	match n#node_type with
97	\| Pxp_document.T_element s -> f s
98	\| _ -> false
99
100	let _namespaces n =
101	List.map
102	(fun n ->
103	(match n#node_type with
104	Pxp_document.T_namespace p -> p \| _ -> assert false),
105	n#data
106	)
107	n#namespaces_as_nodes
108
109	let _find p n = Pxp_document.find p n