Don't store width/height in screen map

Don't store width/height in screen map

--- src/play_clj/core.clj
+++ src/play_clj/core.clj
@@ -22,14 +22,11 @@
 (defn defscreen*
   [{:keys [on-show on-render on-hide on-pause on-resize on-resume]
     :or {on-show dummy on-render dummy on-hide dummy
-         on-pause dummy on-resize dummy on-resume dummy}
-    :as options}]
+         on-pause dummy on-resize dummy on-resume dummy}}]
   (let [screen (atom {})]
     (proxy [Screen] []
       (show []
         (on-show (swap! screen assoc
-                        :width (game :width)
-                        :height (game :height)
                         :total-time 0
                         :delta-time 0
                         :set-entities #(swap! screen assoc :entities %)
@@ -43,7 +40,7 @@
                           :delta-time delta-time)))
       (hide [] (on-hide @screen))
       (pause [] (on-pause @screen))
-      (resize [w h] (on-resize (swap! screen assoc :width w :height h)))
+      (resize [w h] (on-resize @screen))
       (resume [] (on-resume @screen)))))

 (defmacro defscreen
@@ -51,8 +48,7 @@
   `(defonce ~name (defscreen* ~options)))

 (defn defgame*
-  [{:keys [on-create]
-    :or {on-create dummy}}]
+  [{:keys [on-create] :or {on-create dummy}}]
   (proxy [Game] []
     (create [] (on-create this))))


Rename touch :age to :ticks

Rename touch :age to :ticks

--- src/playmary/one.cljs
+++ src/playmary/one.cljs
@@ -159,7 +159,7 @@
         touches (js->clj (.-changedTouches event) :keywordize-keys true)]
     (map (fn [x] {:type (.-type event)
                   :touch-id (:identifier x)
-                  :age 0 ;; ticks
+                  :ticks 0
                   :position {:x (:clientX x) :y (:clientY x)}
                   :time (.-timeStamp event)})
          (for [x (range (:length touches))] ((keyword (str x)) touches)))))
@@ -295,16 +295,16 @@
    (assoc touches touch-id t)))

 (defn emit-touch?
-  [{t-type :type t-age :age} touches]
+  [{t-type :type t-ticks :ticks} touches]
   (and (or (= t-type "touchstart") (= t-type "touchend"))
-       (> t-age 0)))
+       (> t-ticks 0)))

 (defn touch-tick
   [touches out-c]
   (let [{emit true keep false} (group-by emit-touch? (vals touches))]
     (go
      (onto-chan out-c (or (vals (select-keys touches (map :touch-id emit))) '()) false)
-     (reduce (fn [m k] (update-in m [k :age] inc))
+     (reduce (fn [m k] (update-in m [k :ticks] inc))
              (select-keys touches (map :touch-id keep))
              (map :touch-id keep)))))


snapshot: can create callbacks but Qimessaging fails when trying to call invoke()

--- src/naojure/core.clj
+++ src/naojure/core.clj
@@ -16,8 +16,8 @@
                     :sensors "ALSensors"
                     :sonar "ALSonar"
                     :sound-detection "ALSoundDetection"
-                    :speech-recognition "ALSpeechRecognitionProxy"
-                    :tts "ALTextToSpeechProxy"
+                    :speech-recognition "ALSpeechRecognition"
+                    :tts "ALTextToSpeech"
                     })

 (def joint-names '("HeadYaw", "HeadPitch",
@@ -108,6 +108,21 @@

 ; event handling

+; almost there, but get
+;[E] 4426 qimessaging.jni: Cannot find java method invoke (Ljava/lang/Object;)V
+;[W] 4426 qitype.signal: Exception caught from signal subscriber: Cannot find method
+(defn add-event-handler
+  "Call the provided clojure function on the named event"
+  [robot event callback]
+  (let [memory (get-proxy robot :memory)
+        subscriber (.get (.call memory "subscriber" (into-array [event])))]
+    (.connect subscriber "signal::(m)" "invoke::m(m)" callback)))
+
+(defn start-main-loop
+  "Starts the Qimessaging event loop"
+  [robot]
+  (.start (Thread. (fn [] (.run (:application robot))))))
+
 ; behaviour management
 (defn get-installed-behaviours
   "Return list of behaviours installed on robot"


arglists

arglists

--- src/oi_lang/obj.cljs
+++ src/oi_lang/obj.cljs
@@ -4,7 +4,7 @@

 (defparser oi-program
   "start = '' | exp
-   <exp> = literal / message
+   <exp> = literal / message / send
    <literal> = number / string

    number = digit+
@@ -18,6 +18,8 @@
    message = identifier <' '*> <'('> <' '*> arglist <' '*> <')'>
            | identifier
    arglist = '' | exp | arglist <' '*> <','> <' '*> exp
+
+   send = exp <' '+> message
    ")

 (defn reduce-arglist [& params]


avatar without suffix

avatar without suffix

--- src/ontrail/user.clj
+++ src/ontrail/user.clj
@@ -9,7 +9,7 @@
             email (get onuser :email)
             gravatar-md5-hash (md5 email)]
         (if gravatar?
-          (str "http://www.gravatar.com/avatar/" gravatar-md5-hash ".jpg")
+          (str "http://www.gravatar.com/avatar/" gravatar-md5-hash)
           "/img/default-avatar.png"))
       "/img/drno.png")))


Wrap all MIDI event handlers uniformly.

Wrap all MIDI event handlers uniformly.

Not all registered MIDI event handlers were being called inside of a
try/catch block or being checked for thread interruption. This change
uses a single delegation function to do that in a uniform way, and also
offers a single point where they can be moved onto another thread to
protect against resource starvation if and when I am ready to do that.

This change also fixes the API doc describing the mapping atoms, it was
out of date.

--- src/afterglow/midi.clj
+++ src/afterglow/midi.clj
@@ -124,27 +124,42 @@
   {:pre [(= (type device) :midi-device) (fn? f)]}
   (swap! disconnected-device-handlers #(update-in % [(@midi-device-key device)] disj f)))

+(defonce ^:private ^{:doc "The queue used to hand MIDI events from the
+  extension thread to our world, since there seem to be classloader
+  compatibility issues, and the Java3d classes are not available to
+  threads that are directly dispatching MIDI events. Although we
+  allocate a capacity of 100 elements, it is expected that the queue
+  will be drained much more quickly than events arrive, and so it will
+  almost always be empty."} midi-queue
+  (LinkedBlockingDeque. 100))
+
+(defonce ^:private ^{:doc "The thread used to hand MIDI events from
+  the extension thread to our world, since there seem to be
+  classloader compatibility issues, and the Java3d classes are not
+  available to threads that are directly dispatching MIDI events."}
+  midi-transfer-thread
+  (atom nil))
+
 (defonce ^{:private true
            :doc "The metronomes which are being synced to MIDI clock
-  pulses. A map whose keys are the `javax.sound.midi.MidiDevice` on
-  which clock pulses are being received, and whose values are in turn
-  maps whose keys are the metronomes being synced to pulses from that
-  device, and whose values are the sync function to call when each
-  pulse is received."} synced-metronomes (atom {}))
+  pulses. A map whose keys are the [[midi-device-key]] on which clock
+  pulses are being received, and whose values are in turn maps whose
+  keys are the metronomes being synced to pulses from that device, and
+  whose values are the sync function to call when each pulse is
+  received."} synced-metronomes (atom {}))

 (defonce ^{:private true
            :doc "Functions to be called when MIDI Controller Change
   messages arrive from particular input ports. A set of nested maps
-  whose keys are the `javax.sound.midi.MidiDevice` on which the
-  message should be watched for, the channel to watch, and the
-  controller number to watch for. The values are sets of functions to
-  be called with each matching message."}
-  control-mappings (atom {}))
+  whose keys are the [[midi-device-key]] on which the message should
+  be watched for, the channel to watch, and the controller number to
+  watch for. The values are sets of functions to be called with each
+  matching message."} control-mappings (atom {}))

 (defonce ^{:private true
            :doc "Functions to be called when MIDI Note messages arrive
   from particular input ports. A set of nested maps whose keys are the
-  `javax.sound.midi.MidiDevice` on which the message should be watched
+  [[midi-device-key]] on which the message should be watched
   for, the channel to watch, and the note number to watch for. The
   values are sets of functions to be called with each matching
   message."}
@@ -153,19 +168,26 @@
 (defonce ^{:private true
            :doc "Functions to be called when MIDI Aftertouch
   (polyphonic key pressure) messages arrive from particular input
-  ports. A set of nested maps whose keys are the
-  `javax.sound.midi.MidiDevice` on which the message should be watched
-  for, the channel to watch, and the note number to watch for. The
-  values are sets of functions to be called with each matching
-  message."}
-  aftertouch-mappings (atom {}))
+  ports. A set of nested maps whose keys are the [[midi-device-key]]
+  on which the message should be watched for, the channel to watch,
+  and the note number to watch for. The values are sets of functions
+  to be called with each matching message."} aftertouch-mappings (atom
+  {}))

 (defonce ^{:private true
            :doc "Functions to be called when MIDI System Exclusive
   messages arrive from particular input ports. A map whose keys are
-  the `javax.sound.midi.MidiDevice` on which the message should be
-  watched for. The values are sets of functions to be called with each
-  matching message."} sysex-mappings (atom {}))
+  the [[midi-device-key]] on which the message should be watched for.
+  The values are sets of functions to be called with each matching
+  message."} sysex-mappings (atom {}))
+
+(defonce ^{:private true
+           :doc "Functions to be called when any MIDI message is
+  received from a specific device. A map whose keys are the
+  [[midi-device-key]] on which the message should be watched for, and
+  whose values are sets of functions to be called with each matching
+  message."}
+  device-mappings (atom {}))

 (defonce ^{:private true
            :doc "Functions to be called when any MIDI message at all
@@ -186,48 +208,72 @@
   [f]
   (swap! global-handlers disj f))

+(defn- run-message-handler
+  "Invokes a registered MIDI message handler function with an incoming
+  message that has been identified as appropriate to send to it. If an
+  exception is thrown during that invocation, responds appropriately,
+  including shutting down the message handler thread if it was
+  interrupted. This is done by setting the `running` atom to `false`."
+  [handler msg running]
+  (try
+    ;; TODO: This is not really safe because if the handler blocks it ties up all future
+    ;;       MIDI dispatch. Should do in a future with a timeout? Don't want to use a million
+    ;;       threads for this either, so a core.async channel approach is probably best.
+    ;;
+    (handler msg)
+    (catch InterruptedException e
+      (timbre/info "MIDI event handler thread interrupted, shutting down.")
+      (reset! running false)
+      (reset! midi-transfer-thread nil))
+    (catch Throwable t
+      (timbre/error t "Problem running MIDI event handler."))))

 (defn- clock-message-handler
   "Invoked whenever any midi input device being managed receives a
   clock message. Checks whether there are any metronomes being synced
   to that device, and if so, passes along the event."
-  [msg]
+  [msg running]
   (doseq [handler (vals (get @synced-metronomes (@midi-device-key (:device msg))))]
-    (handler msg)))
+    (when @running
+      (run-message-handler handler msg running))))

 (defn- cc-message-handler
   "Invoked whenever any midi input device being managed receives a
   control change message. Checks whether there are any handlers (such
   as for launching cues or mapping show variables) attached to it, and
   if so, calls them."
-  [msg]
+  [msg running]
   (doseq [handler (get-in @control-mappings [(@midi-device-key (:device msg)) (:channel msg) (:note msg)])]
-    (handler msg)))
+    (when @running
+      (run-message-handler handler msg running))))

 (defn- note-message-handler
   "Invoked whenever any midi input device being managed receives a
   note message. Checks whether there are any handlers (such as for
   launching cues or mapping show variables) attached to it, and if so,
   calls them."
-  [msg]
+  [msg running]
   (doseq [handler (get-in @note-mappings [(@midi-device-key (:device msg)) (:channel msg) (:note msg)])]
-    (handler msg)))
+    (when @running
+      (run-message-handler handler msg running))))

 (defn- aftertouch-message-handler
   "Invoked whenever any midi input device being managed receives an
   aftertouch (polyphonic key pressure) message. Checks whether there
   are any handlers attached to it, and if so, calls them."
-  [msg]
+  [msg running]
   (doseq [handler (get-in @aftertouch-mappings [(@midi-device-key (:device msg)) (:channel msg) (:note msg)])]
-    (handler msg)))
+    (when @running
+      (run-message-handler handler msg running))))

 (defn- sysex-message-handler
   "Invoked whenever any midi input device being managed receives a
   System Exclusive message. Checks whether there are any handlers
   attached to it, and if so, calls them."
-  [msg]
+  [msg running]
   (doseq [handler (get-in @sysex-mappings [(@midi-device-key (:device msg))])]
-    (handler msg)))
+    (when @running
+      (run-message-handler handler msg running))))

 (defonce
   ^{:private true
@@ -235,7 +281,7 @@
   be offered as synchronization sources. Also notes when they seem to
   be sending the additional beat phase information provided by the
   Afterglow Traktor controller mapping. Holds a set of nested maps
-  whose top-level keys are the `javax.sound.midi.MidiDevice` on which
+  whose top-level keys are the [[midi-device-key]] on which
   clock pulses have been detected, and whose second-level keys can
   include `:timing-clock`, which will store the timestamp of the
   most-recently received clock pulse from that device, `:master`,
@@ -269,22 +315,6 @@
     (when (= (:status msg) :timing-clock)
       (swap! clock-sources assoc-in [device-key :timing-clock] (now)))
     (check-for-traktor-beat-phase msg device-key)))
-
-(defonce ^:private ^{:doc "The queue used to hand MIDI events from the
-  extension thread to our world, since there seem to be classloader
-  compatibility issues, and the Java3d classes are not available to
-  threads that are directly dispatching MIDI events. Although we
-  allocate a capacity of 100 elements, it is expected that the queue
-  will be drained much more quickly than events arrive, and so it will
-  almost always be empty."} midi-queue
-  (LinkedBlockingDeque. 100))
-
-(defonce ^:private ^{:doc "The thread used to hand MIDI events from
-  the extension thread to our world, since there seem to be
-  classloader compatibility issues, and the Java3d classes are not
-  available to threads that are directly dispatching MIDI events."}
-  midi-transfer-thread
-  (atom nil))

 (defn mac?
   "Return true if we seem to be running on a Mac."
@@ -509,55 +539,30 @@
             ;; First call the global message handlers
             (doseq [handler @global-handlers]
               (when @running
-                (try
-                  ;; TODO: This is not really safe because if the handler blocks it ties up all future
-                  ;;       MIDI dispatch. Should do in a future with a timeout? Don't want to use a million
-                  ;;       threads for this either, so a core.async channel approach is probably best.
-                  ;;
-                  (handler msg)
-                  (catch InterruptedException e
-                    (timbre/info "MIDI event handler thread interrupted, shutting down.")
-                    (reset! running false)
-                    (reset! midi-transfer-thread nil))
-                  (catch Throwable t
-                    (timbre/error t "Problem running global MIDI event handler.")))))
+                (run-message-handler handler msg running)))

             ;; Then call any registered port listeners for the port on which
             ;; it arrived

             ;; Then call specific message handlers that match
             (when @running
-              (try
-                (cond (#{:timing-clock :start :stop} (:status msg))
-                      (clock-message-handler msg)
-
-                      (= 0xf0 (:status msg))
-                      (sysex-message-handler msg)
-
-                      :else
-                      (case (:command msg)
-                        :control-change (do (cc-message-handler msg)
-                                            (clock-message-handler msg)) ; In case it is a Traktor beat phase message
-                        (:note-on :note-off) (note-message-handler msg)
-                        :poly-pressure (aftertouch-message-handler msg)
-                        nil))
-                (catch InterruptedException e
-                  (timbre/info "MIDI event handler thread interrupted, shutting down.")
-                  (reset! running false)
-                  (reset! midi-transfer-thread nil))
-                (catch Throwable t
-                  (timbre/error t "Problem running MIDI event handler"))))
+              (cond (#{:timing-clock :start :stop} (:status msg))
+                    (clock-message-handler msg running)
+
+                    (= 0xf0 (:status msg))
+                    (sysex-message-handler msg running)
+
+                    :else
+                    (case (:command msg)
+                      :control-change (do (cc-message-handler msg running)
+                                          (clock-message-handler msg running)) ; Might be Traktor beat phase message
+                      (:note-on :note-off) (note-message-handler msg running)
+                      :poly-pressure (aftertouch-message-handler msg running)
+                      nil)))

             ;; Finally, keep track of any MIDI clock messages we have seen so the
             ;; user can be informed of them as potential sync sources.
-            (try
-              (watch-for-clock-sources msg)
-              (catch InterruptedException e
-                (timbre/info "MIDI event handler thread interrupted, shutting down.")
-                (reset! running false)
-                (reset! midi-transfer-thread nil))
-              (catch Throwable t
-                (timbre/error t "Problem looking for MIDI clock sources"))))))
+            (run-message-handler watch-for-clock-sources msg running))))

       ;; If we have not been shut down, do it all again for the next message.
       (when @running (recur (.take midi-queue))))))


Use proper software transactional memory in sync.

--- src/afterglow/midi.clj
+++ src/afterglow/midi.clj
@@ -230,16 +230,17 @@
   collecting timestamps, and if we have enough, calculate a BPM value
   and update the associated metronome."
   [msg buffer metronome]
-  (case (:status msg)
-    :timing-clock (let [timestamp (now)]
-                    (swap! buffer conj timestamp)
-                    (when (> (count @buffer) 2)
-                      (let [passed (- timestamp (peek @buffer))
-                            intervals (dec (count @buffer))
-                            mean (/ passed intervals)]
-                        (metro-bpm metronome (double (/ 60000 (* mean 24)))))))
-    (:start :stop) (reset! buffer (ring-buffer max-clock-intervals)) ; Clock is being reset!
-    nil))
+  (dosync
+   (case (:status msg)
+     :timing-clock (let [timestamp (now)]
+                     (alter buffer conj timestamp)
+                     (when (> (count @buffer) 2)
+                       (let [passed (- timestamp (peek @buffer))
+                             intervals (dec (count @buffer))
+                             mean (/ passed intervals)]
+                         (metro-bpm metronome (double (/ 60000 (* mean 24)))))))
+            (:start :stop) (ref-set buffer (ring-buffer max-clock-intervals)) ; Clock is being reset!
+            nil)))

 (defn- add-synced-metronome
   [midi-clock-source metronome sync-fn]
@@ -258,13 +259,15 @@
     (sync-stop [this]
       (remove-synced-metronome midi-clock-source metronome))
     (sync-status [this]
-      (let [n (count @buffer)]
-        {:type :midi,
-         :status (cond
-                   (empty? @buffer)           "Inactive, no clock pulses have been received."
-                   (< n  max-clock-intervals) (str "Stalled? Clock pulse buffer has " n " of "
-                                                   max-clock-intervals " pulses in it.")
-                   :else                      "Running, clock pulse buffer is full.")})))
+      (dosync
+       (ensure buffer)
+       (let [n (count @buffer)]
+         {:type :midi,
+          :status (cond
+                    (empty? @buffer)           "Inactive, no clock pulses have been received."
+                    (< n  max-clock-intervals) (str "Stalled? Clock pulse buffer has " n " of "
+                                                    max-clock-intervals " pulses in it.")
+                    :else                      "Running, clock pulse buffer is full.")}))))

 (defn- describe-name-filter
   "Returns a description of a name filter used to narrow down MIDI
@@ -329,7 +332,7 @@
          0 (throw (IllegalArgumentException. (str "No MIDI clock sources " (describe-name-filter name-filter)
                                                   "were found.")))
          1 (fn [^afterglow.rhythm.Metronome metronome]
-             (let [sync-handler (ClockSync. metronome (first result) (atom (ring-buffer max-clock-intervals)))]
+             (let [sync-handler (ClockSync. metronome (first result) (ref (ring-buffer max-clock-intervals)))]
                (sync-start sync-handler)
                sync-handler))


Lots of cleanup of mongo code; cleaner direct dependence on mongo component

--- src/polismath/components/mongo.clj
+++ src/polismath/components/mongo.clj
@@ -7,62 +7,71 @@
             [monger.collection :as mc]))

-;; This should maybe be using the mongo component instance instead of config directly
-(defn mongo-collection-name
+(defn collection-name
   "Mongo collection name based on math-env and math-schema-date config variables. Makes sure that
-  prod, preprod, dev (and subdevs like chrisdev or mikedev) have their own noninterfering collections.
-  Used for actual math results."
-  [{:keys [math-schema-date math-env] :as config} basename]
-  (str "math_" math-env "_" math-schema-date "_" basename))
+  prod, preprod, dev (and subdevs like chrisdev or mikedev) have their own noninterfering collections."
+  ([mongo rootname]
+   (let [{:keys [math-schema-date math-env]} (:config mongo)]
+     (str rootname "_" math-env "_" math-schema-date)))
+  ([mongo rootname basename] (str (collection-name mongo rootname) basename)))

-(defn mongo-exports-collection-name
-  "Mongo collection name based on math-env config variable. Makes sure that prod, preprod, dev (and
-  subdevs like chrisdev or mikedev) have their own noninterfering collections. Points to collection
-  for export status information."
-  [{:keys [math-env] :as config} basename]
-    (str "exports_" math-env))
+(defn math-collection-name
+  "As in collection-name function, with rootname bound to 'math'; used for actual math results."
+  [mongo basename]
+  (collection-name mongo "math" basename))
+
+(defn exports-collection-name
+  "As in collection-name function, with rootname bound to 'math'; used for actual math results."
+  [mongo]
+  (collection-name mongo "exports"))

 (defn- megabytes
   [^long n]
   (* n 1024 1024))

-(defn get-connection-and-db [{:keys [mongo-url] :as config}]
-  (if (:mongo-url config)
-    (let [{:keys [conn db]} (mg/connect-via-uri mongo-url)]
-      [conn db])
-    (let [conn (mg/connect)]
-      [conn (mg/get-db conn "local-db")])))
+(defn get-connection-and-db!
+  "Connects either to (-> config :mongo :url), or a local temp mongo db if nil, and assocs in the connection
+  and db to the mongo record as the return value."
+  [{:keys [config] :as mongo}]
+  (merge mongo
+         (if-let [mongo-url (-> config :mongo :url)]
+           (mg/connect-via-uri mongo-url)
+           (let [conn (mg/connect)]
+             {:conn conn :db (mg/get-db conn "local-db")}))))

 (defn setup-rolling-profile-collection!
-  [db]
-  (let [prof-coll (mongo-collection-name "profile")]
+  "Sets up the rolling profile collection, if not already present in the mongo db. Returns mongo for
+  threading convenience."
+  [{:keys [db] :as mongo}]
+  (let [prof-coll (math-collection-name mongo "profile")]
     (if-not (mc/exists? db prof-coll)
       (try
         (mc/create db prof-coll {:capped true :size (-> 125 megabytes) :max 200000})
         (catch Exception e
-          (log/warn "Unable to create capped profile collection. Perhaps it's already been created?"))))))
+          (log/warn "Unable to create capped profile collection. Perhaps it's already been created?")))))
+  mongo)

 (defn setup-indices!
-  [config db]
+  "Set up zid indices for upserting and more efficient queries. Also create expiring index for export records."
+  [{:keys [config db] :as mongo}]
   ; Create indices, in case they don't exist
-  (doseq [c ["bidtopid" "main" "cache"]]
-    (let [c (mongo-collection-name c)]
-      (mc/ensure-index db c (array-map :zid 1) {:name (str c "_zid_index") :unique true})))
+  (doseq [c (map (partial math-collection-name mongo)
+                 ["bidtopid" "main" "cache"])]
+    (mc/ensure-index db c (array-map :zid 1) {:name (str c "_zid_index") :unique true}))
   ;; An index for lastupdated on "exports" collection
-  (mc/ensure-index db "exports" {:lastupdate 1} {:expireAfterSeconds (* (try (Integer/parseInt (:export-expiry-days config))
-                                                                            (catch Exception e 10)) ;; Note: make sure env variable exists and move to config component XXX
-                                                                        (* 60 60 24))}))
+  (mc/ensure-index db (exports-collection-name mongo) {:lastupdate 1} {:expireAfterSeconds (-> config :export :expiry-days (* 60 60 24))})
+  mongo)

 (defrecord Mongo [config conn db]
   component/Lifecycle
   (start [component]
     (log/info "Starting Mongo component with mongo-url:" (:mongo-url config))
     (if-not (and conn db)
-      (let [[conn db] (get-connection-and-db config)]
-        (setup-rolling-profile-collection! db)
-        (setup-indices! config db)
-        (assoc component :conn conn :db db))
+      (-> component
+          get-connection-and-db!
+          setup-rolling-profile-collection!
+          setup-indices!)
       component))

   (stop [component]
@@ -79,16 +88,36 @@
   [mongo zid]
   (mc/find-one-as-map
     (:db mongo)
-    (mongo-collection-name (:config mongo) "main")
+    (collection-name (:config mongo) "main")
     {:zid zid}))

 (defn format-for-mongo
   "Formats data for mongo, first passing through a prep function which may strip out uneeded junk or
   reshape things. Takes conv and lastVoteTimestamp, though the latter may be moved into the former in update"
-  [prep-fn conv]
+  [conv]
   (-> conv
-      prep-fn
       ; core.matrix & monger workaround: convert to str with cheshire then back
       ch/generate-string
       ch/parse-string))

+(defn zid-upsert
+  "Perform upsert of new results on mongo collection name based on :zid of new-results"
+  [mongo collection-name new-results]
+  (mc/update
+    (:db mongo)
+    collection-name
+    {:zid (or (:zid new-results) ; covering our bases for strings or keywords due to cheshire hack
+              (get new-results "zid"))}
+    new-results
+    {:upsert true}))
+
+
+(defn insert
+  "Perform insert to mongo collection"
+  [mongo collection-name object]
+  (mc/insert
+    (:db mongo)
+    collection-name
+    object))
+
+


Problem 0076.

Problem 0076.

--- src/project_euler/problem_0076.clj
+++ src/project_euler/problem_0076.clj
@@ -18,20 +18,21 @@
          (map (fn [s] (map count s)))
          )))

-(defn start-histo [n]
-  (->> (sum-generator n)
-       (group-by first)
-       (map (fn [[beg sums]] [beg (count sums)]))
-       (sort)
-       ))
+;; Partition function (number theory)
+(def p
+  (memoize
+   (fn [n]
+     (if (zero? n)
+       1
+       (->> (mapcat (fn [k] [(/ (* k (- (* 3 k) 1)) 2) (/ (* k (+ (* 3 k) 1)) 2)])
+                    (iterate inc 1))
+            (take-while (fn [m] (<= m n)))
+            (map (fn [m] (p (- n m))))
+            (map (fn [ix pm] (if (even? (quot ix 2)) pm (- pm))) (iterate inc 0))
+            (reduce +)
+            )))))

-(defn full-histo [m]
-  (->> (range 2 m)
-       (map (fn [n] [n (start-histo n)]))
-       (map (fn [[n h]] (println (format "%2d" n) (map #(format "%-7s" %) h))))
-       ))
+(defn solution []
+  (- (p 100) 1))

-
-  (defn naive-n-of-sums [n]
-    (count (sum-generator count)))
-
+;;-> 190569291


remove empty strings from token list: e.g. ["the" "" "cat"] => ["the" "cat"]

--- src/babel/parse.cljc
+++ src/babel/parse.cljc
@@ -125,7 +125,7 @@
   ([input model]
    (log/info (str "parsing input: '" input "'"))
    (cond (string? input)
-         (parse (string/split input tokenizer) model)
+         (parse (filter #(not (empty? %)) (string/split input tokenizer)) model)

          (or (seq? input) (vector? input))
          ;; assume input is a list of tokens.


~(defn generate-question-and-correct-set): wrap babel.generate/generate in a +(binding [babel.generate/truncate? true])

--- src/babel/reader.clj
+++ src/babel/reader.clj
@@ -146,7 +146,9 @@
                    (filter lexical-filter-fn)))})

         target-expression
-        (target-timing-fn (babel.generate/generate target-spec target-model))
+        (target-timing-fn
+         (binding [babel.generate/truncate? true]
+           (babel.generate/generate target-spec target-model)))
         source-spec
         (u/strip-refs ;; TODO: consider removing strip-refs; not clear if there is any reason why we need to do it.
          (u/unify


use $$ for sql string delimiters

use $$ for sql string delimiters

--- src/babel/writer.clj
+++ src/babel/writer.clj
@@ -152,9 +152,9 @@

   (try
     (exec-raw [(str "INSERT INTO " table " (surface, structure, serialized, language, model) VALUES (?,"
-                    "'" (json/write-str (strip-refs expression)) "'"
+                    "$$" (json/write-str (strip-refs expression)) "$$"
                     ","
-                    "'" (str (serialize expression)) "'"
+                    "$$" (str (serialize expression)) "$$"
                     ","
                     "?,?)")
                [surface
@@ -164,6 +164,7 @@
       (log/error (str "SQL error: " (.printStackTrace (.getNextException(.getSQLException e))))))))

 (defn insert-lexeme [canonical lexeme language]
+  (log/debug (str "insert-lexeme: canonical=" canonical ",lexeme=" lexeme ",language=" language))
   (if (fail? lexeme)
     (let [message (str "Refusing to enter a :fail for canonical form: " canonical)]
       (log/error message)
@@ -172,7 +173,7 @@
     (exec-raw [(str "INSERT INTO lexeme
                                  (canonical, structure, serialized, language)
                           VALUES (?,"
-                    "'" (json/write-str (strip-refs lexeme)) "'"
+                    "$$" (json/write-str (strip-refs lexeme)) "$$"
                     ",?,?)")
                [canonical (str (serialize lexeme))
                 language]])))


Removed the file I was using to validate the encoding/decoding process with real .torrent files.

--- src/bencode/main.clj
+++ src/bencode/main.clj
@@ -1,106 +0,0 @@
-(ns bencode.main
-  (:gen-class)
-  (:use [bencode.core])
-  (:require [clojure.java [io :as io]]))
-
-(def torrent-file (io/file "/Users/danielmartins/Downloads/03.torrent"))
-
-(with-open [stream (io/input-stream torrent-file)]
-  (def torrent (bdecode stream {:str-keys? true
-                                :raw-keys ["pieces"]})))
-
-(defn parse-date
-  ""
-  [timestamp]
-  (java.util.Date. (* timestamp 1000)))
-
-(defn torrent-length
-  ""
-  [torrent]
-  (get-in torrent ["info" "piece length"]))
-
-(defn torrent-pieces
-  ""
-  [torrent]
-  (/ (count (get-in torrent ["info" "pieces"])) 20))
-
-(defn torrent-first-piece
-  ""
-  [torrent]
-  (take 20 (get-in torrent ["info" "pieces"])))
-
-(defn torrent-last-piece
-  ""
-  [torrent]
-  (let [pieces (get-in torrent ["info" "pieces"])]
-    (take 20 (drop (- (count pieces) 20) pieces))))
-
-(defn torrent-size
-  ""
-  [torrent]
-  (* (torrent-length torrent)
-     (torrent-pieces torrent)))
-
-(defn hex-from-bytes
-  ""
-  [byte-arr]
-  (let [sb (StringBuffer.)]
-    (doseq [b byte-arr]
-      (.append sb (.substring (Integer/toString (+ (bit-and b 0xff) 0x100) 16) 1)))
-    (.toString sb)))
-
-(defn torrent-info-hash
-  ""
-  [torrent]
-  (let [enc (bencode (get torrent "info") {:raw-str? true})
-        dig (java.security.MessageDigest/getInstance "SHA1")
-        res (.digest dig enc)]
-    (hex-from-bytes res)))
-
-(defn print-announce-group
-  ""
-  [idx group]
-  (print (str (inc idx) ". "))
-  (apply print (interpose ", " group))
-  (println ""))
-
-(defn print-file
-  ""
-  [idx file]
-  (print (str (inc idx) ". "))
-  (print (apply str (interpose "/" (get file "path")))
-         (str "[" (get file "length") " bytes]"))
-  (println ""))
-
-(defn -main
-  [& args]
-  (println "Torrent Name........: " (get-in torrent ["info" "name"]))
-  (println "Creation Date.......: " (parse-date (get torrent "creation date")))
-  (println "Created By..........: " (get torrent "created by"))
-  (println "Info Hash...........: " (torrent-info-hash torrent))
-  (println "Encoding............: " (get torrent "encoding"))
-  (println "Private.............: " (get-in torrent ["info" "private"] 0))
-  (println "Comment.............: " (get torrent "comment"))
-
-  (println "")
-
-  (println "Piece Length........: " (str (torrent-length torrent) " bytes"))
-  (println "Number of Pieces....: " (torrent-pieces torrent))
-  (println "Total size..........: " (str (torrent-size torrent) " bytes"))
-
-  (println "")
-
-  (println "SHA1 of 1st Piece...: " (hex-from-bytes (torrent-first-piece torrent)))
-  (println "SHA1 of Last Piece..: " (hex-from-bytes (torrent-last-piece torrent)))
-
-  (println "")
-
-  (println "Trackers............: " (get torrent "announce"))
-  (doall
-   (map-indexed print-announce-group (get torrent "announce-list")))
-
-  (println "")
-
-  (println "Files...............: " (count (get-in torrent ["info" "files"])))
-  (doall
-   (map-indexed print-file (get-in torrent ["info" "files"]))))


call render every frame

call render every frame

--- src/splash/core.cljs
+++ src/splash/core.cljs
@@ -26,6 +26,10 @@
     :background 0x505050}))

+(defonce render-go-block (go (while true
+               (<! (events/next-frame))
+               ;(log "frame")
+               ((:render-fn canvas)))))

 (defn on-js-reload []
   ;; optionally touch your app-state to force rerendering depending on


license

license

--- src/aws/networking.clj
+++ src/aws/networking.clj
@@ -1,3 +1,14 @@
+(comment
+  Celestial, Copyright 2012 Ronen Narkis, narkisr.com
+  Licensed under the Apache License,
+  Version 2.0  (the "License") you may not use this file except in compliance with the License.
+  You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0
+  Unless required by applicable law or agreed to in writing, software
+  distributed under the License is distributed on an "AS IS" BASIS,
+  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+  See the License for the specific language governing permissions and
+  limitations under the License.)
+
 (ns aws.networking
   "AWS networking functions"
   (:require


some parts of parsing works again (french-only for now)

--- src/babel/workbook.clj
+++ src/babel/workbook.clj
@@ -22,6 +22,29 @@
    [dag-unify.core :refer [get-in remove-false strip-refs]]
    [hiccup.core :refer [html]]
 ))
+
+
+(def foo
+  (generate {:synsem {:subcat '()
+                      :infl :imperfect
+                      :sem {:pred :be
+                            :subj {:pred :I}}}}
+            @fr/small))
+
+
+(defn analyze [surface-form lookup-fn]
+  "return the map incorporating the lexical information about a surface form..."
+  (lookup-fn surface-form))
+
+(defn lookup [token]
+  "return the subset of lexemes that match this token from the lexicon."
+  (analyze token #(get (:lexicon @fr/small) %)))
+
+(defn parse [string]
+  (parse/parse string
+               (:lexicon @fr/small)
+               lookup
+               (:grammar @fr/small)))

 ;; this does some sample runtime behavior (generates sentences)
 ;; which allow certain things to get initialized so that remote (i.e. HTTP
@@ -175,25 +198,3 @@
 ;;                                          :infl :imperfect
 ;;                                          :sem {:subj {:pred :I} :pred :be}}}
 ;;                                @fr/small)
-
-(def foo
-  (generate {:synsem {:subcat '()
-                      :infl :imperfect
-                      :sem {:pred :be
-                            :subj {:pred :I}}}}
-            @fr/small))
-
-
-(defn analyze [surface-form lookup-fn]
-  "return the map incorporating the lexical information about a surface form..."
-  (lookup-fn surface-form))
-
-(defn lookup [token]
-  "return the subset of lexemes that match this token from the lexicon."
-  (analyze token #(get (:lexicon fr/small) %)))
-
-(defn parse [string]
-  (parse/parse string
-               (:lexicon fr/small)
-               lookup
-               (:grammar fr/small)))


make *config* {} .cake/config missing

make *config* {} .cake/config missing

--- src/cake/project.clj
+++ src/cake/project.clj
@@ -20,9 +20,10 @@

 (defn read-config []
   (let [file (File. ".cake/config")]
-    (when (.exists file)
+    (if (.exists file)
       (with-open [f (FileInputStream. file)]
-        (into {} (doto (Properties.) (.load f)))))))
+        (into {} (doto (Properties.) (.load f))))
+      {})))

 (def *config* (read-config))


event start can be a js date

event start can be a js date

--- src/callie/core.cljs
+++ src/callie/core.cljs
@@ -203,8 +203,14 @@
       (js/console.error (str "Container with id " container-id " not found.")))))

 (defn read-event [event]
-   (-> (js->clj event :keywordize-keys true)
-       (update-in [:start] DateTime.fromRfc822String)))
+  (-> (js->clj event :keywordize-keys true)
+      (update-in
+        [:start]
+        (fn [start-value]
+        ;; start property can either be a string or a datelike thing
+          (if (string? start-value)
+            (DateTime.fromRfc822String start-value)
+            (DateTime. start-value))))))

 (defn read-events [events]
   (sort-by #(.valueOf :start) (map read-event events)))


Made dom-element and append-children more generic and added support for ifn? plugins and bindings.

--- src/freactive/dom.cljs
+++ src/freactive/dom.cljs
@@ -354,7 +354,7 @@
           (string? attr-handler)
           (do-bind-attr (get-ns-attr-setter element attr-ns attr-name) attr-value)

-          (fn? attr-handler)
+          (ifn? attr-handler)
           (attr-handler element attr-name attr-value)

           :default
@@ -497,20 +497,21 @@

 (declare as-velem)

-(defn- append-children* [ch* children]
-  (doseq [ch children]
-    (if (sequential? ch)
-      (let [head (first ch)]
-        (cond
-          (or (keyword? head) (fn? head))
-          (.push ch* (as-velem ch))
-
-          :default
-          (append-children* ch* ch)))
-      (.push ch* (as-velem ch))))
-  ch*)
-
-(defn element* [elem-factory]
+(defn- append-children* [velem-fn]
+  (fn append-ch [ch-res children]
+    (doseq [ch children]
+      (if (sequential? ch)
+        (let [head (first ch)]
+          (cond
+            (or (keyword? head) (and (ifn? head) (not (sequential? head))))
+            (.push ch-res (velem-fn ch))
+
+            :default
+            (append-ch ch-res ch)))
+        (.push ch-res (velem-fn ch))))
+    ch-res))
+
+(defn element* [elem-factory append-children-fn]
   (fn [ns-uri tag tail]
     (let [[_ tag-name id class] (re-matches re-tag tag)
           attrs? (first tail)
@@ -528,13 +529,8 @@
                               (if cls (str class " " cls) class)))))

           children (if have-attrs (rest tail) tail)
-          children* (append-children* #js [] children)]
+          children* (append-children-fn #js [] children)]
       (elem-factory ns-uri tag-name attrs children*))))
-
-(def dom-element
-  (element*
-   (fn [ns-uri tag-name attrs children*]
-     (DOMElement. ns-uri tag-name attrs children* nil nil nil))))

 (defn- dom-node? [x]
   (and x (> (.-nodeType x) 0)))
@@ -552,6 +548,8 @@
   (let [state (UnmanagedDOMNode. dom-node on-dispose nil)]
     (set! (.-freactive-state dom-node) state)
     state))
+
+(declare dom-element)

 (defn- as-velem [elem-spec]
   (cond
@@ -576,7 +574,7 @@
                 (string? tag-handler)
                 (dom-element tag-handler tag-name tail)

-                (fn? tag-handler)
+                (ifn? tag-handler)
                 (as-velem (tag-handler tag-name tail))

                 :default
@@ -584,7 +582,7 @@
               (.warn js/console "Undefined ns node prefix" tag-ns))
             (dom-element nil tag-name tail)))

-        (fn? head)
+        (and (ifn? head) (not (sequential? head)))
         (as-velem (r/rx* (fn [] (apply head (rest elem-spec)))))

         :default
@@ -603,6 +601,13 @@
     (as-velem (r/-as-velem elem-spec as-velem))

     :default (as-velem (-get-dom-image elem-spec))))
+
+(def dom-element
+  (element*
+   (fn [ns-uri tag-name attrs children*]
+     (DOMElement. ns-uri tag-name attrs children* nil nil nil))
+   (append-children* as-velem)))
+

 ;; Public API


Modified 'new' to allow for multiple templates.

--- src/cake/tasks/new.clj
+++ src/cake/tasks/new.clj
@@ -6,12 +6,13 @@
   (:import [org.apache.tools.ant.taskdefs Mkdir Copy]))

 (def default-template
-"(defproject %s \"0.0.1-SNAPSHOT\"
+"(defproject +project+ \"0.0.1-SNAPSHOT\"
   :description \"TODO: add summary of your project\"
   :dependencies [[clojure \"1.2.0\"]])
 ")

-(def template-dir (file "~" ".cake" "template"))
+(def template-dir (file "~" ".cake" "templates"))
+(def default-template-dir (file template-dir "default"))

 (defn rename-dirs [root project]
   (log "Renaming directories with +project+ in their name")
@@ -21,39 +22,42 @@
           :when (not= name replaced)]
     (.renameTo old-file (file (.getParent old-file) replaced))))

-(defn template-new [project]
+(defn template-new [project template]
   (let [root (file *pwd* project)]
     (if (.exists root)
       (println "error:" project "already exists in this directory")
       (do
-        (log "Creating a new project based on ~/.cake/template")
-        (ant Copy {:todir root} (add-fileset {:dir (str (file "~" ".cake" "template"))}))
+        (log (str "Creating a new project based on ~/cake/templates/" template))
+        (ant Copy {:todir root} (add-fileset {:dir (str (file template-dir template))}))
         (rename-dirs root project)
         (let [files (file-seq root)]
           (log (str "Replacing +project+ with '" project "' in all files."))
           (doseq [f (filter #(.isFile %) files)]
             (spit f (.replace (slurp f) "+project+" project))))))))

-(defn create-default-template [project]
-  (log "Creating template directory: ~/.cake/template")
-  (ant Mkdir {:dir template-dir})
-  (ant Mkdir {:dir (file template-dir "src" "+project+")})
-  (spit (file template-dir "src" "+project+" "core.clj") "(ns +project+.core)")
+(defn create-default-template []
+  (log "Creating template directory: ~/.cake/templates/default")
+  (ant Mkdir {:dir default-template-dir})
+  (ant Mkdir {:dir (file default-template-dir "src" "+project+")})
+  (spit (file default-template-dir "src" "+project+" "core.clj") "(ns +project+.core)")
   (log "Created template file: src/+project+/core.clj")
-  (ant Mkdir {:dir (file template-dir "test")})
-  (spit (file template-dir "project.clj") (format default-template project))
+  (ant Mkdir {:dir (file default-template-dir "test")})
+  (spit (file default-template-dir "project.clj") default-template)
   (log "Created template file: project.clj")
-  (spit (file template-dir ".gitignore")
-        (apply str (interleave [".cake" "pom.xml" "*.jar" "*.war" "lib" "classes" "build" project] (repeat "\n"))))
+  (spit (file default-template-dir ".gitignore")
+        (apply str (interleave [".cake" "pom.xml" "*.jar" "*.war" "lib" "classes" "build" "+project+"] (repeat "\n"))))
   (log "Created template file: .gitignore")
-  (extract-resource "LICENSE" template-dir)
+  (extract-resource "LICENSE" default-template-dir)
   (log "Created template LICENSE file (Eclipse Public License)"))

 (deftask new
   "Create scaffolding for a new project."
-  "You can put a default project template in ~/.cake/template. Substitute +project+ anywhere
-   that you want your project name to be."
-  {[project] :new}
-  (when-not (.exists template-dir)
-    (create-default-template project))
-  (template-new project))
+  "You can put project templates in ~/.cake/templates. Each template is a directory with a default
+   template. You can specify which template to use for your project when you call this task. If
+   you don't specify which template to use, ~/.cake/templates will be used. It will be created if
+   it does not already exist.
+   Examples: cake new aproj, cake new mytemplate aproj"
+  {[one two] :new}
+  (when-not (.exists default-template-dir)
+    (create-default-template))
+  (apply template-new (or (and two [two one]) [one "default"])))


Handle closed msg-put-res.

Handle closed msg-put-res.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -27,7 +27,10 @@
 (defn msg-put-res [actx ch-key m]
   (let [res-ch (achan actx)]
     (act msg-put-res actx
-         (aput msg-put-res (ch-key m) (assoc m :res-ch res-ch)))
+         (when (not (aput msg-put-res (ch-key m) (assoc m :res-ch res-ch)))
+           (aput-close msg-put-res res-ch
+                       (assoc m :status :failed
+                              :status-info [(:op m) :closed :msg-put-res]))))
     res-ch))

 (defn msg-req [actx ch-key m]


Long lines.

Long lines.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -21,14 +21,13 @@

 ; --------------------------------------------

-; --------------------------------------------
-
 (defn kv-server [server-addr & ports]
   (let [lane-max-inflight 10
         lane-buf-size 20
         make-lane (fn [actx lane-name lane-out-ch]
                     (let [lane-in-ch (achan-buf actx lane-buf-size)]
-                      (cbfg.fence/make-fenced-pump actx lane-name lane-in-ch lane-out-ch
+                      (cbfg.fence/make-fenced-pump actx lane-name
+                                                   lane-in-ch lane-out-ch
                                                    lane-max-inflight false)
                       lane-in-ch))
         conn-loop (fn [actx server-send-ch server-recv-ch close-server-recv-ch]


cleaning

cleaning

--- src/celestial/jobs.clj
+++ src/celestial/jobs.clj
@@ -131,9 +131,6 @@
    [envs js]
    (filter (fn [{:keys [env]}] (info env) (envs env)) js))

-#_(defn jobs-status [envs]
-  (merge {:jobs (running-jobs-status)} (done-jobs-status)))
-
 (defn jobs-status [envs]
   (map-vals
     (merge {:jobs (running-jobs-status)} (done-jobs-status))


Return jetty state to enable tools.namespace workflow.

--- src/clj/aspire/web.clj
+++ src/clj/aspire/web.clj
@@ -49,6 +49,7 @@
       (file-info/wrap-file-info)
       (wrap-trace :ui)))

-(defn run [& args]
-  (jetty/run-jetty #'app {:port 4001}))
+(defn run!
+  [& args]
+  (apply jetty/run-jetty #'app args))


Remove Datomic :/

Remove Datomic :/

--- src/clj/topiq/core.clj
+++ src/clj/topiq/core.clj
@@ -28,9 +28,7 @@
             [clojure.core.async :refer [timeout sub chan <!! >!! <! >! go go-loop] :as async]
             [com.ashafa.clutch.utils :as utils]
             [com.ashafa.clutch :refer [couch]]
-            [clojure.tools.logging :refer [info warn error]]
-
-            [datomic.api :as d]))
+            [clojure.tools.logging :refer [info warn error]]))

 (def server-state (atom nil))


Don't expect keywords to be functions of records. Records will be functions of their attributes.

--- clj_record/test/core_test.clj
+++ clj_record/test/core_test.clj
@@ -22,7 +22,7 @@

 (defdbtest get-record-by-id
   (let [humedai (manufacturer/create (valid-manufacturer-with {:name "Humedai Motors"}))]
-    (is (= humedai (manufacturer/get-record (:id humedai))))))
+    (is (= humedai (manufacturer/get-record (humedai :id))))))

 (defdbtest get-record-throws-if-not-found
   (is (thrown? IllegalArgumentException (manufacturer/get-record -1))))
@@ -39,12 +39,12 @@

 (defdbtest destroy-record-destroys-by-id-from-record
   (let [humedai (manufacturer/create (valid-manufacturer-with {:name "Humedai Motors"}))]
-    (manufacturer/destroy-record {:id (:id humedai)})
-    (is (empty? (manufacturer/find-records {:id (:id humedai)})))))
+    (manufacturer/destroy-record {:id (humedai :id)})
+    (is (empty? (manufacturer/find-records {:id (humedai :id)})))))

 (defdbtest update-uses-id-to-update-other-given-attributes-leaving-unspecified-attributes-untouched
   (let [humedai (manufacturer/create (valid-manufacturer-with {:name "Humedai Motors" :grade 90}))
-        id (:id humedai)]
+        id (humedai :id)]
     (manufacturer/update {:id id :name "Schmoomdai Motors" :founded "2008"})
     (is (=
       {:name "Schmoomdai Motors" :grade 90 :founded "2008"}


Update to clojure 1.8

Update to clojure 1.8

--- clojure/cljsearch/project.clj
+++ clojure/cljsearch/project.clj
@@ -3,7 +3,10 @@
   :url "https://github.com/clarkcb/xsearch"
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
-  :dependencies [[org.clojure/clojure "1.6.0"]]
+  :dependencies [
+                  [org.clojure/clojure "1.8.0"]
+                  [org.clojure/data.json "0.2.6"]
+                ]
   :main ^:skip-aot cljsearch.cljsearch
   :target-path "target/%s"
   :profiles {:uberjar {:aot :all}})


Tests for module job-data-fetcher

Tests for module job-data-fetcher

--- test/emender_jenkins/job_data_fetcher_test.clj
+++ test/emender_jenkins/job_data_fetcher_test.clj
@@ -13,7 +13,8 @@
 (ns emender-jenkins.job-data-fetcher-test
   (:require [clojure.test :refer :all]
             [emender-jenkins.job-data-fetcher :refer :all]
-            [emender-jenkins.results          :as results]))
+            [emender-jenkins.results          :as results]
+            [emender-jenkins.common-fetcher   :as common-fetcher]))

 ;
 ; Common functions used by tests.
@@ -44,6 +45,19 @@
 (deftest test-fetch-data
     "Checking the function fetch-data."
     (testing "the function fetch-data."
+        (let [configuration    {:jenkins {:currently-building-view "Building"
+                                          :jenkins-url "http://10.20.30.40:8080/"}}]
         (with-redefs [results/reload-all-results (fn [configuration] :ok)]
-            (is (= :ok (fetch-data nil))))))
+            (is (= :ok (fetch-data configuration)))))))

+(deftest test-run-fetcher-in-thread
+    "Check the function emender-jenkins.build-queue-fetcher/run-fetcher-in-thread"
+    (testing "the function emender-jenkins.build-queue-fetcher/run-fetcher-in-thread"
+        (let [started (atom nil)]
+        (with-redefs [common-fetcher/run-fetcher (fn [name config sleep-amount func status] (reset! started true))]
+            (run-fetcher-in-thread {:fetcher {:run-job-fetcher false}})
+            (is (nil? @started))
+            (run-fetcher-in-thread {:fetcher {:run-job-fetcher true}})
+            (Thread/sleep 1)
+            (is (not (nil? @started)))))))
+


Update core.clj

Update core.clj

--- src/jarkeeper/core.clj
+++ src/jarkeeper/core.clj
@@ -15,7 +15,6 @@
             [jarkeeper.views.json :as project-json]
             [ancient-clj.core :as anc])
   (:import (java.io PushbackReader)))
-


fix: commited to much from a branch

fix: commited to much from a branch

--- ssclj/jar/build.boot
+++ ssclj/jar/build.boot
@@ -24,7 +24,6 @@
                  '[[org.clojure/clojure]

                    [aleph]
-                   [manifold]
                    [cheshire] ;; newer version needed for ring-json
                    [compojure]
                    [com.jcraft/jsch]
@@ -38,7 +37,6 @@
                    [metrics-clojure-jvm]
                    [metrics-clojure-graphite]
                    [me.raynes/fs]
-                   [org.clojure/core.async :exclusions []]
                    [org.clojure/data.json]
                    [org.clojure/java.classpath]
                    [org.clojure/tools.cli]
@@ -48,7 +46,6 @@
                    [ring/ring-core]
                    [ring/ring-json]
                    [superstring]
-                   [zookeeper-clj]

                    [com.sixsq.slipstream/utils]
                    [com.sixsq.slipstream/auth]
@@ -67,7 +64,6 @@
                    [honeysql]
                    [org.clojure/test.check]
                    [org.slf4j/slf4j-log4j12 :scope "test"]
-                   [org.apache.curator/curator-test :scope "test"]

                    ;; boot tasks
                    [boot-environ]


correct the usage hint

correct the usage hint

--- src/leiningen/sync.clj
+++ src/leiningen/sync.clj
@@ -142,9 +142,9 @@
              ""
              "To specify the namespaces and resources to be shared, you must define them in project.clj. i.e"
              ":sync {:test-cmd    [[\"lein\" \"test\"]]"
-             "          :namespaces  [\"namespace.to.be.sync.1\" \"namespace.to.be.sync.2\"]"
-             "          :packages    [\"package.to.be.sync.1\" \"package.to.be.sync.2\"]"
-             "          :resources   [\"resource.to.be.sync.1\"  \"resource.to.be.sync.2\" ]}"
+             "       :namespaces  [\"namespace.to.be.sync.1\" \"namespace.to.be.sync.2\"]"
+             "       :packages    [\"package.to.be.sync.1\" \"package.to.be.sync.2\"]"
+             "       :resources   [\"resource.to.be.sync.1\"  \"resource.to.be.sync.2\" ]}"
              ""]))

 (defn get-profiles [{profiles :profiles}]
@@ -164,4 +164,4 @@
       (and (zero? (count arguments)) interactive-mode) (execute-program ALL-PROJECTS project-desc options c/SYNC-COMMANDS u/PARENT-FOLDER)
       (not= 1 (count arguments)) (m/abort (usage summary))
       :else (execute-program (first arguments) project-desc options c/SYNC-COMMANDS u/PARENT-FOLDER))
-    (m/exit)))+    (m/exit)))


Add indexing to 'r-commit field 'tree-sha.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -925,7 +925,7 @@

 (pldb/db-rel r-branch name sha)
-(pldb/db-rel r-commit ^:index sha ctime tree-sha)
+(pldb/db-rel r-commit ^:index sha ctime ^:index tree-sha)
 (pldb/db-rel r-commit-parent ^:index sha ^:index parent-sha)
 (pldb/db-rel r-tree ^:index sha ^:index name type ^:index obj-sha)
 (pldb/db-rel r-proj ^:index blob-sha ^:index proj-name vmajor vminor vinc vqual has-snaps?)


Fix timestamp to use 24 hours instead of 12

Times would be in 12 hour format without an am/pm marker. Changed to use 24 hour format.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -70,7 +70,7 @@

 ;; === git sha-based versions ===

-(def timestamp-fmt "yyyyMMdd_hhmmss")
+(def timestamp-fmt "yyyyMMdd_HHmmss")

 (defn formatted-timestamp
   [^String fmt t]


load-xml-tree needs to know the spec-version

--- test/vip/data_processor/validation/v5_test.clj
+++ test/vip/data_processor/validation/v5_test.clj
@@ -12,6 +12,7 @@
 (deftest ^:postgres full-good-v5-test
   (let [ctx {:input (xml-input "v5_sample_feed.xml")
              :pipeline (concat [psql/start-run
+                                xml/determine-spec-version
                                 xml/load-xml-ltree]
                                v5/validations)}
         out-ctx (pipeline/run-pipeline ctx)]


in-vpc helper function

in-vpc helper function

--- src/terraboot/vpc.clj
+++ src/terraboot/vpc.clj
@@ -13,97 +13,109 @@
                            :c "172.20.10.0/24"}
                  })

+(defn add-to-every-value-map
+  [map key value]
+  (reduce-kv (fn [m k v]
+               (assoc m k (assoc v key value))) {} map))
+
+(defn in-vpc
+  [vpc-name & resources]
+  (let [vpc-id (id-of "aws_vpc" vpc-name)]
+    (apply merge-in
+           (map
+            (apply comp
+                       (map #(partial (fn [type resource] (update-in resource [:resource type] (fn [spec] (add-to-every-value-map spec :vpc_id vpc-id)))) %)
+                           ["aws_security_group"
+                            "aws_internet_gateway"
+                            "aws_subnet"
+                            "aws_route_table"]))
+                resources))))
+
 (def vpc-vpn-infra
   (merge-in
             (resource "aws_vpc" vpc-name
                       {:tags {:Name vpc-name}
                        :cidr_block "172.20.0.0/20"})

-            (aws-instance "vpn" {
-                                 :user_data (from-template "vpn-config" {:range-start "172.20.0.0"
-                                                                         :fallback-dns "172.20.0.2"})
-                                 :subnet_id (id-of "aws_subnet" "public-b")
-                                 :ami "ami-bc5b48d0"
-                                 :vpc_security_group_ids [(id-of "aws_security_group" "vpn")
-                                                          ]
-                                 :associate_public_ip_address true
-                                 })

-            (security-group "allow_outbound" {:vpc_id (id-of "aws_vpc" vpc-name)}
-                            {:type "egress"
-                             :from_port 0
-                             :to_port 0
-                             :protocol -1
-                             :cidr_blocks [all-external]
-                             })
+            (in-vpc vpc-name
+                    (aws-instance "vpn" {
+                                         :user_data (from-template "vpn-config" {:range-start "172.20.0.0"
+                                                                                :fallback-dns "172.20.0.2"})
+                                         :subnet_id (id-of "aws_subnet" "public-b")
+                                         :ami "ami-bc5b48d0"
+                                         :vpc_security_group_ids [(id-of "aws_security_group" "vpn")
+                                                                  ]
+                                         :associate_public_ip_address true
+                                         })
+                    (security-group "allow_outbound" {}
+                                    {:type "egress"
+                                     :from_port 0
+                                     :to_port 0
+                                     :protocol -1
+                                     :cidr_blocks [all-external]
+                                     })

-            (security-group "vpn" {:vpc_id (id-of "aws_vpc" vpc-name)}
-                            {:from_port 22
-                             :to_port 22
-                             :cidr_blocks [all-external]}
-                            {:from_port 1194
-                             :to_port 1194
-                             :protocol "udp"
-                             :cidr_blocks [all-external]}
-                            )
+                    (security-group "allow_external_http_https" {}
+                                    {:from_port 80
+                                     :to_port 80
+                                     :cidr_blocks [all-external]
+                                     }
+                                    {:from_port 443
+                                     :to_port 443
+                                     :cidr_blocks [all-external]})

-            (security-group "allow_external_http_https" {:vpc_id (id-of "aws_vpc" vpc-name)}
-                            {:from_port 80
-                             :to_port 80
-                             :cidr_blocks ["0.0.0.0/0"]
-                             }
-                            {:from_port 443
-                             :to_port 443
-                             :cidr_blocks ["0.0.0.0/0"]})
+                    (security-group "vpn" {}
+                                    {:from_port 22
+                                     :to_port 22
+                                     :cidr_blocks [all-external]}
+                                    {:from_port 1194
+                                     :to_port 1194
+                                     :protocol "udp"
+                                     :cidr_blocks [all-external]})

-            (resource "aws_internet_gateway" vpc-name
-                      {:vpc_id (id-of "aws_vpc" vpc-name)})
+                    (resource "aws_internet_gateway" vpc-name
+                              {})
+                    (resource "aws_route_table" "public" {:tags { :Name "public"}
+                                                          :vpc_id (id-of "aws_vpc" vpc-name)})
+                    ;; Public Subnets

-            (resource "aws_route_table" "public" {:tags { :Name "public"}
-                                                  :vpc_id (id-of "aws_vpc" vpc-name)})
+                    (resource-seq
+                     (apply concat
+                            (for [az azs]
+                              (let [subnet-name (stringify "public" "-" az)
+                                    nat-eip (stringify subnet-name "-nat")]
+                                [["aws_subnet" subnet-name {:tags {:Name subnet-name}
+                                                            :cidr_block (get-in cidr-block [:public az])
+                                                            :availability_zone (stringify region az)
+                                                            }]
+                                 ["aws_route_table_association" subnet-name {:route_table_id (id-of "aws_route_table" "public")
+                                                                             :subnet_id (id-of "aws_subnet" subnet-name)
+                                                                             }]
+                                 ["aws_nat_gateway" subnet-name {:allocation_id (id-of "aws_eip" nat-eip)
+                                                                 :subnet_id  (id-of "aws_subnet" subnet-name)}]

-            ;; Public Subnets
-            (resource-seq
-             (apply concat
-                    (for [az azs]
-                      (let [subnet-name (stringify "public" "-" az)
-                            nat-eip (stringify subnet-name "-nat")]
-                        [["aws_subnet" subnet-name {:tags {:Name subnet-name}
-                                                    :vpc_id (id-of "aws_vpc" vpc-name)
-                                                    :cidr_block (get-in cidr-block [:public az])
-                                                    :availability_zone (stringify region az)
-                                                    }]
-                         ["aws_route_table_association" subnet-name {:route_table_id (id-of "aws_route_table" "public")
-                                                                     :subnet_id (id-of "aws_subnet" subnet-name)
-                                                                     }]
-                         ["aws_nat_gateway" subnet-name {:allocation_id (id-of "aws_eip" nat-eip)
-                                                         :subnet_id  (id-of "aws_subnet" subnet-name)}]
+                                 ["aws_eip" nat-eip {:vpc true}]])
+                              )))
+                    ;; Private Subnets

-                         ["aws_eip" nat-eip {:vpc true}]])
-                      )))
+                    (resource-seq
+                     (apply concat
+                            (for [az azs]
+                              (let [subnet-name (stringify "private-" az)
+                                    public-subnet-name (stringify "public-" az)]
+                                [["aws_subnet" subnet-name {:tags {:Name subnet-name}
+                                                            :cidr_block (get-in cidr-block [:private az])
+                                                            :availability_zone (stringify region az)
+                                                            }]
+                                 ["aws_route_table" subnet-name {:tags {:Name subnet-name}
+                                                                 :route {:cidr_block "0.0.0.0/0"
+                                                                         :nat_gateway_id (id-of "aws_nat_gateway" public-subnet-name)}}

-            ;; Private Subnets
-            (resource-seq
-             (apply concat
-                    (for [az azs]
-                      (let [subnet-name (stringify "private-" az)
-                            public-subnet-name (stringify "public-" az)]
-                        [["aws_subnet" subnet-name {:tags {:Name subnet-name}
-                                                    :vpc_id (id-of "aws_vpc" vpc-name)
-                                                    :cidr_block (get-in cidr-block [:private az])
-                                                    :availability_zone (stringify region az)
-                                                    }]
-                         ["aws_route_table" subnet-name {:tags {:Name subnet-name}
-                                                         :vpc_id (id-of "aws_vpc" vpc-name)
-                                                         :route {:cidr_block "0.0.0.0/0"
-                                                                 :nat_gateway_id (id-of "aws_nat_gateway" public-subnet-name)}}
-
-                          ]
-                         ["aws_route_table_association" subnet-name {:route_table_id (id-of "aws_route_table" subnet-name)
-                                                                     :subnet_id (id-of "aws_subnet" subnet-name)
-                                                                     }]
-                         ])
-                      )))))
+                                  ]
+                                 ["aws_route_table_association" subnet-name {:route_table_id (id-of "aws_route_table" subnet-name)
+                                                                             :subnet_id (id-of "aws_subnet" subnet-name)
+                                                                             }]])))))))

 (defn -main []
   (to-file vpc-vpn-infra "vpc/vpc.tf"))


change permissions +x

change permissions +x

--- src/terraboot/vpc.clj
+++ src/terraboot/vpc.clj
@@ -72,7 +72,7 @@
                                 :permissions "644"}
                                {:path "/etc/openvpn/up.sh"
                                 :content (snippet "system-files/up.sh")
-                                :permissions "644"}]
+                                :permissions "744"}]
                  }))

 (defn vpc-vpn-infra


case is slightly clearer

case is slightly clearer

--- src/vip/data_processor/validation/xml/xpath.clj
+++ src/vip/data_processor/validation/xml/xpath.clj
@@ -66,7 +66,7 @@
 (defn paths-for-element [element version]
   (let [ancestors (ancestry element)]
     (reduce (fn [paths ancestor]
-              (condp = (.getTagName ancestor)
+              (case (.getTagName ancestor)
                 "xs:element" (conj paths (.getAttribute ancestor "name"))
                 "xs:complexType" (if-let [type-paths (seq (paths-for-type (.getAttribute ancestor "name") version))]
                                    (conj paths type-paths)


Replaced a line that was somehow accidentally deleted.

--- src/mazes_clj/core.clj
+++ src/mazes_clj/core.clj
@@ -6,6 +6,7 @@
    :coord [row column]
    :north (when (> row 0) [(dec row) column])
    :south (when (< row (dec rows)) [(inc row) column])
+   :east  (when (< column (dec columns)) [row (inc column)])
    :west  (when (> column 0) [row (dec column)])
    :links #{}})


attempt to fix test problem

attempt to fix test problem

--- test/clj_money/models/reports_test.clj
+++ test/clj_money/models/reports_test.clj
@@ -194,10 +194,10 @@

 (deftest create-an-income-statement
   (let [context (serialization/realize storage-spec income-statement-context)
-        actual (reports/income-statement storage-spec
-                                         (-> context :entities first :id)
-                                         (t/local-date 2016 1 1)
-                                         (t/local-date 2016 1 31))
+        actual (into [] (reports/income-statement storage-spec
+                                                  (-> context :entities first :id)
+                                                  (t/local-date 2016 1 1)
+                                                  (t/local-date 2016 1 31)))
         expected [{:caption "Income"
                    :value (bigdec 2003)
                    :style :header}


extract md5 functionality into a function

--- frontend/utils.cljs
+++ frontend/utils.cljs
@@ -63,11 +63,14 @@
                        (take 3 (drop 15 r)) ["-"]
                        (take 12 (drop 18 r))))))

+(defn md5 [content]
+  (let [container (goog.crypt.Md5.)]
+    (.update container content)
+    (crypt/byteArrayToHex (.digest container))))
+
 (defn email->gravatar-url [email]
   (let [email (or email "unknown-email@unknown-domain.com")
-        container (goog.crypt.Md5.)
-        _ (.update container email)
-        hash (crypt/byteArrayToHex (.digest container))]
+        hash (md5 email)]
     (str "https://secure.gravatar.com/avatar/" hash "?s=50")))

 (defn notify-error [ch message]


refactor(model.db-test): rename test for clarity

--- test/busa_server/model/db_test.clj
+++ test/busa_server/model/db_test.clj
@@ -11,7 +11,7 @@
   (db/set-test-db!)
   @db/current-db => (db/config :db-test))

-(fact "should connect to test database"
+(fact "should connect to current database"
   (db/set-test-db!)
   (db/connect)
   (instance? rethinkdb.core.Connection @db/current-db-connection) => truthy)


Minor dependency test fixed

Minor dependency test fixed

--- test/clj/hellhound/system_test.clj
+++ test/clj/hellhound/system_test.clj
@@ -67,7 +67,7 @@
         (is (:hellhound.component/started? component2)))

       (testing "Testing dependency of components"
-        (is (< (:counter component1) (:counter component2))))
+        (is (> (:counter component1) (:counter component2))))

       (testing "Workflow"
         (let [input1  (hcomp/input component1)


Fix cookie composition unit test (again?)

--- test/frereth_cp/handshake_test.clj
+++ test/frereth_cp/handshake_test.clj
@@ -7,29 +7,36 @@
   (:import io.netty.buffer.Unpooled))

 (deftest test-cookie-composition
-  (let [client-extension (byte-array (take 16 (repeat 0)))
-        server-extension (byte-array (take 16 (range)))
-        working-nonce (byte-array (take 24 (drop 40 (range))))
-        boxed (byte-array 200)
-        dst (Unpooled/buffer 400)
-        to-encode {::K/header K/cookie-header
-                   ::K/client-extension client-extension
-                   ::K/server-extension server-extension
-                   ::K/client-nonce-suffix (Unpooled/wrappedBuffer working-nonce
-                                                                   K/server-nonce-prefix-length
-                                                                   K/server-nonce-suffix-length)
-                   ;; This is also a great big FAIL:
-                   ;; Have to drop the first 16 bytes
-                   ;; Q: Have I fixed that yet?
-                   ::K/cookie (Unpooled/wrappedBuffer boxed
-                                                      K/box-zero-bytes
-                                                      144)}]
-    (try
-      ;; FIXME: This fails because we can't cast a ByteBuf to a B]
-      (let [composed (shared/compose K/cookie-frame to-encode dst)]
-        (is composed))
-      (catch clojure.lang.ExceptionInfo ex
-        (is (not (.getData ex)))))))
+  ;; The different magic numbers I'm using for the extensions and
+  ;; nonce are just so I have a way to distinguish the different bits
+  ;; when I need to look at the individual bytes
+  (let [client-extension (byte-array (take K/extension-length (repeat 0)))
+        server-extension (byte-array (take K/extension-length (range)))
+        working-nonce (byte-array (take K/nonce-length (drop 40 (range))))
+        boxed (byte-array K/cookie-packet-length)
+        dst (Unpooled/buffer (* 2 K/cookie-packet-length))
+        client-nonce-suffix-buffer (Unpooled/wrappedBuffer working-nonce
+                                                           K/server-nonce-prefix-length
+                                                           K/server-nonce-suffix-length)
+        client-nonce-suffix (byte-array K/server-nonce-suffix-length)
+        cookie-buffer (Unpooled/wrappedBuffer boxed
+                                              K/box-zero-bytes
+                                              K/cookie-frame-length)
+        cookie (byte-array K/cookie-frame-length)]
+    (.readBytes client-nonce-suffix-buffer client-nonce-suffix)
+    (let [to-encode {::K/header K/cookie-header
+                     ::K/client-extension client-extension
+                     ::K/server-extension server-extension
+                     ::K/client-nonce-suffix client-nonce-suffix
+                     ;; This is also a great big FAIL:
+                     ;; Have to drop the first 16 bytes
+                     ;; Q: Have I fixed that yet?
+                     ::K/cookie cookie}]
+      (try
+        (let [composed (shared/compose K/cookie-frame to-encode dst)]
+          (is composed))
+        (catch clojure.lang.ExceptionInfo ex
+          (is (not (.getData ex))))))))

 (deftest vouch-extraction
   ;; TODO:


Factor out byte/hex helper functions.

Factor out byte/hex helper functions.

--- src/multihash/hex.cljc
+++ src/multihash/hex.cljc
@@ -4,34 +4,32 @@
     [clojure.string :as str]))

-(defn- pad-bytes
-  "Pads a byte array with leading zeroes (or trims them) to ensure it has the
-  given length. Returns the same array if the length is already correct, or a
-  new resized array if not."
-  [width ^bytes array]
-  (let [array-length (alength array)]
-    (if (= width array-length)
-      array
-      (let [array' (byte-array width)]
-        (if (< array-length width)
-          (System/arraycopy array 0 array' (- width array-length) array-length)
-          (System/arraycopy array (- array-length width) array' 0 width))
-        array'))))
+(defn- byte->hex
+  "Converts a single byte value to a two-character hex string."
+  [value]
+  (let [hex #?(:clj (Integer/toHexString (if (neg? value) (+ 256 value) value))
+               :cljs (.toString value 16))]
+    (if (= 1 (count hex))
+      (str "0" hex)
+      hex)))
+
+
+(defn- hex->byte
+  "Converts a two-character hex string into a byte value."
+  [hex]
+  #?(:clj (let [value (Integer/parseInt hex 16)]
+            (if (< 127 value) (- value 256) value))
+     :cljs (js/parseInt hex 16)))

 (defn encode
   "Converts a byte array into a lowercase hexadecimal string. Returns nil for
   empty inputs."
   ^String
-  [^bytes value]
-  (when (and value (pos? (alength value)))
-    (->> (range (alength value))
-         (map #(let [b (aget value %)
-                     hex #?(:clj (Integer/toHexString (if (neg? b) (+ 256 b) b))
-                            :cljs (.toString b 16))]
-                 (if (= 1 (count hex))
-                   (str "0" hex)
-                   hex)))
+  [^bytes data]
+  (when (and data (pos? (alength data)))
+    (->> (range (alength data))
+         (map #(byte->hex (aget data %)))
          (str/join))))

@@ -39,13 +37,16 @@
   "Parses a hexadecimal string into a byte array. Ensures that the resulting
   array is zero-padded to match the hex string length."
   ^bytes
-  [^String value]
-  (when value
-    (if (empty? value)
-      (byte-array 0)
-      (let [length (/ (count value) 2)
-            int-bytes (.toByteArray (BigInteger. value 16))]
-        (pad-bytes length int-bytes)))))
+  [^String data]
+  (when-not (empty? data)
+    (let [length (/ (count data) 2)
+          data #?(:clj (byte-array length)
+                  :cljs (js/Uint8Array. (js/ArrayBuffer. length)))]
+      (dotimes [i length]
+        (let [hex (subs data (* 2 i) (* 2 (inc i)))
+              b (hex->byte hex)]
+          (aset data i (byte b))))
+      data)))

 (defn validate


cleanup

cleanup

--- frontend/components/language_landing.cljs
+++ frontend/components/language_landing.cljs
@@ -89,11 +89,9 @@
                  [:div.languages-body
                   [:div.languages-features
                    [:div.center-text
-                    [:h3 "FEATURES"
-                     ]
-                    ]
+                    [:h3 "FEATURES"]]
                    (map-indexed
-                     (fn [i feature] [feature (:features template)]
+                     (fn [i feature]
                        (if (odd? i)
                          [:div.feature
                           [:div.feature-image


Warn about secrets in the test and dependencies settings pages.

--- frontend/components/project_settings.cljs
+++ frontend/components/project_settings.cljs
@@ -400,7 +400,13 @@
         (html
          [:div.dependencies-page
           [:h2 "Install dependencies for " (vcs-url/project-name (:vcs_url project))]
-          [:p [:i "You can also set your dependencies commands from your " [:a {:href "/docs/configuration#dependencies"} "circle.yml"] "."]]
+          [:p
+           "You can also set your dependencies commands from your "
+           [:a {:href "/docs/configuration#dependencies"} "circle.yml"] ". "
+           "Note that anyone who can see this project on GitHub will be able to see these in your build pages. "
+           "Don't put any secrets here that you wouldn't check in! Use our "
+           [:a {:href "#env-vars"} "environment variables settings page"]
+           " instead."]
           [:div.dependencies-inner
            [:form.spec_form
             [:fieldset
@@ -442,7 +448,13 @@
         (html
          [:div.tests-page
           [:h2 "Set up tests for " (vcs-url/project-name (:vcs_url project))]
-          [:p [:i "You can also set your test commands from your " [:a {:href "/docs/configuration#test"} "circle.yml"] "."]]
+          [:p
+           "You can also set your test commands from your "
+           [:a {:href "/docs/configuration#dependencies"} "circle.yml"] ". "
+           "Note that anyone who can see this project on GitHub will be able to see these in your build pages. "
+           "Don't put any secrets here that you wouldn't check in! Use our "
+           [:a {:href "#env-vars"} "environment variables settings page"]
+           " instead."]
           [:div.tests-inner
            [:fieldset.spec_form
             [:textarea {:name "test",


✅ Test that poller/await throws an exception on timeout

Why:
- Makes the behaviour explicit instead of relying on the current
  implementation

--- test/territory_bro/poller_test.clj
+++ test/territory_bro/poller_test.clj
@@ -10,7 +10,7 @@
            (ch.qos.logback.classic.spi LoggingEvent)
            (ch.qos.logback.core.read ListAppender)
            (java.time Duration)
-           (java.util.concurrent CountDownLatch TimeUnit CyclicBarrier)
+           (java.util.concurrent CountDownLatch TimeUnit CyclicBarrier TimeoutException)
            (org.slf4j LoggerFactory)))

 ;; slow enough to be noticed as a slow test, because normally this should never be reached
@@ -138,4 +138,15 @@
       (poller/await p test-timeout)

       (is (= 1 @*task-count) "task count")
+      (poller/shutdown! p)))
+
+  (testing "await throws if the timeout is reached"
+    (let [test-finished (CountDownLatch. 1)
+          p (poller/create (fn []
+                             (.await test-finished 1 TimeUnit/SECONDS)))]
+      (poller/trigger! p)
+
+      (is (thrown? TimeoutException
+                   (poller/await p (Duration/ofMillis 0))))
+      (.countDown test-finished)
       (poller/shutdown! p))))


end of weekly interval one off

end of weekly interval one off

--- src/ontrail/weekly.clj
+++ src/ontrail/weekly.clj
@@ -44,7 +44,7 @@
   (let [midnight (time/date-time (time/year dt) (time/month dt) (time/day dt))
         dow (time/day-of-week midnight)
         week-starts (time/minus midnight (time/days (- dow 1)))
-        week-stops (time/plus midnight (time/days (- 8 dow)))]
+        week-stops (time/plus midnight (time/days (- 7 dow)))]
     (time/interval week-starts week-stops)))

 (defn interval-query [user start end]
@@ -76,7 +76,7 @@
     (let [start (.getStart week-interval) end (.getEnd week-interval)
           results (interval-query user start end)]
       {:week (week-number week-interval)
-       :from start :to (time/minus end (time/days 1))
+       :from start
        :sums (weekly-sums results)
        :exs (map simple-result results)}))


Add counters for thumbnail generation

Add counters for thumbnail generation

Add counter for thumbnail generation and thumbnail cache hits.

--- src/vignette/util/thumbnail.clj
+++ src/vignette/util/thumbnail.clj
@@ -82,7 +82,9 @@
   (assert-original-mime-type (get thumb-map :original) thumb-map)
   (if-let [thumb (and (not (q/query-opt thumb-map :replace))
                       (get-thumbnail (store system) thumb-map))]
-    thumb
+    (do
+      (perf/publish  {:thumbnail-cache-hit 1})
+      thumb)
     (when-let [thumb (generate-thumbnail system thumb-map)]
       thumb)))

@@ -95,6 +97,7 @@
     (when-let [local-original (original->local original thumb-map)]
       (try+
         (when-let [thumb (original->thumbnail local-original thumb-map)]
+          (perf/publish  {:generate-thumbail 1})
           (ls/create-stored-object thumb (fn [stored-object]
                                            (background-save-thumbnail (store system)
                                                                       stored-object


restore scroll position in update-text, and add docstring and performance note

--- src/parinfer/core.cljs
+++ src/parinfer/core.cljs
@@ -44,26 +44,33 @@
 (def global-cm nil)

 (defn update-text!
+  "Read the current value of the editor, and correct its value.
+  (rearranges closing delimiters based on indentation)"
   [cm]
   (let [current-text (.getValue cm)
         cursor (.getCursor cm)
         state {:cursor-line (.-line cursor)
                :cursor-x (.-ch cursor)}
-        formatted (format-text state current-text)]
+
+        ;; FIXME: this can be slow for large files (need to cache state at each line)
+        formatted (format-text state current-text)
+
+        scroller (.getScrollerElement cm)
+        scroll-x (.-scrollLeft scroller)
+        scroll-y (.-scrollTop scroller)]

     (reset! target-text formatted)

-    (println "current value:" (pr-str current-text))
-    (println "current target:" (pr-str @target-text))
     (when-not (= current-text @target-text)
       (.setValue cm @target-text)
+
+      ;; We have to restore the cursor and scroll position after updating the
+      ;; value of the editor. Otherwise, it will reset to the top left.
+      ;;
+      ;;   source: https://groups.google.com/forum/#!topic/codemirror/oNzsevQW1DE
+      ;;
       (.setCursor cm cursor)
-      ;; TODO: also restore scroll:
-      ;;      scrollTop and scrollLeft from cm.getScrollerElement()
-      ;;      source: https://groups.google.com/forum/#!topic/codemirror/oNzsevQW1DE
-      )
-    )
-  )
+      (.scrollTo cm scroll-x scroll-y))))

 ;; NOTE:
 ;; Text is either updated after a change in text or


remove dead code

remove dead code

Signed-off-by: Gregg Reynolds <d0f77bc71a9867acdcb4f62f012b858edad79160@norc.org>

--- standard-env/greeter/build.boot
+++ standard-env/greeter/build.boot
@@ -1,19 +1,5 @@
 (def +project+ 'tmp/greeter)
 (def +version+ "0.1.0-SNAPSHOT")
-
-;; gae does not yet support java 1.8
-;; to set java version on os x put this in ~/.bash_profile
-;; function setjdk() {
-;;   if [ $# -ne 0 ]; then
-;;    removeFromPath '/System/Library/Frameworks/JavaVM.framework/Home/bin'
-;;    if [ -n "${JAVA_HOME+x}" ]; then
-;;     removeFromPath $JAVA_HOME
-;;    fi
-;;    export JAVA_HOME=`/usr/libexec/java_home -v $@`
-;;    export PATH=$PATH:$JAVA_HOME/bin
-;;   fi
-;;  }
-;; then:  $ setjdk 1.7

 (set-env!
  :gae {:app-id "microservices-app"  ; +project+


Fixed bug with displaying dispatched TPNs

Signed-off-by: Tom Marble <b248307e886b80bf9cb4014595572a835b049bf4@info9.net>

--- src/planviz/server.clj
+++ src/planviz/server.clj
@@ -898,7 +898,7 @@
 ;; We'll define message-max to be 90% of that
 (defn new-rmq-tpn [json-str]
   (if-let [tmpdir (user-tmpdir "planviz")]
-    (let [rmq-tpn-json (str tmpdir "/rmq-tpn.json")
+    (let [rmq-tpn-json (str tmpdir "/rmq.tpn.json")
           _ (spit rmq-tpn-json json-str)
           tpn (pschema/tpn-plan {:input [rmq-tpn-json]})
           error (:error tpn)]


Add --add-meta option to the sift task to tag files in the fileset

--- boot/core/src/boot/task/built_in.clj
+++ boot/core/src/boot/task/built_in.clj
@@ -245,21 +245,30 @@

 (core/deftask sift
   "Transform the fileset, matching paths against regexes.
-
-  The --include and --exclude options specify sets of regular expressions that
-  will be used to filter the fileset.
-
-  The --move option applies a find/replace transformation on all paths in the
-  output fileset.

   The --to-asset, --to-resource, and --to-source options move matching paths
   to the corresponding section of the fileset. This can be used to make source
-  files into resource files, for example, etc."
+  files into resource files, for example, etc.
+
+  The --add-meta option adds a key to the metadata map associated with paths
+  matching the regex portion of the argument. For example:
+
+      boot sift --add-meta 'foo$':bar
+
+  merges {:bar true} into the metadata map associated with all paths that end
+  with 'foo'.
+
+  The --move option applies a find/replace transformation on all paths in the
+  output fileset.
+
+  The --include and --exclude options specify sets of regular expressions that
+  will be used to filter the fileset."

   [A add-source         bool        "Add all input files to output fileset."
    a to-asset REGEX     #{regex}    "The set of regexes of paths to move to assets."
    r to-resource REGEX  #{regex}    "The set of regexes of paths to move to resources."
    s to-source REGEX    #{regex}    "The set of regexes of paths to move to sources."
+   M add-meta REGEX:KEY {regex kw}  "The map of path regex to meta key to add."
    m move MATCH:REPLACE {regex str} "The map of regex to replacement path strings."
    i include REGEX      #{regex}    "The set of regexes that paths must match."
    x exclude REGEX      #{regex}    "The set of regexes that paths must not match."]
@@ -278,10 +287,17 @@
           to-rsc  #(if-not (match? to-resource %2) %1 (core/mv-resource %1 [%2]))
           to-ast  #(if-not (match? to-asset    %2) %1 (core/mv-asset    %1 [%2]))
           remover #(if (keep? (io/file (core/tmppath %2))) %1 (core/rm %1 [%2]))
-          addsrcs #(if-not add-source % (core/mv-resource % (core/input-files %)))]
+          addsrcs #(if-not add-source % (core/mv-resource % (core/input-files %)))
+          pathfor #(filter (partial re-find %1) (map core/tmppath (core/ls %2)))
+          addmeta #(-> (fn [meta-map re key]
+                         (-> (fn [meta-map path]
+                               (assoc-in meta-map [path key] true))
+                             (reduce meta-map (pathfor re %))))
+                       (reduce-kv {} add-meta))]
       (util/info "Sifting output files...\n")
       (-> (addsrcs fileset)
           (core/fileset-reduce core/ls remover to-src to-rsc to-ast mover)
+          (#(core/add-meta % (addmeta %)))
           core/commit!))))

 (core/deftask add-repo


Don't try to read a pom.xml if none exist

--- boot/core/src/boot/task/built_in.clj
+++ boot/core/src/boot/task/built_in.clj
@@ -614,7 +614,7 @@
                            (core/by-name ["pom.xml"])
                            (map core/tmp-file))
             {:keys [project version]}
-            (when (not (seq p))
+            (when (and pom (not (seq p)))
               (pod/with-call-worker
                 (boot.pom/pom-xml-parse-string ~(slurp pom))))
             pomname (when (and project version)


codes

codes

--- clojure-scip/src/clojure_scip/core.clj
+++ clojure-scip/src/clojure_scip/core.clj
@@ -18,4 +18,15 @@

 (count (my-fn "hello" 3 4))

-234234
+(def a 123123)
+
+(+ a 123)
+
+(defn square [x] (* x x))
+
+(square 10)
+
+(square (square 10))
+
+
+


Minor refactoring

Minor refactoring

--- src/devtools/core.cljs
+++ src/devtools/core.cljs
@@ -16,7 +16,7 @@

 (defn monitor-api-calls [name api-call]
   (fn [value]
-    (if (not *monitor-enabled*)
+    (if-not *monitor-enabled*
       (api-call value)                                      ; raw API call
       (do
         (debug/log (debug/logger name) value)
@@ -31,7 +31,7 @@
   "wraps our api-call in try-catch block to prevent leaking of exceptions if something goes wrong"
   [_ api-call]
   (fn [value]
-    (if (not *sanitizer-enabled*)
+    (if-not *sanitizer-enabled*
       (api-call value)                                      ; raw API call
       (try
         (api-call value)                                    ; wrapped API call


PLD: fix doc strings

PLD: fix doc strings

--- src/hatti/utils.cljs
+++ src/hatti/utils.cljs
@@ -13,18 +13,21 @@
   (let [last-param (-> url str (split #"/") last)]
     (-> last-param str (split #".json") first)))

-(defn json->js [s]
+(defn json->js
   "Convert json to js using JSON.parse"
+  [s]
   (.parse js/JSON s))

-(defn json->cljs [s]
+(defn json->cljs
   "Convert json string to cljs object.
    Fast, but doesn't preserve keywords."
+  [s]
    (js->clj (json->js s)))

-(defn json->js->cljs [s]
+(defn json->js->cljs
   "Convert json string to cljs via js.
    Slow method, but preserves keywords, and appropriate for small json."
+  [s]
   (js->clj (json->js s) :keywordize-keys true))

 (defn format
@@ -32,10 +35,11 @@
   [fmt & args]
   (apply goog.string/format fmt args))

-(defn safe-regex [s & {:keys [:ignore-case?]
-                       :or    {:ignore-case? true}}]
+(defn safe-regex
   "Create a safe (escaped) js regex out of a string.
    By default, creates regex with ignore case option."
+  [s & {:keys [:ignore-case?]
+        :or {:ignore-case? true}}]
   (let [s (.replace s
                     #"/[\-\[\]\/\{\}\(\)\*\+\?\.\\\^\$\|]/"
                     "\\$&")] ;; See http://stackoverflow.com/a/6969486
@@ -43,12 +47,14 @@
       (js/RegExp. s "i")
       (js/RegExp. s))))

-(defn indexed [coll]
+(defn indexed
   "Given a seq, produces a two-el seq. [a b c] => [[0 a] [1 b] [2 c]]."
+  [coll]
   (map-indexed vector coll))

-(defn click-fn [f]
+(defn click-fn
   "Helper function to create a click function that prevents default"
+  [f]
   (fn [event] (.preventDefault event) (f)))

 (defn pluralize-number


Updates to register-attr-prefix! and unmounting

--- src/freactive/dom.cljs
+++ src/freactive/dom.cljs
@@ -95,18 +95,18 @@

 (def ^:private node-ns-lookup
   #js
-  {:svg "http://www.w3.org/2000/svg"})
+  {"svg" "http://www.w3.org/2000/svg"})

 (defn register-node-prefix! [prefix xml-ns-or-handler]
-  (aset node-ns-lookup prefix xml-ns-or-handler))
+  (aset node-ns-lookup (name prefix) xml-ns-or-handler))

 (def ^:private attr-ns-lookup
   #js
-  {:node (fn [_ _ v] v)
-   :state (fn [_ _ v] v)})
+  {"node" (fn [_ _ _])
+   "state" (fn [_ _ _])})

 (defn register-attr-prefix! [prefix xml-ns-or-handler]
-  (aset attr-ns-lookup prefix xml-ns-or-handler))
+  (aset attr-ns-lookup (name prefix) xml-ns-or-handler))

 ;; Core DOM stuff

@@ -617,7 +617,7 @@

 (defn- do-unmount! [vroot]
   (let [root (.-root vroot)]
-    (when-not (= :unmounted root)
+    (when-not (keyword-identical? :unmounted root)
       (ui/velem-remove root)
       (set! (.-root vroot) :unmounted))))


connection flag for drone

connection flag for drone

--- src/sormilla/drone.clj
+++ src/sormilla/drone.clj
@@ -34,10 +34,11 @@
 (.flush log-file)

 (defn telemetry [_]
-  (let [data (comm/get-nav-data)]
+  #_(let [data (comm/get-nav-data)]
     (when @comm/foo (log data))
     data)
-  #_{:pitch 0.0
+  {:connection true
+   :pitch 0.0
    :yaw 0.0
    :roll 0.0
    :altitude 758.0


Resource notes

Resource notes

--- src/yada/resource.clj
+++ src/yada/resource.clj
@@ -60,10 +60,10 @@

   (request [_ method ctx] "Perform request. Context contains
   content-type, charset, language, content-encoding etc. in
-  the :response map. Method as keyword is in context's :method
-  entry. The returned value is interpreted according to the its type,
-  and the request method. Side-effects are permissiable. Can return a
-  deferred result.
+  the :response map. Method as keyword is in context's :method entry,
+  but is provided as a parameter for convenience only. The returned
+  value is interpreted according to the its type, and the request
+  method. Side-effects are permissiable. Can return a deferred result.

   GET: Return the state. Can be formatted to a representation of the
   given media-type and charset. Returning nil results in a 404. Get the
@@ -90,6 +90,8 @@
 (extend-protocol Resource
   clojure.lang.Fn
   (methods [_] #{:get :head})
+  ;; TODO: Many resources don't have parameters - let's put this in its
+  ;; own protocol (ResourceParameters)
   (parameters [_] nil)
   ;; We assume the resource exists, the request can force a 404 by
   ;; returning nil.


CMR-2507 Fixed some stuff in the PR, now with new and improved demo!

--- umm-lib/src/cmr/umm/start_end_date.clj
+++ umm-lib/src/cmr/umm/start_end_date.clj
@@ -38,8 +38,7 @@
   "Returns the latest end-date of the list of range date times"
   [range-date-times]
   (let [ending-dates (map #(:ending-date-time %) range-date-times)]
-    (if (some #(= nil %) ending-dates)
-      nil
+    (when-not (some #(nil? %) ending-dates)
       (->> ending-dates
       (sort t/after?)
            first))))


CMR-5356: Added spaces in tests.

CMR-5356: Added spaces in tests.

--- test/cmr/sizing/tests/unit/formats.clj
+++ test/cmr/sizing/tests/unit/formats.clj
@@ -30,11 +30,11 @@

 (deftest get-netcdf3-measurement-1-byte
   (is (= 400
-        (#'formats/get-netcdf3-measurement {:umm {:DataType "byte" :Dimensions [{:Size 10}{:Size 20}]}}))))
+        (#'formats/get-netcdf3-measurement {:umm {:DataType "byte" :Dimensions [{:Size 10} {:Size 20}]}}))))

 (deftest get-netcdf3-measurement-4-byte
   (is (= 800
-        (#'formats/get-netcdf3-measurement {:umm {:DataType "float" :Dimensions [{:Size 10}{:Size 20}]}}))))
+        (#'formats/get-netcdf3-measurement {:umm {:DataType "float" :Dimensions [{:Size 10} {:Size 20}]}}))))

 (deftest get-valid-ranges
   (is (=[{:Min -10 :Max 0} {:Min 0 :Max 10} {:Min 10 :Max 100}]


cleanup unnecessary re-calling

cleanup unnecessary re-calling

--- statspop/src/statspop/core.cljs
+++ statspop/src/statspop/core.cljs
@@ -57,8 +57,6 @@
   [chart-data chart-datom]
     (reagent/create-class
      {:component-did-mount #(show-line-chart @chart-datom)
-      :component-will-update #(show-line-chart @chart-datom)
-      :component-will-receive-props #(show-line-chart @chart-datom)
       :component-did-update #(show-line-chart @chart-datom)
       :display-name        "chart-component"
       :reagent-render      (fn []


Positive and negative tests for function get-jobs-in-queue

--- test/emender_jenkins/rest_api_test.clj
+++ test/emender_jenkins/rest_api_test.clj
@@ -779,3 +779,47 @@
                      {"queuePos" 2
                       "jobName" "test-Example_Documentation-1.0-Guide-en-US (stage)  "}])))))

+(deftest test-read-jobs-in-queue-1
+    "Check the function emender-jenkins.rest-api/read-jobs-in-queue."
+    (testing "the function emender-jenkins.rest-api/read-jobs-in-queue."
+    (with-redefs [jenkins-api/get-command (fn [url] nil)]
+        (let [request {:configuration {:jenkins {:currently-building-view "Building"
+                                                 :jenkins-url "http://10.20.30.40:8080/"}}}]
+            (is (= (read-jobs-in-queue request) nil))))))
+
+(deftest test-read-jobs-in-queue-2
+    "Check the function emender-jenkins.rest-api/read-jobs-in-queue."
+    (testing "the function emender-jenkins.rest-api/read-jobs-in-queue."
+    (with-redefs [jenkins-api/get-command (fn [url] jobs-in-queue-jenkins-response)]
+        (let [request {:configuration {:jenkins {:currently-building-view "Building"
+                                                 :jenkins-url "http://10.20.30.40:8080/"}}}]
+            (is (= (read-jobs-in-queue request)
+             [{"_class" "hudson.model.Queue$BlockedItem" "task" {"_class" "hudson.model.FreeStyleProject" "name" "test-Example_Documentation-1.0-Guide-en-US (preview)"}}
+              {"_class" "hudson.model.Queue$BlockedItem" "task" {"_class" "hudson.model.FreeStyleProject" "name" "test-Example_Documentation-1.0-Guide-en-US (stage)  "}}]
+    ))))))
+
+(deftest test-get-jobs-in-queue
+    "Check the function emender-jenkins.rest-api/get-jobs-in-queue."
+    (testing "the function emender-jenkins.rest-api/get-jobs-in-queue."
+    (with-redefs [jenkins-api/get-command (fn [all-jobs-url] jobs-in-queue-jenkins-response)
+                  send-response (fn [response request] response)]
+        (let [request {:configuration {:jenkins {:currently-building-view "Building"
+                                                 :jenkins-url "http://10.20.30.40:8080/"}}}]
+             (is (= (get-jobs-in-queue request)
+                   [{"queuePos" 1
+                     "jobName" "test-Example_Documentation-1.0-Guide-en-US (preview)"}
+                     {"queuePos" 2
+                      "jobName" "test-Example_Documentation-1.0-Guide-en-US (stage)  "}]))))))
+
+(deftest test-get-jobs-in-queue-negative
+    "Check the function emender-jenkins.rest-api/get-jobs-in-queue."
+    (testing "the function emender-jenkins.rest-api/get-jobs-in-queue."
+    (with-redefs [jenkins-api/get-command (fn [all-jobs-url] nil)
+                  send-error-response (fn [response request http-code] response)]
+        (let [request {:configuration {:jenkins {:currently-building-view "Building"
+                                                 :jenkins-url "http://10.20.30.40:8080/"}}}]
+             (is (= (get-jobs-in-queue request)
+                    {:status  "error"
+                     :command "jobs_in_queue"
+                     :message "Can not read Jenkins queue"}))))))
+