[r2004-03-09 22:59:09 by afrisch] meilleure gestion netclient

Original author: afrisch
Date: 2004-03-09 22:59:09+00:00

driver/run.ml

@@ -23,7 +23,8 @@ let version () =
   Printf.eprintf "using OCaml %s compiler\n" <:symbol<ocaml_compiler>>;
   Printf.eprintf "support for ocaml interfacing: %b\n" ocaml_support;
   Printf.eprintf "support for expat: %b\n" (Load_xml.expat_support);
-  Printf.eprintf "support for curl: %b\n" (Load_xml.curl_support);
+  Printf.eprintf "support for curl: %b\n" (Url.curl_support);
+  Printf.eprintf "support for netclient: %b\n" (Url.netclient_support);
   exit 0
 
 let license () =

parser/url.ml

 type url = Filename of string | Url of string
 
+ifdef CURL then
+  let curl_support = true
+else
+  let curl_support = false
+
+ifdef NETCLIENT then
+  let netclient_support = true
+else
+  let netclien_support = false
 
 let is_url s = 
   try let _ = Neturl.extract_url_scheme s in true
@@ -17,12 +26,26 @@ else
 ifdef NETCLIENT then
   let load_url s =
     match  Neturl.extract_url_scheme s with
-      | "http" -> Http_client.Convenience.http_get s
-      | "file" ->
-  	  let msg = 
-	    Printf.sprintf "FIXME: write in url.ml the code so that netclient handle file:// protocol" 
-	  in
+      | "http" -> 
+	  (try Http_client.Convenience.http_get s
+	   with 
+	     | Http_client.Bad_message s ->
+		 let msg = Printf.sprintf "Netclient. Bad http answer: %s" s in
+		 raise (Location.Generic msg)
+	     | Http_client.Http_error (n,s) ->
+		 let msg = Printf.sprintf "Netclient. Http error %i: %s" n s in
 		 raise (Location.Generic msg)
+	     | Http_client.No_reply ->
+		 raise (Location.Generic "Netclient. No reply")
+	     | Http_client.Http_protocol exn ->
+		 let msg = Printf.sprintf "Netclient. %s" 
+			     (Printexc.to_string exn) in
+		 raise (Location.Generic msg)
+	  )
+      | "file" ->
+	  raise (Location.Generic 
+		   "FIXME: write in url.ml the code so that netclient \
+                    handle file:// protocol")
       | sc -> 
 	  let msg = 
 	    Printf.sprintf "Error: netclient does not handle the %s protocol" sc

parser/url.mli

 type url = Filename of string | Url of string
 
+val curl_support : bool
+val netclient_support : bool
 
 (* Returns whether a string  is a valid url. *)
 

runtime/load_xml.ml

@@ -5,11 +5,6 @@ ifdef EXPAT then
 else
   let expat_support = false
 
-ifdef CURL then
-  let curl_support = true
-else
-  let curl_support = false
-
 let use_parser = ref (if expat_support then `Expat else `Pxp)
 
 open Pxp_yacc
@@ -213,7 +208,12 @@ let load_html s =
       | Url.Url s ->
           parse (Lexing.from_string s) 
   in
-  val_of_docs (Nethtml.decode ~enc:`Enc_utf8 ~subst:(fun _ -> "???") doc)
+  let doc = Nethtml.decode ~subst:(fun _ -> "???") doc in
+  let doc = Nethtml.map_list 
+	      (Netconversion.convert ~in_enc:`Enc_iso88591
+		 ~out_enc:`Enc_utf8) doc in
+  val_of_docs doc
+
   
 
 

runtime/load_xml.mli

 val use_parser: [ `Expat | `Pxp ] ref
 val expat_support : bool
-val curl_support : bool
 
 val load_xml: string -> Value.t
 

runtime/print_xml.ml

@@ -145,7 +145,7 @@ let print_xml ~utf8 ns_table s =
   try   
     let s = string_of_xml ~utf8 ns_table s in
     if utf8 then string_utf8 (U.mk s) else string_latin1 s
-  with exn ->
-    raise
-      (Location.Generic (Pxp_types.string_of_exn exn))
+  with 
+      CDuceExn _ as exn -> raise exn
+    | exn -> raise (Location.Generic (Pxp_types.string_of_exn exn))
  

types/builtin.ml

@@ -170,7 +170,7 @@ unary_op_cst "load_xml"
   (fun v -> Load_xml.load_xml (Value.get_string_latin1 v));;
   
 unary_op_cst "load_html" 
-  string any
+  string Sequence.any
   (fun v -> Load_xml.load_html  (Value.get_string_latin1 v));;
 
 unary_op_cst "load_file_utf8"