/[svn]/parser/url.ml
ViewVC logotype

Diff of /parser/url.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1028 by abate, Tue Jul 10 18:18:13 2007 UTC revision 1187 by abate, Tue Jul 10 18:29:32 2007 UTC
# Line 1  Line 1 
1  type url = Filename of string | Url of string  type url = Filename of string | Url of string
2    
 ifdef CURL then  
   let curl_support = true  
 else  
   let curl_support = false  
   
 ifdef NETCLIENT then  
   let netclient_support = true  
 else  
   let netclient_support = false  
   
3  let is_url s =  let is_url s =
4    try let _ = Neturl.extract_url_scheme s in true    try let _ = Neturl.extract_url_scheme s in true
5    with Neturl.Malformed_URL -> false    with Neturl.Malformed_URL -> false
6    
7  ifdef CURL then  let no_load_url s =
   let load_url s =  
     let buff = Buffer.create 4096 in  
     let conn = Curl.init () in  
     Curl.set_url conn s;  
     Curl.set_writefunction conn (Buffer.add_string buff);  
     Curl.perform conn;  
     Buffer.contents buff  
 else  
 ifdef NETCLIENT then  
   let load_url s =  
     match  Neturl.extract_url_scheme s with  
       | "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  
           in  
           raise (Location.Generic msg)  
 else  
   let load_url s =  
8      let msg =      let msg =
9          Printf.sprintf          Printf.sprintf
10            "Error \"%s\": \nTo fetch external URLs, you need to compile CDuce with curl and/or netclient" s            "Error \"%s\": \nTo fetch external URLs, you need to compile CDuce with curl and/or netclient" s
11      in      in
12      raise (Location.Generic msg)      raise (Location.Generic msg)
13    
14    let load_url = ref no_load_url
15    
16  let process s =  let process s =
17    if is_url s then Url (load_url s)    if is_url s then Url (!load_url s)
18    else Filename s    else Filename s
Legend:
Removed from v.1028  
changed lines
  Added in v.1187
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5