add relative path for convenience

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"

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)})))))))
 

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