Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Various updates to the Clojure codes

  • Loading branch information...
commit a37cb167eaf16ef5e2b42e88092e51c44f2d348f 1 parent 85630fa
@mmcgrana authored
Showing with 179 additions and 151 deletions.
  1. +1 −2  clj-http-client/TODO
  2. +1 −1  clj-scrape/test/files/uswebgen.html
  3. +2 −5 stash/TODO
  4. +1 −1  stash/src/stash/core.clj
  5. +23 −7 stash/src/stash/core_crud.clj
  6. +7 −9 stash/src/stash/core_def.clj
  7. +12 −0 stash/src/stash/core_finders.clj
  8. +0 −17 stash/src/stash/core_sugar.clj
  9. +6 −4 stash/src/stash/utils.clj
  10. +2 −2 stash/test/stash/core_callbacks_test.clj
  11. +17 −5 stash/test/stash/core_crud_test.clj
  12. +2 −2 stash/test/stash/core_def_test.clj
  13. +17 −0 stash/test/stash/core_finders_test.clj
  14. +0 −21 stash/test/stash/core_sugar_test.clj
  15. +1 −3 stash/test/stash/core_test.clj
  16. +6 −6 stash/test/stash/utils_test.clj
  17. +3 −7 weld-blog-example/TODO
  18. +4 −4 weld-blog-example/src/weldblog/config.clj
  19. +20 −3 weld-blog-example/src/weldblog/controllers.clj
  20. +1 −1  weld-blog-example/src/weldblog/models.clj
  21. +16 −17 weld-blog-example/src/weldblog/routing.clj
  22. +7 −9 weld-blog-example/src/weldblog/views.clj
  23. +2 −0  weld-snippets-example/README
  24. +3 −8 weld-snippets-example/src/weldsnip/app.clj
  25. +2 −0  weld-snippets-example/src/weldsnip/custom_config.clj
  26. +6 −1 weld-upload-example/TODO
  27. +1 −1  weld-upload-example/script/server.clj
  28. +16 −15 weld-upload-example/src/weldup/app.clj
