gered/blarg
Archived
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

fix up some path handling/fixing

Browse source
This commit is contained in:
Gered 2013-05-22 22:33:48 -04:00
parent 514593101b
commit e8e12e08e9
3 changed files with 31 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
src/blarg/models/files.clj
View file

@ -6,9 +6,10 @@
[clojure.java.io :as io]))
(defn get-file [file]
(couch/with-db files
(let [f (ensure-prefix file "/")]
(couch/with-db files
(if-let [file-info (->first-view-value
(couch/get-view "files" "listPublished" {:key file}))]
(couch/get-view "files" "listPublished" {:key f}))]
(let [id (:_id file-info)
attachment (:filename file-info)
attachment-info (second (first (:_attachments file-info)))
@ -16,12 +17,13 @@
(if gz
(merge
{:data gz}
attachment-info))))))
attachment-info)))))))
(defn list-files [path]
(if-let [file-list (->view-values
(let [p (ensure-prefix-suffix path "/")]
(if-let [file-list (->view-values
(couch/with-db files
(couch/get-view "files" "listPublishedByPath" {:key path})))]
(couch/get-view "files" "listPublishedByPath" {:key p})))]
(map
(fn [f]
(let [attachment (second (first (:_attachments f)))]
@ -30,7 +32,7 @@
:last_modified (parse-timestamp (:last_modified_at f))
:content-type (:content_type attachment)
:size (:length attachment)}))
file-list)))
file-list))))
(defn get-tree []
(->view-keys
@ -38,12 +40,12 @@
(couch/get-view "files" "listPaths" {:group true}))))
(defn add-file [path filename file content-type]
(let [proper-path (ensure-prefix path "/")
id (str proper-path filename)]
(let [p (ensure-prefix-suffix path "/")
id (str p filename)]
(if-let [doc (couch/with-db files
(couch/put-document {:_id id
:filename filename
:path proper-path
:path p
:last_modified_at (get-timestamp)
:published true}))]
(couch/with-db files

24
src/blarg/routes/files.clj
View file

@ -8,21 +8,21 @@
[noir.response :as resp]))
(defn list-files [path]
(layout/render
"files/list.html" {:html-title (->html-title [(str "Files in " path)])
:path path
:files (files/list-files path)
:tree (files/get-tree)}))
(let [p (ensure-prefix-suffix path "/")]
(layout/render
"files/list.html" {:html-title (->html-title [(str "Files in " p)])
:path p
:files (files/list-files p)
:tree (files/get-tree)})))
(defn handle-new-file [path file]
(println "path: " path ", file: " file)
(if-let [newfile (files/add-file
(ensure-prefix path "/")
(let [p (ensure-prefix-suffix path "/")]
(if-let [newfile (files/add-file p
(:filename file)
(:tempfile file)
(:content-type file))]
(resp/redirect (str "/listfiles" (ensure-prefix path "/")))
(throw (Exception. "Error uploading file"))))
(resp/redirect (str "/listfiles" p))
(throw (Exception. "Error uploading file")))))
(defn get-file [path]
(if-let [file (files/get-file path)]
@ -31,6 +31,6 @@
(defroutes files-routes
(restricted GET "/listfiles" [] (list-files "/"))
(restricted GET "/listfiles/*" [*] (list-files (ensure-prefix * "/")))
(restricted GET "/listfiles/*" [*] (list-files *))
(restricted POST "/uploadfile" [path file] (handle-new-file path file))
(GET "/files/*" [*] (get-file (ensure-prefix * "/"))))
(GET "/files/*" [*] (get-file *)))

8
src/blarg/util.clj
View file

@ -51,3 +51,11 @@
(if-not (.startsWith s prefix)
(str prefix s)
s))
(defn ensure-suffix [s suffix]
(if-not (.endsWith s suffix)
(str s suffix)
s))
(defn ensure-prefix-suffix [s affix]
(ensure-prefix (ensure-suffix s affix) affix))