Permalink
Browse files

Merge branch 'release/1.3.1'

  • Loading branch information...
amalloy committed Sep 20, 2011
2 parents 6fd1c7e + 29ade2a commit 54b2859729ae1f75ed9bf2301a011bc957446db4
View
@@ -9,6 +9,7 @@
:pass ""
:repo-url "https://github.com/4clojure/4clojure"
:golfing-active true
+ :heartbeat nil ; set to, eg, [1 :hour] for periodic heap information on stdout
;; this list is just for bootstrapping - the real DB is authoritative
:contributors ["amalloy" "dbyrne" "raynes" "cmeier" "devn" "0x89"
"citizen428" "daviddavis" "clinteger" "amcnamara"]}
View
@@ -1,4 +1,4 @@
-(defproject foreclojure "1.3.0.1"
+(defproject foreclojure "1.3.1"
:description "4clojure - a website for lisp beginners"
:dependencies [[clojure "1.2.1"]
[clojure-contrib "1.2.0"]
@@ -52,7 +52,7 @@ function configureDataTables(){
} );
$('#user-table').dataTable( {
- "iDisplayLength":25,
+ "iDisplayLength":100,
"aaSorting": [[ 0, "asc" ]],
"aoColumns": [
null,
View
@@ -16,6 +16,7 @@
[foreclojure.graphs :only [graph-routes]]
[foreclojure.mongo :only [prepare-mongo]]
[foreclojure.utils :only [wrap-uri-binding]]
+ [foreclojure.periodic :only [schedule-task]]
[ring.adapter.jetty :only [run-jetty]]
[ring.middleware.reload :only [wrap-reload]]
[ring.middleware.stacktrace :only [wrap-stacktrace]]
@@ -51,8 +52,21 @@
wrap-strip-trailing-slash
wrap-gzip))
+(defn register-heartbeat []
+ (when-let [period (:heartbeat config)]
+ (apply schedule-task
+ (let [^java.io.PrintWriter out *out*
+ ^Runtime r (Runtime/getRuntime)]
+ (fn []
+ (.println out (format "%d/%d/%d MB free/total/max"
+ (int (/ (. r (freeMemory)) 1e6))
+ (int (/ (. r (totalMemory)) 1e6))
+ (int (/ (. r (maxMemory)) 1e6))))))
+ period)))
+
(defn run []
(prepare-mongo)
+ (register-heartbeat)
(run-jetty (var app) {:join? *block-server* :port 8080}))
(defn -main [& args]
View
@@ -5,8 +5,7 @@
(:import [java.io ByteArrayInputStream
ByteArrayOutputStream])
(:use [compojure.core :only [defroutes GET]]
- [foreclojure.utils :only [from-mongo]]
- [somnium.congomongo :only [fetch-one]]
+ [foreclojure.problems :only [solved-stats]]
[useful.utils :only [with-adjustments]]))
(defn un-group
@@ -18,13 +17,9 @@
(repeat count x))))
(defn fetch-score-frequencies [problem-id]
- (into {}
- (for [[k v] (:scores
- (from-mongo
- (fetch-one :problems
- :where {:_id problem-id}
- :only [:scores])))]
- [(Integer/parseInt (name k)), v])))
+ (-> @solved-stats
+ (get problem-id)
+ (dissoc nil)))
(defn make-problem-plot [id best curr]
(let [freqs (fetch-score-frequencies id)
View
@@ -2,7 +2,7 @@
(:use somnium.congomongo
[foreclojure.data-set :only [load-problems]]
[foreclojure.config :only [config]]
- [foreclojure.problems :only [total-solved get-problem-list]]
+ [foreclojure.problems :only [number-from-mongo-key solved-stats get-problem-list]]
[foreclojure.users :only [get-users]]))
(defn connect-to-db []
@@ -43,16 +43,18 @@
(defn reconcile-solved-count
"Overwrites the times-solved field in the problems collection based on data from the users collection. Should only be called on server startup since it isn't a safe operation. Also updates the total-solved agent."
[]
- (let [total (->> (get-users)
- (mapcat :solved)
- (frequencies)
- (reduce (fn [sum [id solved]]
- (update! :problems
- {:_id id}
- {:$set {:times-solved solved}})
- (+ sum solved))
- 0))]
- (send total-solved (constantly total))))
+ (let [+ (fnil + 0)
+ [total scores]
+ (->> (fetch :users :only [:scores])
+ (mapcat :scores)
+ (frequencies)
+ (reduce (fn [[total scores] [[id score] times]]
+ [(+ total times)
+ (update-in scores
+ [(number-from-mongo-key id) score]
+ + times)])
+ [0 {}]))]
+ (send solved-stats (constantly (assoc scores :total total)))))
(defn prepare-mongo []
(connect-to-db)
@@ -0,0 +1,25 @@
+(ns foreclojure.periodic
+ (:import (java.util.concurrent ScheduledThreadPoolExecutor
+ ScheduledExecutorService
+ TimeUnit)))
+
+;; Stolen from clojail, but I wrote it myself anyway.
+;; I guess it deserves a library of its own? Or maybe in useful?
+(def uglify-time-unit
+ (into {} (for [[enum aliases] {TimeUnit/NANOSECONDS [:ns :nanoseconds]
+ TimeUnit/MICROSECONDS [:us :microseconds]
+ TimeUnit/MILLISECONDS [:ms :milliseconds]
+ TimeUnit/SECONDS [:s :sec :seconds]
+ TimeUnit/MINUTES [:m :min :minutes]
+ TimeUnit/HOURS [:h :hours]
+ TimeUnit/DAYS [:d :days]}
+ alias aliases]
+ {alias enum})))
+
+(def ^ScheduledExecutorService pool
+ (memoize (fn []
+ (ScheduledThreadPoolExecutor. 2))))
+
+(defn schedule-task [task period unit]
+ (.scheduleAtFixedRate (pool) task 0
+ period (uglify-time-unit unit)))
@@ -4,7 +4,7 @@
[clojure.string :as s]
[ring.util.response :as response])
(:import [org.apache.commons.mail EmailException])
- (:use [foreclojure.utils :only [from-mongo get-user get-solved login-link *url* flash-msg flash-error def-page row-class approver? can-submit? send-email image-builder with-user]]
+ (:use [foreclojure.utils :only [from-mongo get-user get-solved login-link *url* flash-msg flash-error def-page row-class approver? can-submit? send-email image-builder with-user as-int maybe-update]]
[foreclojure.social :only [tweet-link gist!]]
[foreclojure.feeds :only [create-feed]]
[foreclojure.users :only [golfer? get-user-id disable-codebox?]]
@@ -20,7 +20,7 @@
[compojure.core :only [defroutes GET POST]]
[clojure.contrib.json :only [json-str]]))
-(def total-solved (agent 0))
+(def solved-stats (agent {:total 0}))
(defn get-problem [x]
(from-mongo
@@ -31,7 +31,7 @@
([criteria]
(from-mongo
(fetch :problems
- :only [:_id :title :difficulty :tags :times-solved :user]
+ :only [:_id :title :difficulty :tags :user]
:where criteria
:sort {:_id 1}))))
@@ -80,6 +80,11 @@
[id]
(keyword (str (int id))))
+(defn number-from-mongo-key
+ "Turn a keyword like :4 into an integer"
+ [k]
+ (Integer. (name k)))
+
(defn trim-code [code]
(when code (.trim code)))
@@ -89,44 +94,39 @@
code)))
(defn record-golf-score! [user-id problem-id score]
- (let [user-score-key (keyword (str "scores." problem-id))
- problem-score-key (keyword (str "scores." score))
- [problem-scores-key user-subkey] (map mongo-key-from-number
- [score problem-id])]
- (when-let [{:keys [_id scores] :as user}
- (from-mongo
- (fetch-one :users
- :where {:_id user-id}))]
- (let [old-score-real (get scores user-subkey)
- old-score-test (or old-score-real 1e6)
- old-score-key (keyword (str "scores." old-score-real))]
- (when (golfer? user)
- (session/session-put! :golf-chart
- {:id problem-id
- :score score
- :best old-score-real}))
- (when (< score old-score-test)
- (update! :problems
- {:_id problem-id,
- old-score-key {:$gt 0}}
- {:$inc {old-score-key -1}})
- (update! :problems
- {:_id problem-id}
- {:$inc {problem-score-key 1}})
- (update! :users
- {:_id _id}
- {:$set {user-score-key score}}))))))
+ (when-let [{user-id :_id {old-score (keyword problem-id)} :scores :as user}
+ (from-mongo
+ (fetch-one :users
+ :where {:_id user-id}))]
+ (when (golfer? user)
+ (session/session-put! :golf-chart
+ {:id problem-id
+ :score score
+ :best old-score}))
+ (when (or (not old-score)
+ (> old-score score))
+ (update! :users
+ {:_id user-id}
+ {:$set {(keyword (str "scores." problem-id)) score}})
+ (send solved-stats (fn [scores]
+ (let [inc (fnil inc 0),
+ dec (fn [x]
+ (when (and x (> x 1))
+ (dec x)))]
+ (maybe-update scores [problem-id]
+ #(-> %
+ (maybe-update [score] inc)
+ (maybe-update [old-score] dec)))))))))
(defn store-completed-state! [username problem-id code]
(let [{user-id :_id} (fetch-one :users
:where {:user username}
:only [:_id])
current-time (java.util.Date.)]
(when (not-any? #{problem-id} (get-solved username))
- (update! :users {:_id user-id} {:$addToSet {:solved problem-id}})
- (update! :problems {:_id problem-id} {:$inc {:times-solved 1}})
- (update! :users {:_id problem-id} {:$set {:last-solved-date current-time}})
- (send total-solved inc))
+ (update! :users {:_id user-id} {:$addToSet {:solved problem-id}
+ :$set {:last-solved-date current-time}})
+ (send solved-stats update-in [:total] inc))
(record-golf-score! user-id problem-id (code-length code))
(save-solution user-id problem-id code)))
@@ -270,7 +270,7 @@ Return a map, {:message, :error, :url, :num-tests-passed}."
(if session-user
(with-user [{:keys [solved]}]
(if (some #{(Integer. id)} solved)
- (link-to (str "/problem/solutions/" id)
+ (link-to (str "/problem/solutions/" id)
[:button#solutions-link {:type "submit"} "Solutions"])
[:div {:style "clear: right; margin-bottom: 15px;"} "&nbsp;"]))
[:div {:style "clear: right; margin-bottom: 15px;"} "&nbsp;"])
@@ -318,7 +318,7 @@ Return a map, {:message, :error, :url, :num-tests-passed}."
[:button.large {:id "approve-button"} "Approve"]]))]}))
(defn problem-page [id]
- (if (or (:approved (get-problem (Integer. id)))
+ (if (or (:approved (get-problem id))
(approver? (session/session-get :user)))
(code-box id)
(flash-error "You cannot access this page" "/problems")))
@@ -347,7 +347,7 @@ Return a map, {:message, :error, :url, :num-tests-passed}."
[:div.follower-username (str f-user "'s solution:")]
[:pre.follower-code f-code]]))
[:p "None of the users you follow have solved this problem yet!"]))))})
-
+
(defn show-solutions [id]
(let [problem-id (Integer. id)
user (session/session-get :user)]
@@ -381,7 +381,7 @@ Return a map, {:message, :error, :url, :num-tests-passed}."
(let [solved (get-solved (session/session-get :user))
problems (get-problem-list)]
(map-indexed
- (fn [x {:keys [title difficulty times-solved tags user], id :_id}]
+ (fn [x {:keys [title difficulty tags user], id :_id}]
[:tr (row-class x)
[:td.titlelink
[:a {:href (str "/problem/" id)}
@@ -391,7 +391,7 @@ Return a map, {:message, :error, :url, :num-tests-passed}."
(s/join " " (map #(str "<span class='tag'>" % "</span>")
tags))]
[:td.centered user]
- [:td.centered (int times-solved)]
+ [:td.centered (reduce + (vals (get @solved-stats id)))]
[:td.centered (checkbox-img (contains? solved id))]])
problems))])}))
@@ -488,16 +488,15 @@ Return a map, {:message, :error, :url, :num-tests-passed}."
(update! :problems
{:_id id}
- {:_id id
- :title title
- :difficulty difficulty
- :times-solved (or (:times-solved existing-problem) 0)
- :description description
- :tags (re-seq #"\S+" tags)
- :restricted (re-seq #"\S+" restricted)
- :tests (s/split code #"\r\n\r\n")
- :user (if (empty? author) user author)
- :approved approved})
+ {:$set
+ {:title title
+ :difficulty difficulty
+ :description description
+ :tags (re-seq #"\S+" tags)
+ :restricted (re-seq #"\S+" restricted)
+ :tests (s/split code #"\r\n\r\n")
+ :user (if (empty? author) user author)
+ :approved approved}})
(flash-msg "Thank you for submitting a problem! Be sure to check back to see it posted." "/problems"))
(flash-error "You are not authorized to submit a problem." "/problems"))))
@@ -551,7 +550,11 @@ Return a map, {:message, :error, :url, :num-tests-passed}."
(defroutes problems-routes
(GET "/problems" [] (problem-list-page))
- (GET "/problem/:id" [id] (problem-page id))
+ (GET "/problem/:id" [id]
+ (if-let [id-int (as-int id)]
+ (problem-page id-int)
+ (flash-error (format "'%s' is not a valid problem number." id)
+ "/problems")))
(GET "/problems/submit" [] (problem-submission-page))
(POST "/problems/submit" [prob-id author title difficulty tags restricted description code]
(create-problem title difficulty tags restricted description code (when (not= "" prob-id) (Integer. prob-id)) author))
@@ -1,6 +1,6 @@
(ns foreclojure.static
(:use [compojure.core :only [defroutes GET]]
- [foreclojure.problems :only [total-solved]]
+ [foreclojure.problems :only [solved-stats]]
[foreclojure.config :only [repo-url]]
[foreclojure.utils :only [def-page]]))
@@ -17,7 +17,7 @@
:content
[:div#welcome
[:div#totalcount
- (.format df (deref total-solved)) " problems solved and counting!"]
+ (.format df (:total @solved-stats)) " problems solved and counting!"]
[:div
[:h3 "What is 4Clojure?"]
[:p "4Clojure is a resource to help fledgling clojurians learn the language through interactive problems. The first few problems are easy enough that even someone with no prior experience should find the learning curve forgiving. See 'Help' for more information."]]
Oops, something went wrong.

0 comments on commit 54b2859

Please sign in to comment.