(* $Id: webdav_client.ml 9 2015-01-12 20:00:52Z gerd $ *)

open Webdav_client_methods
open Webdav_http
open Webdav_compat
open Printf


class type webdav_client_t = 
object
  method base_url : string
  method pipeline : Http_client.pipeline
  method propfind : ?depth:depth -> 
                    ?propfind_request:propfind_request -> 
                    ?fixup:(Http_client.http_call -> unit) ->
                    string -> propfind_call_t
  method list : ?depth:depth -> 
                ?fixup:(Http_client.http_call -> unit) ->
                list_request -> string -> list_t
  method proppatch : ?fixup:(Http_client.http_call -> unit) ->
                     proppatch_request:proppatch_request ->
                     string -> proppatch_call_t
  method mkcol : ?fixup:(Http_client.http_call -> unit) ->
                  string -> mkcol_call_t
  method delete : ?fixup:(Http_client.http_call -> unit) -> 
                  string -> delete_call_t
  method get : ?store:Http_client.response_body_storage -> 
               ?fixup:(Http_client.http_call -> unit) -> 
               string -> get_call_t
  method put : ?content_type:string ->
               ?content_length:int64 ->
               ?expect_handshake:bool ->
               ?fixup:(Http_client.http_call -> unit) -> 
               string -> Netmime.mime_body -> put_call_t
  method copy : ?depth:depth ->
                ?overwrite:bool ->
                ?dest_base_url:string ->
                ?fixup:(Http_client.http_call -> unit) -> 
                string -> string -> copy_call_t
  method move : ?overwrite:bool ->
                ?dest_base_url:string ->
                ?fixup:(Http_client.http_call -> unit) -> 
                string -> string -> move_call_t
end

let url_path url =
  Webdav_xml.url_path url


let length_of_body body =
  match body#store with
    | `Memory ->
	Int64.of_int (String.length body#value)

    | `File name ->
	let st = Unix.LargeFile.stat name in
	st.Unix.LargeFile.st_size


class webdav_client ?(pipeline =  new Http_client.pipeline) base_url
                     : webdav_client_t =
  let _ = Neturl.parse_url base_url in
  let execute call =
    pipeline # add call;
    pipeline # run()
  in
  let append ?(base_url=base_url) path =
    url_append base_url path in
  let strip_prefix =
    url_path base_url in
object(self)
  method base_url = base_url
  method pipeline = pipeline

  method propfind ?depth ?propfind_request ?(fixup=fun _->()) path =
    let url = append path in
    let call = new propfind ?depth ?propfind_request ~strip_prefix url in
    fixup (call :> Http_client.http_call);
    execute (call :> Http_client.http_call);
    call

  method list ?depth ?(fixup=fun _->()) lreq path =
    let url = append path in
    let call = new filelist ?depth ~strip_prefix lreq url in
    fixup (call :> Http_client.http_call);
    execute (call :> Http_client.http_call);
    call

  method proppatch ?(fixup=fun _->()) ~proppatch_request path =
    let url = append path in
    let call = new proppatch ~strip_prefix ~proppatch_request url in
    fixup (call :> Http_client.http_call);
    execute (call :> Http_client.http_call);
    call

  method mkcol ?(fixup=fun _->()) path =
    let url = append path in
    let call = new mkcol ~strip_prefix url in
    fixup (call :> Http_client.http_call);
    execute (call :> Http_client.http_call);
    call

  method delete ?(fixup=fun _->()) path =
    let url = append path in
    let call = new delete ~strip_prefix url in
    fixup (call :> Http_client.http_call);
    execute (call :> Http_client.http_call);
    call

  method get ?(store = `Memory) ?(fixup=fun _->()) path =
    let url = append path in
    let call = new get ~strip_prefix url in
    call # set_response_body_storage store;
    fixup (call :> Http_client.http_call);
    execute (call :> Http_client.http_call);
    call

  method put ?content_type ?content_length ?expect_handshake ?(fixup=fun _->())
             path body =
    let url = append path in
    let call = 
      new put ?content_type ?content_length ?expect_handshake ~strip_prefix 
              url body in
    fixup (call :> Http_client.http_call);
    execute (call :> Http_client.http_call);
    call

  method copy ?depth ?overwrite ?dest_base_url ?(fixup=fun _->())
              src_path dest_path =
    let src_url = append src_path in
    let dest_url = append ?base_url:dest_base_url dest_path in
    let call = new copy ?depth ?overwrite ~strip_prefix src_url dest_url in
    fixup (call :> Http_client.http_call);
    execute (call :> Http_client.http_call);
    call

  method move ?overwrite ?dest_base_url ?(fixup=fun _->())
              src_path dest_path =
    let src_url = append src_path in
    let dest_url = append ?base_url:dest_base_url dest_path in
    let call = new move ?overwrite ~strip_prefix src_url dest_url in
    fixup (call :> Http_client.http_call);
    execute (call :> Http_client.http_call);
    call
end


let webdav_client = new webdav_client