[r2004-07-06 14:16:32 by afrisch] Add string:// scheme

Original author: afrisch
Date: 2004-07-06 14:16:32+00:00

parser/url.ml

 type url = Filename of string | Url of string
 
+let start_with s p =
+  let l = String.length p in
+  let n = String.length s in
+  if (n >= l) && (String.sub s 0 l = p)
+  then Some (String.sub s l (n - l))
+  else None
+
 let is_url s = 
   try let _ = Neturl.extract_url_scheme s in true
   with Neturl.Malformed_URL -> false
@@ -14,5 +21,9 @@ let no_load_url s =
 let load_url = ref no_load_url
 
 let process s =
-  if is_url s then Url (!load_url s)
-  else Filename s
+  match start_with s "string://" with
+    | None -> 
+	if is_url s then Url (!load_url s)
+	else Filename s
+    | Some s ->
+	Url s

parser/url.mli

 type url = Filename of string | Url of string
 
-(* Returns whether a string  is a valid url. *)
-
-val is_url: string -> bool
-
-
 (* It recognizes if it is a valid url. If it is connect and bufferize 
  * in a string otherwise consider it as filename 
  *)

runtime/load_xml.ml

@@ -96,7 +96,7 @@ let load_xml s =
     !xml_parser s;
     match !stack with
       | Element (x,Empty) -> stack := Empty; x
-      | _ -> assert false
+      | _ -> Value.failwith' "No XML stream to parse"
   with e -> stack := Empty; txt.pos <-0; raise e
 
       

runtime/value.ml

@@ -64,6 +64,9 @@ let concat v1 v2 =
     | (Atom _, v) | (v, Atom _) -> v
     | (v1,v2) -> Concat (v1,v2)
 
+let failwith' s = raise (CDuceExn (string_latin1 s))
+let raise' v = raise (CDuceExn v)
+
 
 let rec const = function
   | Types.Integer i -> Integer i
@@ -183,7 +186,7 @@ let rec add_buf_utf8_to_latin1 src i j =
   if Utf8.equal_index i j  then ()
   else
     let (c,i) = Utf8.next src i in
-    if (c > 255) then failwith "get_string_latin1";
+    if (c > 255) then failwith' "get_string_latin1";
     Buffer.add_char buf (Char.chr c);
     add_buf_utf8_to_latin1 src i j
 
@@ -199,6 +202,7 @@ let get_string_latin1 e =
     | String_utf8 (i,j,src,y) -> add_buf_utf8_to_latin1 src i j; aux y
     | Concat (_,_) as v -> eval_lazy_concat v; aux v
     | _ -> () in
+  Buffer.clear buf;
   aux e;
   let s = Buffer.contents buf in
   Buffer.clear buf;
@@ -523,8 +527,6 @@ let rec flatten = function
 
 *)
 
-let failwith' s = raise (CDuceExn (string_latin1 s))
-let raise' v = raise (CDuceExn v)
 
 let () = dump_forward := dump_xml