View
3  clj-http-client/TODO
@@ -1,4 +1,3 @@
Finish documentation
-Figure out logging situation
-Consider HttpComponents 4
+Upgrade to HttpComponents 4
Test against a Ring echo server
View
2  clj-scrape/test/files/uswebgen.html
@@ -91,7 +91,7 @@ <h3 align="center">10th Anniversary<br /> <br />
<div align="left">
<p><img src="photos/oldphoto1.jpg" width="175" height="200" align="right" />2006 marks the 10th Anniversary of the USGenWeb Project and I have been looking back over those past 10 years. When the USGenWeb Project began, it was one of the few (if not the only) centralized places on the internet to find genealogy information and post a query. Those early state and county sites began with links to the small amount of on-line information of interest to a family historian and a query page. The only Special Project was the Archives. How far the Project has come during the past 10 years! Now there are several special projects and the states, counties and special projects sites of the Project not only contain links; they are filled with information and transcribed records, and more is being added every day by our wonderful, dedicated and hard working volunteers.</p>
<p>Ten years ago the internet, as we know it today, was in its infancy. The things we take for granted today--e-mail, PCs, cell phones, digital cameras, etc., were not in the average person's world. Family historians and professional genealogists not only didn't use the internet, most had never heard of it.</p>
- <p>Over the past 10 years the internet has gone from obscurity to commonplace. As the internet became an every day tool for millions of people. it changed the way family historians do research. The availability of on-line, easily accessible genealogy and historical information has fueled the phenomenal growth of Genealogy as a hobby and, I'm proud to say, the Project has been right there every step of the way. </p>
+ <p>Over the past 10 years the internet has gone from obscurity to commonplace. As the internet became an every day tool for millions of people. it changed the way family historians do research. The availability of on-line, easily accessible-attrs genealogy and historical information has fueled the phenomenal growth of Genealogy as a hobby and, I'm proud to say, the Project has been right there every step of the way. </p>
<p>Everywhere we look we see genealogy reported as the fastest growing hobby in the country. Now the internet is the first stop for beginning family historians and is used extensively by experienced researchers. New &quot;How To&quot; genealogy books devote chapters to using the internet, and it is a rare book that does not recommend The USGenWeb Project as one of the first places to visit.</p>
<p>While subscription sites have popped up everywhere on the web, The Project has continued to offer free access to its vast wealth of information. The USGenWeb Project is recognized as the premier site of free information, and the Project's websites welcome well over a million visitors each day.</p>
<p>The Project is where it is today because of the thousands of volunteers, both past and present, who cared enough to devote, collectively, millions of hours to gathering, transcribing and uploading information. </p>
View
7 stash/TODO
@@ -1,12 +1,9 @@
-stash.core/update ???
-rething accessible-attrs name and implementation
-throw usefyll error when hash braces are forgotten on defmodel
-
add support for (sane) auto-incrementing ids, in def ddl/migs and pk-init
-rethink, test attr protection, foo* situation
+
datetime caster
more validators
multi-order (while still keeping simple case)
+
associations
calculations
locking, esp. optimistic
View
2  stash/src/stash/core.clj
@@ -5,4 +5,4 @@
stash.utils)
(:load "core_column_mappings" "core_def" "core_uuid" "core_callbacks"
"core_validations" "core_sql" "core_crud" "core_finders"
- "core_transactions" "core_sugar"))
+ "core_transactions"))
View
30 stash/src/stash/core_crud.clj
@@ -129,20 +129,27 @@
"Returns a new instance based on the given instance but reflecting any
attribute values in attrs. Does not touch the databse."
[instance attrs]
- (limit-keys attrs (accessible-attrs (instance-model instance)))
+ (limit-keys attrs (accessible-attrs (instance-model instance))
+ "Attempted to mass-assign keys not declared as accessible-attrs: %s")
(update-attrs* instance attrs))
+(defn new-instance
+ "Returns a new instance of the given model, with only the auto-initializing
+ pk values set."
+ [model]
+ (with-meta
+ (if-let [init-fn (pk-init model)] (init-fn) {})
+ {:model model :new true}))
+
(defn init*
"Like init, but bypasses mass-assignment protection."
[model & [attrs]]
- (let [pk-attrs (if-let [init-fn (pk-init model)] (init-fn) {})]
- (update-attrs* (with-meta pk-attrs {:model model :new true}) attrs)))
+ (update-attrs* (new-instance model) attrs))
(defn init
"Returns an instance of the model with the given attrs having new status."
[model & [attrs]]
- (limit-keys attrs (accessible-attrs model))
- (init* model attrs))
+ (update-attrs (new-instance model) attrs))
(defn instantiate
"Returns an instance based on unparsed versions of the given quoted attrs
@@ -192,8 +199,17 @@
(defn create
"Creates an instance of the model with the attrs."
[model & [attrs]]
- (limit-keys attrs (accessible-attrs model))
- (create* model attrs))
+ (save (init model attrs)))
+
+(defn update*
+ "Like update, but bypasses mass-assignment protection."
+ [instance attrs]
+ (save (update-attrs* instance attrs)))
+
+(defn update
+ "Like update-attrs, but saves the model as well."
+ [instance attrs]
+ (save (update-attrs instance attrs)))
(defn destroy
"Deletes the instance, running before- and after- destroy callbacks.
View
16 stash/src/stash/core_def.clj
@@ -166,7 +166,8 @@
Raises on any unrecognized callback names."
[model-map]
(let [cb-map (get model-map :callbacks)]
- (limit-keys cb-map recognized-callback-names)
+ (limit-keys cb-map recognized-callback-names
+ "Unrecognized callback names: %s")
{:before-validation-on-create
(concat (get cb-map :before-validation-on-create)
(get cb-map :before-validation))
@@ -204,7 +205,8 @@
"Returns the given model map provided that it contains only valid keys,
raises otherwise."
[model-map]
- (limit-keys model-map recognized-model-keys))
+ (limit-keys model-map recognized-model-keys
+ "Unrecognized model map keys: %s"))
(defn compiled-model
"Returns a compiled model representation that can be used later as the
@@ -230,14 +232,10 @@
:casters-by-name (compiled-mappers-by-name type-caster column-defs)
:validators (compiled-validators model-map)
:callbacks (compiled-callbacks model-map)
- :accessible-attrs (checked-accessible-attrs model-map)
+ :accessible-attrs (checked-accessible-attrs model-map)
:model-map model-map})))
(defmacro defmodel
"Short for (def name (compiled-model model-map))"
- [name model-map & [options]]
- (limit-keys options '(:accessors))
- (if (get options :accessors)
- `(do (def ~name (compiled-model ~model-map))
- ((resolve 'stash.core/define-accessors) ~name))
- `(def ~name (compiled-model ~model-map))))
+ [name model-map]
+ `(def ~name (compiled-model ~model-map)))
View
12 stash/src/stash/core_finders.clj
@@ -32,6 +32,18 @@
(find-all-by-sql model
(find-sql model options)))
+(defn get-one
+ "Returns an instance corresponding to the record for the given pk val(s)."
+ [model pk-val-or-vals]
+ (let [pk-vals (if (coll? pk-val-or-vals) pk-val-or-vals [pk-val-or-vals])]
+ (find-one model {:where (pk-where-exp (pk-column-names model) pk-vals)})))
+
+(defn reload
+ "Returns an instance corresponding to the given one but reloaded fresh from
+ the db."
+ [instance]
+ (find-one (instance-model instance) {:where (pk-where-exp instance)}))
+
(defn delete-all-by-sql
"Deletes model's records from the database according to the sql,
returning the number that were deleted."
View
17 stash/src/stash/core_sugar.clj
@@ -1,17 +0,0 @@
-(in-ns 'stash.core)
-
-(defn inc-attr [instance attr-name]
- "Returns a model with the value for attr-name incremented by 1."
- (update instance attr-name inc))
-
-(defn get-one
- "Returns an instance corresponding to the record for the given pk val(s)."
- [model pk-val-or-vals]
- (let [pk-vals (if (coll? pk-val-or-vals) pk-val-or-vals [pk-val-or-vals])]
- (find-one model {:where (pk-where-exp (pk-column-names model) pk-vals)})))
-
-(defn reload
- "Returns an instance corresponding to the given one but reloaded fresh from
- the db."
- [instance]
- (find-one (instance-model instance) {:where (pk-where-exp instance)}))
View
10 stash/src/stash/utils.clj
@@ -3,7 +3,7 @@
clojure.contrib.except
clojure.contrib.str-utils))
-(defn update
+(defn assoc-by
"'Updates' a value in an associative structure, where k is a key and f is a
function that will take the old value and any supplied args and return the new
value, and returns the new associative structure."
@@ -50,11 +50,13 @@
(defn limit-keys
"Assures that the given map has only keys included in recognized-keys,
throwing an exception if there are unrecognized keys or returning the map
- otherwise."
- [m recognized-keys]
+ otherwise.
+ The exception message will be formatted according to message-template, which
+ should include an %s where the unrecognized keys will be inserted."
+ [m recognized-keys message-template]
(let [bad (reduce #(dissoc %1 %2) m recognized-keys)]
(if-not (empty? bad)
- (throwf "Unrecognized keys %s" (pr-str (keys bad)))))
+ (throwf message-template (pr-str (keys bad)))))
m)
(defn the-str
View
4 stash/test/stash/core_callbacks_test.clj
@@ -2,7 +2,7 @@
(defn- upcase-title
[post]
- [(update post :title (memfn toUpperCase)) true])
+ [(assoc-by post :title (memfn toUpperCase)) true])
(defn- possible-failing
[post]
@@ -10,7 +10,7 @@
(defn- inc-view_count
[post]
- [(update post :view_count inc) true])
+ [(assoc-by post :view_count inc) true])
(defmodel +post-with-callbacks+
(assoc +post-map+ :callbacks
View
22 stash/test/stash/core_crud_test.clj
@@ -62,11 +62,11 @@
{:before-validation-on-create
[(fn [i] [(assoc i :track [:before-v]) true])]
:after-validation-on-create
- [(fn [i] [(update i :track conj :after-v) true])]
+ [(fn [i] [(assoc-by i :track conj :after-v) true])]
:before-create
- [(fn [i] [(update i :track conj :before-c) true])]
+ [(fn [i] [(assoc-by i :track conj :before-c) true])]
:after-create
- [(fn [i] [(update i :track conj :after-c) true])]})))
+ [(fn [i] [(assoc-by i :track conj :after-c) true])]})))
(deftest-db "save: new instance"
(let [saved (save (init +post-with-save-callbacks+ +complete-post-map+))]
@@ -86,16 +86,28 @@
(assert= 7
(:view_count (create +post+ (assoc +complete-post-map+ :view_count "7")))))
-(deftest "update-attrs"
+(deftest "update-attrs: accessible attrs"
(assert= 7
(:view_count
(update-attrs (init +post+ +complete-post-map+) {:view_count "7"}))))
+(deftest "update-attrs: inaccessible attrs"
+ (assert-throws
+ #"Attempted to mass-assign keys not declared as accessible-attrs.*\:pk_uuid"
+ (update-attrs (init +post+ +complete-post-map+)
+ {:pk_uuid "foobar" :pk_integer 5})))
+
+(deftest "update"
+ (let [saved (create +post+ +complete-post-map+)
+ updated (update saved {:view_count 7})]
+ (assert= 7 (:view_count updated))
+ (assert= 7 (:view_count (reload updated)))))
+
(def +post-with-destroy-cbs+
(compiled-model
(assoc +post-map+ :callbacks
{:before-destroy [(fn [i] [(assoc i :track [:before]) true])]
- :after-destroy [(fn [i] [(update i :track #(conj % :after)) true])]})))
+ :after-destroy [(fn [i] [(assoc-by i :track #(conj % :after)) true])]})))
(deftest-db "destroy, deleted?"
(let [destroyed (destroy (create +post-with-destroy-cbs+ +complete-post-map+))]
View
4 stash/test/stash/core_def_test.clj
@@ -9,12 +9,12 @@
(assert= +post+ (instance-model (init +post+))))
(deftest "compiled-model: throws on unrecognized callback names"
- (assert-throws #"Unrecognized keys \(:foobar\)"
+ (assert-throws #"Unrecognized callback names: \(:foobar\)"
(compiled-model (assoc +post-map+ :callbacks {:foobar [identity]}))))
(deftest "compiled-model: throws on unrecognized column types"
(assert-throws #"Unrecognized column type: :bogus_type"
- (compiled-model (update +post-map+ :columns conj [:a_name :bogus_type]))))
+ (compiled-model (assoc-by +post-map+ :columns conj [:a_name :bogus_type]))))
(deftest "defmodel"
(assert= +macro-post+ (compiled-model +post-map+)))
View
17 stash/test/stash/core_finders_test.clj
@@ -80,6 +80,23 @@
(list +complete-post+)
(find-all +post+ {:where [:id := (:id +complete-post+)]})))
+(deftest-db "get-one: single pk"
+ (let [saved (save +complete-post+)]
+ (assert-that
+ (get-one +post+ (:id +complete-post+)))))
+
+(deftest-db "get-one: multi pk"
+ (let [saved (save +simple-schmorg+)]
+ (assert-that
+ (get-one +schmorg+
+ [(:pk_uuid +simple-schmorg+) (:pk_integer +simple-schmorg+)]))))
+
+(deftest-db "reload"
+ (let [saved (save +complete-post+)
+ reloaded (reload saved)]
+ (assert= saved reloaded)
+ (assert-not (identical? saved reloaded))))
+
(deftest-db "delete-all-by-sql"
(persist-insert +complete-post+)
(persist-insert +complete-post-2+)
View
21 stash/test/stash/core_sugar_test.clj
@@ -1,21 +0,0 @@
-(in-ns 'stash.core-test)
-
-(deftest "inc-attr"
- (assert= {:foo 2} (inc-attr {:foo 1} :foo)))
-
-(deftest "get-one: single pk"
- (let [saved (save +complete-post+)]
- (assert-that
- (get-one +post+ (:id +complete-post+)))))
-
-(deftest "get-one: multi pk"
- (let [saved (save +simple-schmorg+)]
- (assert-that
- (get-one +schmorg+
- [(:pk_uuid +simple-schmorg+) (:pk_integer +simple-schmorg+)]))))
-
-(deftest "reload"
- (let [saved (save +complete-post+)
- reloaded (reload saved)]
- (assert= saved reloaded)
- (assert-not (identical? saved reloaded))))
View
4 stash/test/stash/core_test.clj
@@ -15,6 +15,4 @@
"core_crud_test"
"core_finders_test"
"core_transactions_test"
- "core_extensions_test"
- "core_sugar_test"
- ))
+ "core_extensions_test"))
View
12 stash/test/stash/utils_test.clj
@@ -2,13 +2,13 @@
(:use clj-unit.core stash.utils))
-(deftest "update"
+(deftest "assoc-by"
(assert=
{:foo 2}
- (update {:foo 1} :foo inc))
+ (assoc-by {:foo 1} :foo inc))
(assert=
{:foo 6}
- (update {:foo 1} :foo + 2 3)))
+ (assoc-by {:foo 1} :foo + 2 3)))
(deftest "mash"
(doseq [f [list vector]]
@@ -37,9 +37,9 @@
(deftest "limit-keys"
(let [m {:foo :bar :biz :bat}]
- (assert= m (limit-keys m [:foo :biz :whiz])))
- (assert-throws #"Unrecognized keys \(:biz\)"
- (limit-keys {:foo :bar :biz :bat} [:foo :whiz])))
+ (assert= m (limit-keys m [:foo :biz :whiz] "Fails: %s")))
+ (assert-throws #"Fails: \(:biz\)"
+ (limit-keys {:foo :bar :biz :bat} [:foo :whiz] "Fails: %s")))
(deftest "the-str"
(assert= "foo" (the-str :foo))
View
10 weld-blog-example/TODO
@@ -1,11 +1,7 @@
error handling
pretty-printing xml and json api, with nice responses
app tests
-consider reloadability of routing and apps - currently not possible
-perhaps handlers could transparently handle vars
- what are the semantics of relading in Clojure in general
+consider reloadability of routing and apps
+ should be able to reload all user-level logic if routing is in vars
+ and routing and config file are reloaded
-; (htmlfor [post posts]
-; [:name {:key "val"}])
-
-; cling -> wiki backed by jgit and ring
View
8 weld-blog-example/src/weldblog/config.clj
@@ -1,5 +1,5 @@
(ns weldblog.config
- (:use clj-jdbc.data-sources clj-log4j.core)
+ (:use clj-jdbc.data-sources clj-log.core)
(:import java.io.File))
(def env (keyword (System/getProperty "weldblog.env")))
@@ -8,9 +8,9 @@
(def test? (= env :test))
(def prod? (= env :prod))
-(def app-host "localhost:8000")
+(def host "localhost:8000")
-(def public-dir (File. "public"))
+(def public (File. "public"))
(def data-source
(pg-data-source
@@ -20,7 +20,7 @@
test? {:database "weldblog_test" :user "mmcgrana" :password ""})))
(def logger
- (logger4j :err (cond prod? :info dev? :debug test? :error)))
+ (new-logger :err (cond prod? :info dev? :debug test? :error)))
(def exception-details? dev?)
(def exception-handling? prod?)
View
23 weld-blog-example/src/weldblog/controllers.clj
@@ -1,6 +1,6 @@
(ns weldblog.controllers
(:use
- (weld controller request)
+ (weld controller request config)
(weldblog routing auth))
(:require
(weldblog
@@ -10,7 +10,7 @@
[stash.core :as stash]))
(defn not-found [& [env]]
- (respond-404 (v/not-found (session env))))
+ (respond (v/not-found (session env))))
(defn not-authenticated [& [info]]
(respond (v/new-session info)))
@@ -44,7 +44,7 @@
(not-found ~env)))
(defn index [env]
- (with-fading-session [sess env]
+ (with-fading-session []
(respond (v/index (stash/find-all m/+post+) sess))))
(defn index-atom [env]
@@ -88,3 +88,20 @@
(stash/destroy post)
(flash-session sess :post-destroyed
(redirect (path :posts))))))
+
+(defn with-xtime
+ [action]
+ (fn [req]
+ (let [start (time/now)]
+ (let [resp (action req)]
+ (assoc-in resp [:headers "X-Runtime"] (- (time/now) start))))))
+
+(defn with-rescues
+ [action]
+ (fn [req]
+ (try
+ (action req)
+ (catch Exception e
+ (respond (v/internal-error) {:status 500})))))
+
+(def index (with-rescues (with-xtime index)))
View
2  weld-blog-example/src/weldblog/models.clj
@@ -9,11 +9,11 @@
(defmodel +post+
(merge model-base
{:table-name :posts
- :pk-init a-uuid
:columns
[[:id :uuid {:pk true}]
[:title :string]
[:body :string]]
+ :pk-init a-uuid
:accessible-attrs
[:title :body]
:validations
View
33 weld-blog-example/src/weldblog/routing.clj
@@ -1,20 +1,19 @@
(ns weldblog.routing
- (:require
- [weld.routing :as routing]
- [weldblog.config :as config]))
+ (:use weld.routing))
-(def c 'weldblog.controllers)
+(defn s [sym] (symbol "weldblog.controllers" (str sym)))
-(routing/defrouting config/app-host
- [[c 'new-session :new-session :get "/sessions/new"]
- [c 'create-session :create-session :put "/sessions" ]
- [c 'destroy-session :destroy-session :delete "/sessions" ]
- [c 'index :posts :get "/" ]
- [c 'index-atom :posts-atom :get "/posts.atom" ]
- [c 'new :new-post :get "/new" ]
- [c 'show :post :get "/:id" ]
- [c 'edit :edit-post :get "/:id/edit" ]
- [c 'create :create-post :put "/" ]
- [c 'update :update-post :post "/:id" ]
- [c 'destroy :destroy-post :delete "/:id" ]
- [c 'not-found :not-found :any "/:path" {:path ".*"}]])
+(def router
+ (compiled-router
+ [[(s new-session) :new-session :get "/sessions/new"]
+ [(s create-session) :create-session :put "/sessions" ]
+ [(s destroy-session) :destroy-session :delete "/sessions" ]
+ [(s index) :posts :get "/" ]
+ [(s index-atom) :posts-atom :get "/posts.atom" ]
+ [(s new) :new-post :get "/new" ]
+ [(s show) :post :get "/:id" ]
+ [(s edit) :edit-post :get "/:id/edit" ]
+ [(s create) :create-post :put "/" ]
+ [(s update) :update-post :post "/:id" ]
+ [(s destroy) :destroy-post :delete "/:id" ]
+ [(s not-found) :not-found :any "/:path" {:path ".*"}]]))
View
16 weld-blog-example/src/weldblog/views.clj
@@ -1,24 +1,22 @@
(ns weldblog.views
- (:use (weldblog routing utils auth)
+ (:use (weld routing)
+ (weldblog utils auth)
(clj-html core utils helpers helpers-ext)
[stash.core :only (errors)])
(:require [clj-time.core :as time]))
(defmacro with-layout
- [& body]
- `(with-layout-throwing {} ~@body))
-
-(defmacro with-layout-throwing
- [thrown-form & body]
- `(let [inner# (html ~@body)]
+ [assigns-form & body]
+ `(let [assigns# ~assigns-form
+ inner# (html ~@body)]
(html
(doctype :xhtml-transitional)
[:html {:xmlns "http://www.w3.org/1999/xhtml"}
[:head
(include-css "/stylesheets/main.css")
- (~thrown-form :for_head)
+ (get assigns# :for_head)
[:meta {:http-equiv "Content-Type" :content "text/html;charset=utf-8"}]
- [:title "Ring Blog Example"]
+ [:title "Weld Blog Example"]
[:body inner#]]])))
(def message-info
View
2  weld-snippets-example/README
@@ -0,0 +1,2 @@
+A snippet server implemented with Ring, Weld, and Stash.
+Based on the snippet server in 'Programming Clojure'
View
11 weld-snippets-example/src/weldsnip/app.clj
@@ -1,6 +1,3 @@
-;;; A snippet server implemented with Ring, Weld, and Stash.
-;;; Based on the snippet server in 'Programming Clojure'
-
(ns weldsnip.app
(:use (weld routing request controller app config)
(clj-html core utils helpers helpers-ext)
@@ -12,24 +9,22 @@
(:import java.io.File))
;; Config & Routing
-(def host "http://localhost:8080")
+(def custom-config (read-string (slurp "src/weldsnip/custom_config.clj")))
(def public (File. "public"))
(def statics '("/stylesheets" "/javascripts" "/favicon.ico"))
(def logger (new-logger :err :info))
-(def data-source
- (pg-data-source {:database "weldsnip_dev" :user "mmcgrana" :password ""}))
+(def data-source (pg-data-source (get custom-config :db)))
(def router
(compiled-router
[['weldsnip.app/ping :ping :get "/ping"]
- ['weldsnip.app/new :new :get "/" ]
+ ['weldsnip.app/new :new :get "/"]
['weldsnip.app/show :show :get "/:id"]
['weldsnip.app/create :create :post "/"]
['weldsnip.app/miss :miss :any "/:path" {:path ".*"}]]))
(use-config {'weld.routing/*router* router
- 'weld.routing/*host* host
'weld.app/*logger* logger})
;; Model
View
2  weld-snippets-example/src/weldsnip/custom_config.clj
@@ -0,0 +1,2 @@
+{:db
+ {:database "weldsnip_dev" :user "mmcgrana" :password ""}}
View
7 weld-upload-example/TODO
@@ -1,2 +1,7 @@
logger & envs & error handling
-tests
+tests
+
+:accessible-attrs??
+ also i don't like that it is the same for all users - i.e. is there a generalization of all or non access controls
+{:auto true} for ids and uuid
+
View
2  weld-upload-example/script/server.clj
@@ -1,4 +1,4 @@
-(System/setProperty "weldblog.env" (or (first *command-line-args*) "dev"))
+(System/setProperty "weldup.env" (or (first *command-line-args*) "dev"))
(require 'ring.jetty 'weldup.app)
View
31 weld-upload-example/src/weldup/app.clj
@@ -12,19 +12,18 @@
(ring reload backtrace static file-info)))
;; Config & Routing
-(def app-env (keyword (System/getProperty "weldup.env")))
-(def app-host "http://localhost:8080")
-(def public-dir (file-utils/file "public"))
-(def uploads-dir (file-utils/file "public/uploads"))
+(def env (keyword (System/getProperty "weldup.env")))
+(def host "http://localhost:8080")
+(def public (file-utils/file "public"))
+(def uploads (file-utils/file "public/uploads"))
(def statics '("/uploads" "/stylesheets" "/javascripts" "/favicon.ico"))
(def reloadables '(weldup.app weldup.utils))
+(def logger (if (= env :dev) (new-logger :out :info)))
(def data-source
(pg-data-source {:database "weldup_dev" :user "mmcgrana" :password ""}))
-(def app-logger (if (= app-env :dev) (new-logger :out :info)))
-(def app-router
+(def router
(compiled-router
- app-host
[['weldup.app/index :index :get "/"]
['weldup.app/new :new :get "/new"]
['weldup.app/create :create :put "/"]
@@ -32,16 +31,17 @@
['weldup.app/destroy :destroy :delete "/:id"]
['weldup.app/not-found :not-found :any "/:path" {:path ".*"}]]))
-(def config {#'router app-router #'logger app-logger})
+(def config
+ {'weld.routing/*router* router
+ 'weld.app/*logger* logger})
;; Models
(stash/defmodel +upload+
{:data-source data-source
:logger logger
:table-name :uploads
- :pk-init stash/a-uuid
:columns
- [[:id :uuid {:pk true}]
+ [[:id :uuid {:pk true :auto true}]
[:filename :string]
[:content_type :string]
[:size :integer]]
@@ -63,10 +63,11 @@
(file-utils/cp (:tempfile upload-map) (upload-file upload)))))
(defn destroy-upload [upload]
- (stash/destroy upload)
- (file-utils/rm-f (upload-file upload)))
+ (stash/transaction +upload+
+ (stash/destroy upload)
+ (file-utils/rm-f (upload-file upload))))
-(defmacro with-layout
+(defmacro layout
[& body]
`(html
(doctype :xhtml-transitional)
@@ -77,7 +78,7 @@
[:body ~@body]]))
(defn index-view [uploads]
- (with-layout
+ (layout
[:p (link-to "new upload" (path :new))]
[:h2 "Uploads (" (count uploads) ")"]
(html-for [upload uploads]
@@ -86,7 +87,7 @@
(delete-button "Delete" (path :destroy upload))])))
(defn new-view []
- (with-layout
+ (layout
[:p (link-to "back to uploads" (path :index))]
[:h2 "New Upload"]
(form-to (path-info :create) {:multipart true}
Please sign in to comment.
Something went wrong with that request. Please try again.