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

[r2005-03-07 22:32:09 by afrisch] Better treatment of external entities with PXP

Original author: afrisch
Date: 2005-03-07 22:32:09+00:00
parent 53d4aec3
......@@ -40,7 +40,7 @@ let local s1 s2 =
)
| _, (String _ | Uri _) | (String _, File _) ->
s2
| Uri _, File _ ->
| Uri _, File _ ->
let url1 = Neturl.parse_url s1 in
let url2 =
Neturl.parse_url
......@@ -53,3 +53,17 @@ let process s =
| File s -> Location.protect_op "loading file"; Filename s
| Uri s -> Location.protect_op "fetching external URI"; Url (!load_url s)
| String s -> Url s
let load_file s =
let ic = open_in s in
let b = Buffer.create 10240 in
let buf = String.create 1024 in
let rec loop () =
let n = input ic buf 0 1024 in
if (n > 0) then (Buffer.add_substring b buf 0 n; loop ())
in
loop ();
close_in ic;
Buffer.contents b
......@@ -6,3 +6,4 @@ val local: string -> string -> string
val load_url: (string -> string) ref
val load_file: string -> string
......@@ -2,6 +2,7 @@ open Pxp_yacc
open Pxp_lexer_types
open Pxp_types
open Pxp_ev_parser
open Pxp_reader
let pxp_handle_event = function
| E_start_tag (name,att,_,_) -> Load_xml.start_element_handler name att
......@@ -18,28 +19,24 @@ let pxp_config =
}
let channel_of_id rt rid =
match rid.rid_system with
| Some local ->
let s = Url.local rt local in
let ch =
match Url.process s with
| Url.Url s -> new Netchannels.input_string s
| Url.Filename s -> raise Not_competent
in
let get_uri uri =
match Url.process uri with
| Url.Filename s -> Url.load_file s
| Url.Url s -> s
let channel_of_id rid =
match rid.rid_system_base, rid.rid_system with
| Some base, Some local ->
let uri = Url.local base local in
let ch = new Netchannels.input_string (get_uri uri) in
ch, None, None
| None -> raise Not_competent
let load_pxp rt =
| _ -> raise Not_competent
let alt = [ new resolve_to_any_obj_channel ~channel_of_id () ]
let load_pxp uri =
try
let src =
match Url.process rt with
| Url.Url s ->
let channel_of_id = channel_of_id rt in
let r =
new Pxp_reader.resolve_to_any_obj_channel ~channel_of_id () in
from_string ~alt:[r] s
| Url.Filename s -> from_file s in
let src = from_string ~alt ~system_id:uri (get_uri uri) in
let mgr = create_entity_manager pxp_config src in
process_entity pxp_config
(`Entry_document[`Extend_dtd_fully]) mgr pxp_handle_event;
......
......@@ -42,29 +42,25 @@ let node_of src =
(Pxp_tree_parser.parse_wfdocument_entity (new_xsd_config ()) src spec) # root
open Pxp_types
let channel_of_id rt rid =
match rid.rid_system with
| Some local ->
let s = Url.local rt local in
let ch =
match Url.process s with
| Url.Url s -> new Netchannels.input_string s
| Url.Filename s -> raise Not_competent
in
open Pxp_reader
let get_uri uri =
match Url.process uri with
| Url.Filename s -> Url.load_file s
| Url.Url s -> s
let channel_of_id rid =
match rid.rid_system_base, rid.rid_system with
| Some base, Some local ->
let uri = Url.local base local in
let ch = new Netchannels.input_string (get_uri uri) in
ch, None, None
| None -> raise Not_competent
| _ -> raise Not_competent
let alt = [ new resolve_to_any_obj_channel ~channel_of_id () ]
let node_of_uri uri =
try
let source = match Url.process uri with
| Url.Filename s -> Pxp_types.from_file s
| Url.Url s ->
let channel_of_id = channel_of_id uri in
let r =
new Pxp_reader.resolve_to_any_obj_channel ~channel_of_id () in
from_string ~alt:[r] s
in
node_of source
try node_of (from_string ~alt ~system_id:uri (get_uri uri))
with exn -> raise (Location.Generic (Pxp_types.string_of_exn exn))
let _may_attr name n =
......
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