diff --git a/README.md b/README.md index 6a852ed..98f5f2e 100644 --- a/README.md +++ b/README.md @@ -68,11 +68,10 @@ Each var that is recorded can be customized with options: fn; if it returns falsy, the call will be passed to through to the original function both during recording and playback. - -## TODO - -* Add a better way to re-record than deleting cassette files. - Maybe an environment variable? +- `:record-new-episodes?`: + a boolean indicating if an existing cassette should be + updated with calls that were not previously recorded. + defaults to false. ## License diff --git a/src/vcr_clj/cassettes.clj b/src/vcr_clj/cassettes.clj index 077dfb8..5725573 100644 --- a/src/vcr_clj/cassettes.clj +++ b/src/vcr_clj/cassettes.clj @@ -28,8 +28,15 @@ (binding [*out* writer] (prn cassette)))) +(defn- reattach-http-meta + [cassette] + (let [set-http-meta #(vary-meta % assoc :type :vcr-clj.clj-http/serializable-http-request) + update-episode #(update % :return set-http-meta)] + (update cassette :calls #(mapv update-episode %)))) + ;; TODO: use clojure.edn? (defn read-cassette [name] - (with-open [r (java.io.PushbackReader. (io/reader (cassette-file name)))] - (edn/read {:readers data-readers} r))) + (let [cassette (with-open [r (java.io.PushbackReader. (io/reader (cassette-file name)))] + (edn/read {:readers data-readers} r))] + (reattach-http-meta cassette))) diff --git a/src/vcr_clj/core.clj b/src/vcr_clj/core.clj index 975dadf..e053f6b 100644 --- a/src/vcr_clj/core.clj +++ b/src/vcr_clj/core.clj @@ -52,6 +52,9 @@ cassette {:calls @calls}] [func-return cassette])) +(defn indexed-cassette [cassette] + (group-by (juxt :var-name :arg-key) (:calls cassette))) + ;; I guess currently we aren't recording actual arguments, just the arg-key. ;; Should that change? (defn playbacker @@ -67,7 +70,7 @@ [cassette order-scope] ;; don't support anything else yet (case order-scope - :key (let [calls (atom (group-by (juxt :var-name :arg-key) (:calls cassette)))] + :key (let [calls (atom (indexed-cassette cassette))] (fn [var-name arg-key] (let [next-val (swap! calls (fn [x] @@ -81,26 +84,43 @@ {:function var-name :arg-key arg-key})))))))) +(defn record-new-episodes? [specs the-var-name] + (->> specs + (filter #(= (var-name (:var %)) the-var-name)) + first + :record-new-episodes?)) + ;; Assuming that order is only preserved for calls to any var in ;; particular, not necessarily all the vars considered together. (defn playback [specs cassette func] - (let [the-playbacker (playbacker cassette :key) + (let [updated-cassette (atom cassette) + record! #(swap! updated-cassette update-in [:calls] conj %) + has-recording? #(get (indexed-cassette cassette) [%1 %2]) + the-playbacker (playbacker cassette :key) redeffings (into {} - (for [{:keys [var arg-key-fn recordable?] + (for [{:keys [var arg-key-fn recordable? return-transformer] :or {arg-key-fn vector - recordable? (constantly true)}} + recordable? (constantly true) + return-transformer identity}} specs :let [orig (deref var) the-var-name (var-name var) wrapped (fn [& args] (let [k (apply arg-key-fn args)] (if (apply recordable? args) - (:return (the-playbacker the-var-name k)) + (if (and (record-new-episodes? specs the-var-name) + (not (has-recording? the-var-name k))) + (let [result (return-transformer (apply orig args))] + (record! {:var-name the-var-name + :arg-key k + :return result}) + result) + (:return (the-playbacker the-var-name k))) (apply orig args))))]] [var (add-meta-from wrapped orig)]))] - (with-redefs-fn redeffings func))) + [(with-redefs-fn redeffings func) @updated-cassette])) ;; * TODO ;; ** Handle streams @@ -115,7 +135,9 @@ (if (cassette-exists? cassette-name) (do (println' "Running test with existing" cassette-name "cassette...") - (playback specs (read-cassette cassette-name) func)) + (let [[result cassette] (playback specs (read-cassette cassette-name) func)] + (write-cassette cassette-name cassette) + result)) (do (println' "Recording new" cassette-name "cassette...") (let [[return cassette] (record specs func)] @@ -139,6 +161,10 @@ a function that the return value will be passed through while recording, which can be useful for doing things like ensuring serializability. + :record-new-episodes? + a boolean indicating if an existing cassette should be + updated with calls that were not previously recorded. + defaults to false. }" [cname specs & body] `(with-cassette-fn* ~cname ~specs (fn [] ~@body))) diff --git a/test/vcr_clj/test/clj_http.clj b/test/vcr_clj/test/clj_http.clj index 6efa729..9162e0b 100644 --- a/test/vcr_clj/test/clj_http.clj +++ b/test/vcr_clj/test/clj_http.clj @@ -123,3 +123,21 @@ (is (= "bar" (get "/foo"))))) (with-cassette :whale (is (= "bar" (get "/foo"))))) + +(defn time-server [&args] + {:status 200 + :body (str (System/currentTimeMillis)) + :headers {}}) + + +(deftest recording-new-http-episodes + (with-jetty-server time-server + (with-local-vars [result-with-a nil + result-with-b nil] + (with-cassette :recording-new-episodes + (var-set result-with-a (get "/a"))) + (with-cassette :recording-new-episodes {:record-new-episodes? true} + (var-set result-with-b (get "/b"))) + (with-cassette :recording-new-episodes + (is (= (get "/a") @result-with-a)) + (is (= (get "/b") @result-with-b)))))) diff --git a/test/vcr_clj/test/core.clj b/test/vcr_clj/test/core.clj index 1a02ace..9f71554 100644 --- a/test/vcr_clj/test/core.clj +++ b/test/vcr_clj/test/core.clj @@ -110,3 +110,18 @@ (is (= 42 (self-caller 41)))) (is (empty? (calls self-caller)) "the recorded call does not result in any self-calls"))) + +(defn current-time [& args] + "Accepts any arguments and returns the current time" + (System/currentTimeMillis)) + +(deftest recording-new-episodes + (with-local-vars [result-with-a nil + result-with-b nil] + (with-cassette :recording-new-episodes [{:var #'current-time}] (var-set result-with-a (current-time :a))) + (with-cassette :recording-new-episodes [{:var #'current-time :record-new-episodes? true}] + (var-set result-with-b (current-time :b))) + (with-cassette :recording-new-episodes [{:var #'current-time}] + (is (= (current-time :a) @result-with-a)) + (is (= (current-time :b) @result-with-b))))) +