diff --git a/project.clj b/project.clj index 3036751..35ef23d 100644 --- a/project.clj +++ b/project.clj @@ -1,4 +1,4 @@ -(defproject de.mpg.shh/util-webdav "0.0.3" +(defproject de.mpg.shh/util-webdav "0.0.4" :description "LIMS for ssh" :url "http://www.shh.mpg.de/" :license {:name "Eclipse Public License" diff --git a/src/main/clojure/de/mpg/shh/util_webdav/client.clj b/src/main/clojure/de/mpg/shh/util_webdav/client.clj index 408b071..2c92815 100644 --- a/src/main/clojure/de/mpg/shh/util_webdav/client.clj +++ b/src/main/clojure/de/mpg/shh/util_webdav/client.clj @@ -59,14 +59,28 @@ (sort-by sort-on-kv-num) (map second)))) +(defn relative-path + [base-url path] + (loop [base-url-split (reverse (str/split base-url #"/")) + path-split (str/split path #"/")] + (cond + (empty? path-split) + "" + (str/blank? (first path-split)) + (recur base-url-split (rest path-split)) + (= (first path-split) (first base-url-split)) + (recur (rest base-url-split) (rest path-split)) + :else (str/join "/" path-split)))) + (defn- extract-dav-resource - [dav-resource] + [base-url dav-resource] ;;(info "extract-dav-resource .getCustomProps: " (pr-str (.getCustomProps dav-resource))) ;;(info "extract-dav-resource .getCustomPropsNS: " (pr-str (.getCustomPropsNS dav-resource))) (let [gathered-props (reduce extract-properties {:custom [] :props {}} (.getCustomPropsNS dav-resource)) custom-props (gather-custom-props (:custom gathered-props))] {:file-name (.getName dav-resource) :path (.getPath dav-resource) + :relative-path (relative-path base-url (.getPath dav-resource)) :dir? (.isDirectory dav-resource) :content-type (.getContentType dav-resource) :content-length (.getContentLength dav-resource) @@ -96,7 +110,7 @@ file-path] (let [url (str/join "/" [base-url file-path])] (try - (map extract-dav-resource (-> sardine (.list url 1))) + (map (partial extract-dav-resource base-url) (-> sardine (.list url 1))) (catch SardineException se (throw (ex-info "Failed to list file" {:cause (.getMessage se)})))))) @@ -106,7 +120,7 @@ file-path] (let [url (str/join "/" [base-url file-path])] (try - (first (map extract-dav-resource (-> sardine (.list url 0)))) + (first (map (partial extract-dav-resource base-url) (-> sardine (.list url 0)))) (catch SardineException se (throw (ex-info "Failed to list file" {:cause (.getMessage se)})))))) @@ -186,7 +200,7 @@ (let [url (str/join "/" [base-url file-path]) sardine-props (reduce prop->sardine [] props)] (try - (map extract-dav-resource (-> sardine (.patchTx url sardine-props (Collections/emptyList) if-header))) + (map (partial extract-dav-resource base-url) (-> sardine (.patchTx url sardine-props (Collections/emptyList) if-header))) (catch SardineException se (throw (ex-info "Failed to add props" {:cause (.getMessage se)}))))))) diff --git a/src/test/clojure/util_webdav/client_test.clj b/src/test/clojure/util_webdav/client_test.clj index 9f11583..f8c0cd8 100644 --- a/src/test/clojure/util_webdav/client_test.clj +++ b/src/test/clojure/util_webdav/client_test.clj @@ -108,18 +108,21 @@ _ (client/delete-dir conn "bar") expected [{:file-name (str/replace dav-prefix #"/$" "") :path (str "/" dav-prefix) + :relative-path "" :dir? true :content-type "httpd/unix-directory" :content-length -1 :properties {}} {:file-name "bar" :path (str "/" dav-prefix "bar/") + :relative-path "bar" :dir? true :content-type "httpd/unix-directory" :content-length -1 :properties {}} {:file-name "foo.txt" :path (str "/" dav-prefix "foo.txt") + :relative-path "foo.txt" :dir? false :content-type "text/plain" :content-length 12 @@ -139,6 +142,7 @@ _ (client/delete-file conn file-name) expected {:file-name "foo.txt" :path (str "/" dav-prefix "foo.txt") + :relative-path "foo.txt" :dir? false :content-type "text/plain" :content-length 12 @@ -173,6 +177,7 @@ _ (client/delete-file conn "foo.txt") expected {:file-name "foo.txt" :path (str "/" dav-prefix "foo.txt") + :relative-path "foo.txt" :dir? false :content-type "text/plain" :content-length 12 @@ -206,6 +211,7 @@ _ (client/delete-file conn "foo.txt") expected {:file-name "foo.txt" :path (str "/" dav-prefix "foo.txt") + :relative-path "foo.txt" :dir? false :content-type "text/plain" :content-length 12