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 node_of_uri uri =
  try
    let source = match Url.process uri with 
      | Url.Filename s -> Pxp_types.from_file s 
      | Url.Url s -> Pxp_types.from_string s
    in
    node_of source
  with exn -> raise (Location.Generic (Pxp_types.string_of_exn exn))

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 _filter_elems p n =
  Pxp_document.find_all (fun n -> match n#node_type with
                           | Pxp_document.T_element s -> List.mem s p
                           | _ -> false) 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 _fold_elems n x f = 
  let x = ref x in
  n#iter_nodes
    (fun n ->
       match n#node_type with
         | Pxp_document.T_element s -> x := f !x n s
         | _ -> ()
    );
  !x
  
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 node_of_uri uri =
45	try
46	let source = match Url.process uri with
47	\| Url.Filename s -> Pxp_types.from_file s
48	\| Url.Url s -> Pxp_types.from_string s
49	in
50	node_of source
51	with exn -> raise (Location.Generic (Pxp_types.string_of_exn exn))
52
53	let _may_attr name n =
54	try
55	match n#attribute name with
56	\| Pxp_types.Value v -> Some (Utf8.mk v)
57	\| _ -> None
58	with Not_found -> None
59
60	let _is_attr name n v =
61	try
62	match n#attribute name with
63	\| Pxp_types.Value v' -> v = v'
64	\| _ -> false
65	with Not_found -> false
66
67	let _attr name n =
68	match n#attribute name with
69	\| Pxp_types.Value v -> Utf8.mk v
70	\| _ -> raise Not_found
71
72	let _may_elem e (n: node) =
73	try Some (Pxp_document.find_element e n) with Not_found -> None
74
75	let _elems e n = Pxp_document.find_all_elements e n
76
77	let _filter_elems p n =
78	Pxp_document.find_all (fun n -> match n#node_type with
79	\| Pxp_document.T_element s -> List.mem s p
80	\| _ -> false) n
81
82	let _line n = match n#position with (_,l,_) -> l
83
84	let _iter_nodes n f = n#iter_nodes f
85
86	let _iter_elems n f = n#iter_nodes
87	(fun n ->
88	match n#node_type with
89	\| Pxp_document.T_element s -> f n s
90	\| _ -> ()
91	)
92
93	let _fold_elems n x f =
94	let x = ref x in
95	n#iter_nodes
96	(fun n ->
97	match n#node_type with
98	\| Pxp_document.T_element s -> x := f !x n s
99	\| _ -> ()
100	);
101	!x
102
103	let _tag n =
104	match n#node_type with
105	\| Pxp_document.T_element s -> s
106	\| _ -> assert false
107
108	let _has_tag n f =
109	match n#node_type with
110	\| Pxp_document.T_element s -> f s
111	\| _ -> false
112
113	let _namespaces n =
114	List.map
115	(fun n ->
116	(match n#node_type with
117	Pxp_document.T_namespace p -> p \| _ -> assert false),
118	n#data
119	)
120	n#namespaces_as_nodes
121
122	let _find p n = Pxp_document.find p n