Commit b9b90984 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2005-02-17 12:10:01 by afrisch] Clean schema

Original author: afrisch
Date: 2005-02-17 12:10:01+00:00
parent f6ac979a
......@@ -12,7 +12,7 @@ open Schema_types
(** {2 Aux/Misc stuff} *)
let add_xsd_prefix s = Schema_xml.add_xsd_prefix (Utf8.mk s)
let add_xsd_prefix s = Utf8.mk ("xsd:"^s)
let unsupported =
List.map (fun s -> add_xsd_prefix s)
......
This diff is collapsed.
open Pxp_document
open Pxp_ev_parser
(*open Pxp_ev_parser
open Pxp_tree_parser
open Pxp_types
*)
open Encodings
open Schema_pcre
type pxp_node =
type node =
('a Pxp_document.node Pxp_document.extension as 'a) Pxp_document.node
type pxp_document =
('a Pxp_document.node Pxp_document.extension as 'a) Pxp_document.document
let xsd_RE = pcre_regexp "^xsd:"
module Node = struct
type t = node
let compare = Pxp_document.compare
end
let has_xsd_prefix s = Pcre.pmatch ~rex:xsd_RE (Utf8.get_str s)
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 add_xsd_prefix =
let prefix = Utf8.concat xsd_prefix (Utf8.mk ":") in
fun s -> Utf8.concat prefix s
let schema_ns_prefixes =
[ xsd_prefix, xsd_namespace; xsi_prefix, xsi_namespace ]
let spec = default_namespace_spec
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;
{ default_namespace_config with
{ Pxp_types.default_namespace_config with
Pxp_types.enable_namespace_processing = Some ns_manager
}
let pxp_node_of src =
parse_wfcontent_entity (new_xsd_config ()) src spec
open Printf
let string_of_pxp_event = function
| E_start_doc (version, dtd) -> "E_start_doc"
| E_end_doc _ -> "E_end_doc"
| E_start_tag (name, attlist, _, entity_id) -> sprintf "E_start_tag (%s)" name
| E_end_tag (name, entity_id) -> sprintf "E_end_tag (%s)" name
| E_char_data data ->
sprintf "E_char_data (%s)" (Pcre.replace ~pat:"\n" ~templ:"\\n" data)
| E_pinstr _ -> "E_pinstr"
| E_comment data -> "E_comment"
| E_position (entity, line, col) -> "E_position"
| E_error exn -> sprintf "E_error (%s)" (Pxp_types.string_of_exn exn)
| E_end_of_stream -> "E_end_of_stream"
| _ -> assert false
let rec dump_stream s =
print_endline (string_of_pxp_event (Stream.next s));
flush stdout;
dump_stream s
let dump_stream s = try dump_stream s with Stream.Failure -> ()
(* peek version that assume the stream isn't at the end *)
let peek s =
match Stream.peek s with
| Some v -> v
| None -> raise Stream.Failure
(* collect all E_char_data events from a PXP stream and return the
concatenation of their datas *)
let collect_pcdata s =
let buf = Buffer.create 1 in
let rec collect () =
match peek s with
| E_char_data d ->
Buffer.add_string buf d; Stream.junk s; collect ()
| _ -> Buffer.contents buf
in
collect ()
module Pxp_helpers =
struct
open Pxp_document
open Pxp_types
exception PxpHelpers of exn
let _raise e = raise (PxpHelpers e)
let space_RE = pcre_regexp " "
let _tag_name (n: pxp_node) =
match n#node_type with
| T_element tag -> Utf8.mk tag
| _ -> raise Not_found
let _has_attribute name (n: pxp_node) =
try
match n#attribute name with
| Value _ -> true
| _ -> false
with Not_found -> false
let _attribute name (n: pxp_node) =
match n#attribute name with
| Value v -> Utf8.mk v
| _ -> raise Not_found
let _has_element e (n: pxp_node) =
try ignore (find_element e n); true with Not_found -> false
let _element e (n: pxp_node): pxp_node = find_element e n
let _elements e (n: pxp_node): pxp_node list = find_all_elements e n
let _element' names (n: pxp_node): pxp_node =
let node = ref None in
(try
n#iter_nodes (fun n ->
(match n#node_type with
| T_element name when List.mem name names ->
node := Some n;
raise Exit
| _ -> ()))
with Exit -> ());
match !node with None -> raise Not_found | Some n -> n
let _elements' names (n: pxp_node): pxp_node list =
find_all (fun n ->
match n#node_type with
| T_element name when List.mem name names -> true
| _ -> false) n
let _has_element' names (n: pxp_node) =
try ignore (_element' names n); true with Not_found -> false
end
(** export Ns.t version of defined namespaces *)
let xsd_namespace = Ns.mk xsd_namespace
let xsi_namespace = Ns.mk xsi_namespace
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
open Encodings
type pxp_node =
('a Pxp_document.node Pxp_document.extension as 'a) Pxp_document.node
type pxp_document =
('a Pxp_document.node Pxp_document.extension as 'a) Pxp_document.document
module Node: Set.OrderedType
type node = Node.t
val node_of_file: string -> node
val node_of_string: string -> node
val _may_attr: string -> node -> Utf8.t option
val _is_attr: string -> node -> string -> bool
val _attr: string -> node -> Utf8.t
val _may_elem: string -> node -> node option
val _elems: string -> node -> node list
val _line: node -> int
val _iter_nodes: node -> (node -> unit) -> unit
val _iter_elems: node -> (node -> string -> unit) -> unit
val _tag: node -> string
val _has_tag: node -> (string -> bool) -> bool
val _namespaces: node -> (string * string) list
val _find: (node -> bool) -> node -> node
val pxp_node_of: Pxp_types.source -> pxp_node
module Pxp_helpers:
sig
exception PxpHelpers of exn
val _tag_name : pxp_node -> Utf8.t
val _has_attribute : string -> pxp_node -> bool
(* test if exists a child element which name is given *)
val _has_element : string -> pxp_node -> bool
(* test if exists a child element which name is one of the given *)
val _has_element': string list -> pxp_node -> bool
val _attribute : string -> pxp_node -> Utf8.t
(* find the first child element which have the given name *)
val _element : string -> pxp_node -> pxp_node
(* find the first child element which name is one of the given names *)
val _element': string list -> pxp_node -> pxp_node
(* find all child elements which have a given name *)
val _elements: string -> pxp_node -> pxp_node list
(* find all child elements which name is one of the given names *)
val _elements': string list -> pxp_node -> pxp_node list
end
(* namespace handling *)
open Encodings
val has_xsd_prefix : Utf8.t -> bool
val schema_ns_prefixes: (Utf8.t * Utf8.t) list
val xsd_namespace : Ns.t
val xsi_namespace : Ns.t
val xsd_prefix : Utf8.t
val xsi_prefix : Utf8.t
val add_xsd_prefix : Utf8.t -> Utf8.t
(* misc stuff *)
val string_of_pxp_event : Pxp_types.event -> string
val collect_pcdata : Pxp_types.event Stream.t -> string
(** @raise Stream.Failure at the end of the stream *)
val peek : Pxp_types.event Stream.t -> Pxp_types.event
(* debugging only *)
val dump_stream : Pxp_types.event Stream.t -> unit
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