(ns desdemona.query-test
  (:require
   [desdemona.query :as q]
   [clojure.test :refer [deftest is are testing]]))

(deftest infix-parser-tests
  (is (= [:expr [:ipv4-address "10" "0" "0" "1"]]
         (#'q/infix-parser "10.0.0.1"))
      "ipv4 addresses")
  (is (= [:expr [:fn-call
                 [:identifier "ip"]
                 [:identifier "x"]]]
         (#'q/infix-parser "ip(x)"))
      "simple fn calls")
  (is (= [:expr [:eq
                 [:identifier "a"]
                 [:identifier "b"]]]
         (#'q/infix-parser "a = b"))
      "equality between identifiers")
  (is (= [:expr [:eq
                 [:fn-call
                  [:identifier "ip"]
                  [:identifier "x"]]
                 [:ipv4-address "10" "0" "0" "1"]]]
         (#'q/infix-parser "ip(x) = 10.0.0.1"))
      "equality between fn call and IP address literal"))

(deftest infix->dsl-tests
  (is (= '(= (:ip x) "10.0.0.1")
         (q/infix->dsl "ip(x) = 10.0.0.1"))))

(deftest free-sym-tests
  (is (not (#'q/free-sym? 's))
      "sym not marked as free")
  (is (not (#'q/free-sym? 1))
      "not a symbol")
  (is (#'q/free-sym? (#'q/free-sym 's))
      "sym explicitly marked as free"))

(deftest find-free-vars-tests
  (are [expected query] (= expected (#'q/find-free-vars query))
    #{}
    '()

    #{'x}
    (#'q/dsl->logic '(= (:ip x) "10.0.0.1"))

    #{'x}
    (#'q/dsl->logic '(= "10.0.0.1" (:ip x)))

    #{'x}
    (#'q/dsl->logic '(= (:type x) "egress"))

    #{'x}
    (#'q/dsl->logic '(and (= (:ip x) "10.0.0.1")
                          (= (:type x) "egress")))))

(deftest dsl->logic-tests
  (is (thrown? IllegalArgumentException
               (#'q/dsl->logic '(BOGUS BOGUS BOGUS))))
  (is (= '(clojure.core.logic/featurec x {:ip "10.0.0.1"})
         (#'q/dsl->logic '(= (:ip x) "10.0.0.1"))
         (#'q/dsl->logic '(= "10.0.0.1" (:ip x)))))
  (testing "logic variable is not hard coded to 'x"
    (is (= '(clojure.core.logic/featurec y {:ip "10.0.0.1"})
           (#'q/dsl->logic '(= (:ip y) "10.0.0.1"))
           (#'q/dsl->logic '(= "10.0.0.1" (:ip y))))))
  (testing "logical conjunction"
    (is (= '(clojure.core.logic/conde
             [(clojure.core.logic/featurec x {:ip "10.0.0.1"})
              (clojure.core.logic/featurec x {:type "egress"})])
           (#'q/dsl->logic '(and (= (:ip x) "10.0.0.1")
                                 (= (:type x) "egress"))))))
  (testing "logical disjunction"
    (is (= '(clojure.core.logic/conde
             [(clojure.core.logic/featurec x {:ip "10.0.0.1"})]
             [(clojure.core.logic/featurec x {:type "egress"})])
           (#'q/dsl->logic '(or (= (:ip x) "10.0.0.1")
                                (= (:type x) "egress")))))
    (is (= '(clojure.core.logic/conde
             [(clojure.core.logic/featurec x {:type "egress"})]
             [(clojure.core.logic/featurec x {:ip "10.0.0.1"})])
           (#'q/dsl->logic '(or (= (:type x) "egress")
                                (= (:ip x) "10.0.0.1")))))))

(def events
  [{:ip "10.0.0.1"}
   {:ip "10.0.0.2"
    :type "egress"}
   {:ip "10.0.0.2"
    :type "ingress"}])

(deftest run-dsl-query-tests
  (are [query results] (= results (q/run-dsl-query query events))
    '(= (:ip x) "10.0.0.1")
    [[{:ip "10.0.0.1"}]]

    '(= (:ip x) "BOGUS")
    []

    '(= "10.0.0.1" (:ip x))
    [[{:ip "10.0.0.1"}]]

    '(= "BOGUS" (:ip x))
    [])
  (testing "explicit maximum number of results"
    (let [results [[{:ip "10.0.0.1"}]]
          query '(= (:ip x) "10.0.0.1")]
      (are [n-results] (= results (q/run-dsl-query n-results query events))
        1
        10)))
  (testing "conjunction"
    (are [query results] (= results (q/run-dsl-query query events))
      '(and (= (:ip x) "10.0.0.1")
            (= (:type x) "egress"))
      []

      '(and (= (:ip x) "10.0.0.2")
            (= (:type x) "egress"))
      [[{:ip "10.0.0.2"
         :type "egress"}]]

      '(and (= (:type x) "egress")
            (= (:ip x) "10.0.0.2"))
      [[{:ip "10.0.0.2"
         :type "egress"}]]))
  (testing "disjunction"
    (are [query results] (= results (q/run-dsl-query 10 query events))
      '(or (= (:ip x) "1.2.3.4")
           (= (:type x) "bogus"))
      []

      '(or (= (:ip x) "10.0.0.1")
           (= (:type x) "egress"))
      [[{:ip "10.0.0.1"}]
       [{:ip "10.0.0.2"
         :type "egress"}]]

      '(or (= (:ip x) "10.0.0.1")
           (= (:type x) "ingress"))
      [[{:ip "10.0.0.1"}]
       [{:ip "10.0.0.2"
         :type "ingress"}]]

      '(or (= (:ip x) "10.0.0.2")
           (= (:type x) "egress"))
      [[{:ip "10.0.0.2"    ;; ip clause succeeded
         :type "egress"}]
       [{:ip "10.0.0.2"    ;; type clause succeeded
         :type "egress"}]
       [{:ip "10.0.0.2"    ;; ip clause succeeded
         :type "ingress"}]]

      '(or (= (:type x) "egress")
           (= (:ip x) "10.0.0.2"))
      [[{:ip "10.0.0.2"    ;; type clause succeeded
         :type "egress"}]
       [{:ip "10.0.0.2"    ;; ip clause succeeded
         :type "egress"}]
       [{:ip "10.0.0.2"    ;; ip clause succeeded
         :type "ingress"}]])))

(deftest run-logic-query-tests
  (are [query results] (= results (#'q/run-logic-query query events))
    'l/fail
    []

    (list clojure.core.logic/featurec
          (#'q/free-sym 'x)
          {:ip "10.0.0.1"})
    [[{:ip "10.0.0.1"}]])
  (testing "explicit maximum number of results"
    (let [results [[{:ip "10.0.0.1"}]]
          query (list clojure.core.logic/featurec
                      (#'q/free-sym 'x)
                      {:ip "10.0.0.1"})]
      (are [n-results] (= results (#'q/run-logic-query n-results query events))
        1
        10))))

(ns desdemona.query-test
  (:require
   [desdemona.query :as q]
   [clojure.test :refer [deftest is are testing]]))

(deftest infix-parser-tests
  (is (= [:expr [:ipv4-address "10" "0" "0" "1"]]
         (#'q/infix-parser "10.0.0.1"))
      "ipv4 addresses")
  (is (= [:expr [:fn-call
                 [:identifier "ip"]
                 [:identifier "x"]]]
         (#'q/infix-parser "ip(x)"))
      "simple fn calls")
  (is (= [:expr [:eq
                 [:identifier "a"]
                 [:identifier "b"]]]
         (#'q/infix-parser "a = b"))
      "equality between identifiers")
  (is (= [:expr [:eq
                 [:fn-call
                  [:identifier "ip"]
                  [:identifier "x"]]
                 [:ipv4-address "10" "0" "0" "1"]]]
         (#'q/infix-parser "ip(x) = 10.0.0.1"))
      "equality between fn call and IP address literal"))

(deftest infix->dsl-tests
  (is (= '(= (:ip x) "10.0.0.1")
         (q/infix->dsl "ip(x) = 10.0.0.1"))))

(deftest free-sym-tests
  (is (not (#'q/free-sym? 's))
      "sym not marked as free")
  (is (not (#'q/free-sym? 1))
      "not a symbol")
  (is (#'q/free-sym? (#'q/free-sym 's))
      "sym explicitly marked as free"))

(deftest find-free-vars-tests
  (are [expected query] (= expected (#'q/find-free-vars query))
    #{}
    '()

    #{'x}
    (#'q/dsl->logic '(= (:ip x) "10.0.0.1"))

    #{'x}
    (#'q/dsl->logic '(= "10.0.0.1" (:ip x)))

    #{'x}
    (#'q/dsl->logic '(= (:type x) "egress"))

    #{'x}
    (#'q/dsl->logic '(and (= (:ip x) "10.0.0.1")
                          (= (:type x) "egress")))))

(deftest dsl->logic-tests
  (is (thrown? IllegalArgumentException
               (#'q/dsl->logic '(BOGUS BOGUS BOGUS))))
  (is (= '(clojure.core.logic/featurec x {:ip "10.0.0.1"})
         (#'q/dsl->logic '(= (:ip x) "10.0.0.1"))
         (#'q/dsl->logic '(= "10.0.0.1" (:ip x)))))
  (testing "logic variable is not hard coded to 'x"
    (is (= '(clojure.core.logic/featurec y {:ip "10.0.0.1"})
           (#'q/dsl->logic '(= (:ip y) "10.0.0.1"))
           (#'q/dsl->logic '(= "10.0.0.1" (:ip y))))))
  (testing "logical conjunction"
    (is (= '(clojure.core.logic/conde
             [(clojure.core.logic/featurec x {:ip "10.0.0.1"})
              (clojure.core.logic/featurec x {:type "egress"})])
           (#'q/dsl->logic '(and (= (:ip x) "10.0.0.1")
                                 (= (:type x) "egress"))))))
  (testing "logical disjunction"
    (is (= '(clojure.core.logic/conde
             [(clojure.core.logic/featurec x {:ip "10.0.0.1"})]
             [(clojure.core.logic/featurec x {:type "egress"})])
           (#'q/dsl->logic '(or (= (:ip x) "10.0.0.1")
                                (= (:type x) "egress")))))
    (is (= '(clojure.core.logic/conde
             [(clojure.core.logic/featurec x {:type "egress"})]
             [(clojure.core.logic/featurec x {:ip "10.0.0.1"})])
           (#'q/dsl->logic '(or (= (:type x) "egress")
                                (= (:ip x) "10.0.0.1")))))))

(def events
  [{:ip "10.0.0.1"}
   {:ip "10.0.0.2"
    :type "egress"}
   {:ip "10.0.0.2"
    :type "ingress"}])

(deftest run-dsl-query-tests
  (are [query results] (= results (q/run-dsl-query query events))
    '(= (:ip x) "10.0.0.1")
    [[{:ip "10.0.0.1"}]]

    '(= (:ip y) "10.0.0.1")
    [[{:ip "10.0.0.1"}]]

    '(= (:ip x) "BOGUS")
    []

    '(= "10.0.0.1" (:ip x))
    [[{:ip "10.0.0.1"}]]

    '(= "BOGUS" (:ip x))
    [])
  (testing "explicit maximum number of results"
    (let [results [[{:ip "10.0.0.1"}]]
          query '(= (:ip x) "10.0.0.1")]
      (are [n-results] (= results (q/run-dsl-query n-results query events))
        1
        10)))
  (testing "conjunction"
    (are [query results] (= results (q/run-dsl-query query events))
      '(and (= (:ip x) "10.0.0.1")
            (= (:type x) "egress"))
      []

      '(and (= (:ip x) "10.0.0.2")
            (= (:type x) "egress"))
      [[{:ip "10.0.0.2"
         :type "egress"}]]

      '(and (= (:type x) "egress")
            (= (:ip x) "10.0.0.2"))
      [[{:ip "10.0.0.2"
         :type "egress"}]]))
  (testing "disjunction"
    (are [query results] (= results (q/run-dsl-query 10 query events))
      '(or (= (:ip x) "1.2.3.4")
           (= (:type x) "bogus"))
      []

      '(or (= (:ip x) "10.0.0.1")
           (= (:type x) "egress"))
      [[{:ip "10.0.0.1"}]
       [{:ip "10.0.0.2"
         :type "egress"}]]

      '(or (= (:ip x) "10.0.0.1")
           (= (:type x) "ingress"))
      [[{:ip "10.0.0.1"}]
       [{:ip "10.0.0.2"
         :type "ingress"}]]

      '(or (= (:ip x) "10.0.0.2")
           (= (:type x) "egress"))
      [[{:ip "10.0.0.2"    ;; ip clause succeeded
         :type "egress"}]
       [{:ip "10.0.0.2"    ;; type clause succeeded
         :type "egress"}]
       [{:ip "10.0.0.2"    ;; ip clause succeeded
         :type "ingress"}]]

      '(or (= (:type x) "egress")
           (= (:ip x) "10.0.0.2"))
      [[{:ip "10.0.0.2"    ;; type clause succeeded
         :type "egress"}]
       [{:ip "10.0.0.2"    ;; ip clause succeeded
         :type "egress"}]
       [{:ip "10.0.0.2"    ;; ip clause succeeded
         :type "ingress"}]])))

(deftest run-logic-query-tests
  (are [query results] (= results (#'q/run-logic-query query events))
    'l/fail
    []

    (list clojure.core.logic/featurec
          (#'q/free-sym 'x)
          {:ip "10.0.0.1"})
    [[{:ip "10.0.0.1"}]])
  (testing "explicit maximum number of results"
    (let [results [[{:ip "10.0.0.1"}]]
          query (list clojure.core.logic/featurec
                      (#'q/free-sym 'x)
                      {:ip "10.0.0.1"})]
      (are [n-results] (= results (#'q/run-logic-query n-results query events))
        1
        10))))

Test run-dsl-query not assuming hardcoded 'x


(ns mdr2.repair
  "Functions to handle repairing of a production

  This mostly entails functionality to fetch a production from the archive.

  A production is stored in the archive as a tar file. There is a HTTP
  API to the archive which is used to fetch productions. The tar file
  is then unpacked in a tmp dir inside the structured path (as there
  is not enough space in the /tmp dir). From this temporary location
  all the relevant files are copied to the structured path and the
  production is set to state \"structured\". After that the repair
  takes its course down the same route as a normal production."
  (:require [clojure.java.io :as io]
            [clojure.tools.logging :as log]
            [immutant.caching :as caching]
            [immutant.transactions :refer [transaction]]
            [immutant.transactions.jdbc :refer [factory]]
            [yesql.core :refer [defqueries]]
            [me.raynes.fs.compression :as compress]
            [org.tobereplaced.nio.file :as nio]
            [environ.core :refer [env]]
            [clj-http.client :as client]
            [mdr2.obi :as obi]
            [mdr2.production :as prod]
            [mdr2.production.path :as path]
            [mdr2.util :as util]))

(def ^:private db {:factory factory :name "java:jboss/datasources/archive"})
(def ^:private archive-web-root (env :archive-web-root))
(def ^:private archive-web-user (env :archive-web-user))
(def ^:private archive-web-password (env :archive-web-password))

(defqueries "mdr2/archive/queries.sql" {:connection db})

(def ^:private repairing-cache (caching/cache "repairing-cache" :ttl [15 :minutes]))

(defn production-id?
  "Return true if `id` is a valid production id"
  [id]
  (re-matches #"(?i)dam\d{1,5}" id))

(defn product-number?
  "Return true if `id` is a valid product number"
  [id]
  (re-matches #"DY\d{5}" id))

(defn archive-identifier?
  "Return true if `id` is either a valid production id, i.e. a dam
  number or a valid library signature"
  [id]
  (or (production-id? id) (prod/library-signature? id)))

(defn archive-url
  "Return the url for an archived production given a `container-id`"
  [container-id]
  (format "%s/0%s/%s/a0%s.tar" archive-web-root
          (.substring container-id 0 1)
          (.substring container-id 1 3)
          container-id))

(defn container-id
  "Return a container-id given a `production` and optionally `sektion`
  which can be either `:master` or `:dist-master`"
  ([production]
   (container-id production :master))
  ([production sektion]
   (let [id (case sektion
              :master (prod/dam-number production)
              :dist-master (:library_signature production))]
     (-> {:id id} production-id-to-archive-id first :id str))))

(defn repair
  "Get a production from the archive and prepare it for repairing"
  [{id :id :as production}]
  (let [repairing-in-progress? (.putIfAbsent repairing-cache id true)
        dest-path (path/structured-path production)
        ;; create the tmp dir in the structured-path as there is not
        ;; enough space on the normal tmp dir path
        tmp-dir (nio/resolve-sibling dest-path (str id "_repair"))]
    (cond
      repairing-in-progress?
      (let [error-msg (format "Repair for %s already pending" id)]
        (log/warn error-msg)
        [error-msg])
      (not= (:state production) "archived")
      (let [error-msg "Production is not in state \"archived\""]
        (log/error error-msg)
        [error-msg])
      ;; checking for the state is not enough: there is a race
      ;; condition as the state is only set after all the files have
      ;; been copied. This takes time. So we also check for the
      ;; existence of some important directories
      (nio/exists? dest-path)
      (let [error-msg (format "Directory %s already exists" dest-path)]
        (log/error error-msg)
        [error-msg])
      (nio/exists? tmp-dir)
      (let [error-msg (format "Directory %s already exists" tmp-dir)]
        (log/error error-msg)
        [error-msg])
      :else
      (let [container-id (container-id production)
            url (archive-url container-id)
            response (client/get url
                                 {:as :stream
                                  :basic-auth [archive-web-user archive-web-password]})]
        (log/infof "Repairing %s" id)
        (if (client/success? response)
          (let [dam-number (prod/dam-number production)
                tar-file (io/file tmp-dir (str dam-number ".tar"))
                tar-dir (io/file tmp-dir dam-number)]
            (transaction
             ;; create all dirs for this production
             (prod/create-dirs production)
             ;; copy tar to tmpdir
             (nio/create-directory! tmp-dir)
             (with-open [input (:body response)]
               (nio/copy! input tar-file))
             ;; extract the tar
             (compress/untar tar-file tar-dir)
             ;; extract the relevant parts to the structured-path
             (let [src-path (io/file tar-dir dam-number "produkt" dam-number)]
               (doseq [f (filter #(.isFile %) (file-seq src-path))]
                 (nio/move! f (io/file dest-path (nio/file-name f)))))
             ;; clear the temporary files
             (util/delete-directory! tmp-dir)
             ;; create the obi config file
             (obi/config-file production)
             ;; set the state
             (let [updated (prod/set-state! production "structured")]
               ;; clear repairing-cache
               (.remove repairing-cache id)
               updated)
             (prod/set-state! production "structured")))
          (let [error-msg (format "Couldn't get %s from archive (%s)" id url)]
            ;; close the stream
            (.close (:body response))
            (log/error error-msg)
            (.remove repairing-cache id)
            [error-msg]))))))

(ns mdr2.repair
  "Functions to handle repairing of a production

  This mostly entails functionality to fetch a production from the archive.

  A production is stored in the archive as a tar file. There is a HTTP
  API to the archive which is used to fetch productions. The tar file
  is then unpacked in a tmp dir inside the structured path (as there
  is not enough space in the /tmp dir). From this temporary location
  all the relevant files are copied to the structured path and the
  production is set to state \"structured\". After that the repair
  takes its course down the same route as a normal production."
  (:require [clojure.java.io :as io]
            [clojure.tools.logging :as log]
            [immutant.caching :as caching]
            [immutant.transactions :refer [transaction]]
            [immutant.transactions.jdbc :refer [factory]]
            [yesql.core :refer [defqueries]]
            [me.raynes.fs.compression :as compress]
            [org.tobereplaced.nio.file :as nio]
            [environ.core :refer [env]]
            [clj-http.client :as client]
            [mdr2.obi :as obi]
            [mdr2.production :as prod]
            [mdr2.production.path :as path]
            [mdr2.util :as util]))

(def ^:private db {:factory factory :name "java:jboss/datasources/archive"})
(def ^:private archive-web-root (env :archive-web-root))
(def ^:private archive-web-user (env :archive-web-user))
(def ^:private archive-web-password (env :archive-web-password))

(defqueries "mdr2/archive/queries.sql" {:connection db})

(def ^:private repairing-cache (caching/cache "repairing-cache" :ttl [15 :minutes]))

(defn production-id?
  "Return true if `id` is a valid production id"
  [id]
  (re-matches #"(?i)dam\d{1,5}" id))

(defn product-number?
  "Return true if `id` is a valid product number"
  [id]
  (re-matches #"DY\d{5}" id))

(defn archive-identifier?
  "Return true if `id` is either a valid production id, i.e. a dam
  number or a valid library signature"
  [id]
  (or (production-id? id) (prod/library-signature? id)))

(defn archive-url
  "Return the url for an archived production given a `container-id`"
  [container-id]
  ;; zero pad the container-id so that it contains 6 digits
  (let [padded-id (format "%06d" container-id)]
    (format "%s/%s/%s/a%s.tar" archive-web-root
            (.substring padded-id 0 2)
            (.substring padded-id 2 4)
            padded-id)))

(defn container-id
  "Return a container-id given a `production` and optionally `sektion`
  which can be either `:master` or `:dist-master`"
  ([production]
   (container-id production :master))
  ([production sektion]
   (let [id (case sektion
              :master (prod/dam-number production)
              :dist-master (:library_signature production))]
     (-> {:id id} production-id-to-archive-id first :id))))

(defn repair
  "Get a production from the archive and prepare it for repairing"
  [{id :id :as production}]
  (let [repairing-in-progress? (.putIfAbsent repairing-cache id true)
        dest-path (path/structured-path production)
        ;; create the tmp dir in the structured-path as there is not
        ;; enough space on the normal tmp dir path
        tmp-dir (nio/resolve-sibling dest-path (str id "_repair"))]
    (cond
      repairing-in-progress?
      (let [error-msg (format "Repair for %s already pending" id)]
        (log/warn error-msg)
        [error-msg])
      (not= (:state production) "archived")
      (let [error-msg "Production is not in state \"archived\""]
        (log/error error-msg)
        [error-msg])
      ;; checking for the state is not enough: there is a race
      ;; condition as the state is only set after all the files have
      ;; been copied. This takes time. So we also check for the
      ;; existence of some important directories
      (nio/exists? dest-path)
      (let [error-msg (format "Directory %s already exists" dest-path)]
        (log/error error-msg)
        [error-msg])
      (nio/exists? tmp-dir)
      (let [error-msg (format "Directory %s already exists" tmp-dir)]
        (log/error error-msg)
        [error-msg])
      :else
      (let [container-id (container-id production)
            url (archive-url container-id)
            response (client/get url
                                 {:as :stream
                                  :basic-auth [archive-web-user archive-web-password]})]
        (log/infof "Repairing %s" id)
        (if (client/success? response)
          (let [dam-number (prod/dam-number production)
                tar-file (io/file tmp-dir (str dam-number ".tar"))
                tar-dir (io/file tmp-dir dam-number)]
            (transaction
             ;; create all dirs for this production
             (prod/create-dirs production)
             ;; copy tar to tmpdir
             (nio/create-directory! tmp-dir)
             (with-open [input (:body response)]
               (nio/copy! input tar-file))
             ;; extract the tar
             (compress/untar tar-file tar-dir)
             ;; extract the relevant parts to the structured-path
             (let [src-path (io/file tar-dir dam-number "produkt" dam-number)]
               (doseq [f (filter #(.isFile %) (file-seq src-path))]
                 (nio/move! f (io/file dest-path (nio/file-name f)))))
             ;; clear the temporary files
             (util/delete-directory! tmp-dir)
             ;; create the obi config file
             (obi/config-file production)
             ;; set the state
             (let [updated (prod/set-state! production "structured")]
               ;; clear repairing-cache
               (.remove repairing-cache id)
               updated)
             (prod/set-state! production "structured")))
          (let [error-msg (format "Couldn't get %s from archive (%s)" id url)]
            ;; close the stream
            (.close (:body response))
            (log/error error-msg)
            (.remove repairing-cache id)
            [error-msg]))))))

Make sure the archive-url is correct even for 6-digit container-ids

the classic y2k problem

This will be correct as long as the container-ids do not have 7
digits, which will not happen "for another 100 years" according to
some sources on the internal irc channel


(ns mdr2.repair
  "Functions to handle repairing of a production

  This mostly entails functionality to fetch a production from the archive."
  (:require [clojure.java.io :as io]
            [clojure.tools.logging :as log]
            [yesql.core :refer [defqueries]]
            [me.raynes.fs :as fs]
            [me.raynes.fs.compression :as compress]
            [environ.core :refer [env]]
            [clj-http.client :as client]
            [mdr2.obi :as obi]
            [mdr2.production :as prod]
            [mdr2.production.path :as path]))

(def ^:private db (env :archive-database-url))
(def ^:private archive-web-root (env :archive-web-root))
(def ^:private archive-web-user (env :archive-web-user))
(def ^:private archive-web-password (env :archive-web-password))

(defqueries "mdr2/archive/queries.sql" {:connection db})

(defn production-id?
  "Return true if `id` is a valid production id"
  [id]
  (re-matches #"(?i)dam\d{1,5}" id))

(defn product-number?
  "Return true if `id` is a valid product number"
  [id]
  (re-matches #"DY\d{5}" id))

(defn archive-identifier?
  "Return true if `id` is either a valid production id, i.e. a dam
  number or a valid library signature"
  [id]
  (or (production-id? id) (prod/library-signature? id)))

(defn archive-url
  "Return the url for an archived production given a `container-id`"
  [container-id]
  (format "%s/0%s/%s/a0%s.tar" archive-web-root
          (.substring container-id 0 1)
          (.substring container-id 1 3)
          container-id))

(defn container-id
  "Return a container-id given a `production`"
  [production]
  (let [dam-number (prod/dam-number production)]
    (-> {:id dam-number} production-id-to-archive-id first :id str)))

(defn repair
  "Get a production from the archive and prepare it for repairing"
  [production]
  (let [container-id (container-id production)
        url (archive-url container-id)
        response (client/get url
                  {:as :stream
                   :basic-auth [archive-web-user archive-web-password]})]
    (if (client/success? response)
      (let [dam-number (prod/dam-number production)
            tar-file (io/file (fs/tmpdir) (str dam-number ".tar"))
            tar-dir (io/file (fs/tmpdir) dam-number)]
        ;; copy tar to tmpdir
        (with-open [input (:body response)
                    output (io/output-stream tar-file)]
          (io/copy input output))
        ;; extract the tar
        (compress/untar tar-file tar-dir)
        ;; extract the relevant parts to the structured-path
        (let [src-path (io/file tar-dir dam-number "produkt" dam-number)
              dest-path (path/structured-path production)]
          (doseq [f (filter #(.isFile %) (file-seq src-path))]
            (fs/rename f (io/file dest-path (fs/base-name f)))))
        ;; clear the temporary files
        (fs/delete tar-file)
        (fs/delete-dir tar-dir)
        ;; create the obi config file
        (obi/config-file production)
        ;; set the state
        (prod/set-state! production "structured"))
      (do
        (log/errorf "Couldn't get %s from archive (%s)" (:id production) url)
        ;; close the stream
        (.close (:body response))))))

(ns mdr2.repair
  "Functions to handle repairing of a production

  This mostly entails functionality to fetch a production from the archive."
  (:require [clojure.java.io :as io]
            [clojure.tools.logging :as log]
            [yesql.core :refer [defqueries]]
            [me.raynes.fs :as fs]
            [me.raynes.fs.compression :as compress]
            [environ.core :refer [env]]
            [clj-http.client :as client]
            [mdr2.obi :as obi]
            [mdr2.production :as prod]
            [mdr2.production.path :as path]))

(def ^:private db (env :archive-database-url))
(def ^:private archive-web-root (env :archive-web-root))
(def ^:private archive-web-user (env :archive-web-user))
(def ^:private archive-web-password (env :archive-web-password))

(defqueries "mdr2/archive/queries.sql" {:connection db})

(defn production-id?
  "Return true if `id` is a valid production id"
  [id]
  (re-matches #"(?i)dam\d{1,5}" id))

(defn product-number?
  "Return true if `id` is a valid product number"
  [id]
  (re-matches #"DY\d{5}" id))

(defn archive-identifier?
  "Return true if `id` is either a valid production id, i.e. a dam
  number or a valid library signature"
  [id]
  (or (production-id? id) (prod/library-signature? id)))

(defn archive-url
  "Return the url for an archived production given a `container-id`"
  [container-id]
  (format "%s/0%s/%s/a0%s.tar" archive-web-root
          (.substring container-id 0 1)
          (.substring container-id 1 3)
          container-id))

(defn container-id
  "Return a container-id given a `production`"
  [production]
  (let [dam-number (prod/dam-number production)]
    (-> {:id dam-number} production-id-to-archive-id first :id str)))

(defn repair
  "Get a production from the archive and prepare it for repairing"
  [production]
  (let [container-id (container-id production)
        url (archive-url container-id)
        response (client/get url
                  {:as :stream
                   :basic-auth [archive-web-user archive-web-password]})]
    (if (client/success? response)
      (let [dam-number (prod/dam-number production)
            tar-file (io/file (fs/tmpdir) (str dam-number ".tar"))
            tar-dir (io/file (fs/tmpdir) dam-number)]
        ;; create all dirs for this production
        (prod/create-dirs production)
        ;; copy tar to tmpdir
        (with-open [input (:body response)
                    output (io/output-stream tar-file)]
          (io/copy input output))
        ;; extract the tar
        (compress/untar tar-file tar-dir)
        ;; extract the relevant parts to the structured-path
        (let [src-path (io/file tar-dir dam-number "produkt" dam-number)
              dest-path (path/structured-path production)]
          (doseq [f (filter #(.isFile %) (file-seq src-path))]
            (fs/rename f (io/file dest-path (fs/base-name f)))))
        ;; clear the temporary files
        (fs/delete tar-file)
        (fs/delete-dir tar-dir)
        ;; create the obi config file
        (obi/config-file production)
        ;; set the state
        (prod/set-state! production "structured"))
      (do
        (log/errorf "Couldn't get %s from archive (%s)" (:id production) url)
        ;; close the stream
        (.close (:body response))))))

Create all dirs when repairing

Create all dirs when repairing


(ns frontend.components.pieces.topbar
  (:require [devcards.core :as dc :refer-macros [defcard]]
            [frontend.components.common :as common]
            [frontend.config :as config]
            [frontend.utils.html :as html]

            [frontend.models.build :as build-model]
            [frontend.models.project :as project-model]
            [frontend.models.plan :as pm]

            [frontend.utils.github :as gh-utils])
  (:require-macros [frontend.utils :refer [component html]]))

(defn topbar
  "A bar which sits at the top of the screen and provides navigation and context.

  :support-info - A map defining the attributes of the support link. This is
                   most likely going to be the result of the
                   function (common/contact-support-a-info owner).

  :user         - The current user. We display their avatar in the bar."
  [{:keys [support-info user]}]
  (component
    (html
     [:div
      [:a.logomark {:href "/dashboard"
                    :aria-label "Dashboard"}
       (common/ico :logo)]
      [:div.navs-container
        [:ul.nav-items.collapsing-nav
          [:li
            [:a.has-icon {:href "/dashboard"
                          :aria-label "Builds"}
              [:i.material-icons "storage"] "Builds"]]
          [:li
            [:a.has-icon {:href "/build-insights"
                          :aria-label "Insights"}
              [:i.material-icons "assessment"] "Insights"]]
          [:li
            [:a.has-icon {:href "/projects"
                          :aria-label "Projects"}
              [:i.material-icons "book"] "Projects"]]
          [:li
            [:a.has-icon {:href "/team"
                          :aria-label "Teams"}
              [:i.material-icons "group"] "Teams"]]]
        [:ul.nav-items.nav-items-left.collapsing-nav
         [:li.dropdown
          [:button.dropdown-toggle
           {:data-toggle "dropdown"
            :aria-haspopup "true"
            :aria-expanded "false"}
           "What's New " [:i.material-icons "keyboard_arrow_down"]]
          [:ul.dropdown-menu.pull-right.animated.slideInDown
           (when-not (config/enterprise?)
             [:li [:a (html/open-ext {:href "https://circleci.com/changelog/"}) "Changelog"]])
           [:li [:a (html/open-ext {:href "https://discuss.circleci.com/c/announcements"}) "Announcements"]]]]
         [:li
          [:a (html/open-ext {:href "https://circleci.com/docs/"})
           "Docs"]]
         [:li
          [:a (html/open-ext {:href "https://discuss.circleci.com/"})
           "Discuss"]]
         [:li
          [:a support-info
           "Support"]]]
        [:ul.nav-items
         [:li.dropdown.user-menu
          [:button.dropdown-toggle
           {:data-toggle "dropdown"
            :aria-haspopup "true"
            :aria-expanded "false"}
           [:img.gravatar {:src (gh-utils/make-avatar-url user :size 60)}]
           [:i.material-icons "keyboard_arrow_down"]]
          [:ul.dropdown-menu.pull-right.animated.slideInDown
           [:li [:a {:href "/logout/"} "Logout"]]
           [:li [:a {:href "/account"} "User Settings"]]
           (when (:admin user)
             [:li [:a {:href "/admin"} "Admin"]])]]]
        [:button.navbar-toggler.hidden-sm-up {:type "button"
                                                      :data-toggle "collapse"
                                                      :data-target "collapsing-nav"
                                                      :aria-controls "collapsing-nav"
                                                      :aria-expanded "false"
                                                      :aria-label "Toggle navigation"}
           [:i.material-icons "menu"]]]])))

(dc/do
  (defcard topbar
    (html
      (topbar {:support-info {:href "#"
                              :onclick #(.log js/console "Clicked the support button!")}
               :user { :avatar_url "https://avatars.githubusercontent.com/u/5826638" }}))))

(ns frontend.components.pieces.topbar
  (:require [devcards.core :as dc :refer-macros [defcard]]
            [frontend.components.common :as common]
            [frontend.config :as config]
            [frontend.utils.html :as html]

            [frontend.models.build :as build-model]
            [frontend.models.project :as project-model]
            [frontend.models.plan :as pm]

            [frontend.utils.github :as gh-utils])
  (:require-macros [frontend.utils :refer [component html]]))

(defn topbar
  "A bar which sits at the top of the screen and provides navigation and context.

  :support-info - A map defining the attributes of the support link. This is
                   most likely going to be the result of the
                   function (common/contact-support-a-info owner).

  :user         - The current user. We display their avatar in the bar."
  [{:keys [support-info user]}]
  (component
    (html
     [:div
      [:div.navs-container
       [:a.logomark.hidden-sm-down {:href "/dashboard"
                     :aria-label "Dashboard"}
        (common/ico :logo)]
       [:a.logomark-narrow.hidden-md-up {:href "/dashboard"
                     :aria-label "Dashboard"}
        [:img {:src (common/icon-path "Logo-Wordmark")}]]
       [:ul.nav-items.collapsing-nav
         [:li
           [:a.has-icon {:href "/dashboard"
                         :aria-label "Builds"}
             [:i.material-icons "storage"] "Builds"]]
         [:li
           [:a.has-icon {:href "/build-insights"
                         :aria-label "Insights"}
             [:i.material-icons "assessment"] "Insights"]]
         [:li
           [:a.has-icon {:href "/projects"
                         :aria-label "Projects"}
             [:i.material-icons "book"] "Projects"]]
         [:li
           [:a.has-icon {:href "/team"
                         :aria-label "Teams"}
             [:i.material-icons "group"] "Teams"]]]
        [:ul.nav-items.nav-items-left.collapsing-nav
         [:li.dropdown
          [:button.dropdown-toggle
           {:data-toggle "dropdown"
            :aria-haspopup "true"
            :aria-expanded "false"}
           "What's New " [:i.material-icons "keyboard_arrow_down"]]
          [:ul.dropdown-menu.pull-right.animated.slideInDown
           (when-not (config/enterprise?)
             [:li [:a (html/open-ext {:href "https://circleci.com/changelog/"}) "Changelog"]])
           [:li [:a (html/open-ext {:href "https://discuss.circleci.com/c/announcements"}) "Announcements"]]]]
         [:li
          [:a (html/open-ext {:href "https://circleci.com/docs/"})
           "Docs"]]
         [:li
          [:a (html/open-ext {:href "https://discuss.circleci.com/"})
           "Discuss"]]
         [:li
          [:a support-info
           "Support"]]
         [:li.dropdown.user-menu
          [:button.dropdown-toggle
           {:data-toggle "dropdown"
            :aria-haspopup "true"
            :aria-expanded "false"}
           [:img.gravatar {:src (gh-utils/make-avatar-url user :size 60)}]
           [:i.material-icons "keyboard_arrow_down"]]
          [:ul.dropdown-menu.pull-right.animated.slideInDown
           [:li [:a {:href "/logout/"} "Logout"]]
           [:li [:a {:href "/account"} "User Settings"]]
           (when (:admin user)
             [:li [:a {:href "/admin"} "Admin"]])]]]
        [:button.navbar-toggler.hidden-md-up {:type "button"
                                                      :data-toggle "collapse"
                                                      :data-target "collapsing-nav"
                                                      :aria-controls "collapsing-nav"
                                                      :aria-expanded "false"
                                                      :aria-label "Toggle navigation"}
           [:i.material-icons "menu"]]]])))

(dc/do
  (defcard topbar
    (html
      (topbar {:support-info {:href "#"
                              :onclick #(.log js/console "Clicked the support button!")}
               :user { :avatar_url "https://avatars.githubusercontent.com/u/5826638" }}))))

Refactor nav bar

Refactor nav bar


(ns misaki.core
  "misaki: Jekyll inspired static site generator in Clojure"
  (:use
    [misaki transform config]
    [misaki.util file code]
    [clj-time.core :only [date-time after? month day year]]
    [hiccup.core :only [html]]
    [hiccup.page-helpers :only [html5 xhtml html4]])
  (:require
    html
    conv
    [clojure.string :as str]
    [clojure.java.io :as io])
  (:import
    [java.io File]
    [java.net URLEncoder]))

(declare generate-html)
(declare make-output-filename)

(def ^:dynamic *post-filename-regexp*
  #"(\d{4})[-_](\d{1,2})[-_](\d{1,2})[-_](.+)$")

; =parse-template-options
(defn parse-template-options
  "Parse template options

  ex) template file
      ; @layout default
      ; @title hello, world
      [:h1 \"hello world\"]

      => {:layout \"default\", :title \"hello, world\"}"
  [data]
  (let [lines (map str/trim (str/split-lines data))
        comments (filter #(= 0 (.indexOf % ";")) lines)
        params (remove nil? (map #(re-seq #"^;+\s*@(\w+)\s+(.+)$" %) comments))]

    (into {} (for [[[_ k v]] params] [(keyword k) v]))))

; =apply-template
(defn apply-template
  "Apply contents data to template function."
  [f contents]
  (let [option (merge (meta f) (meta contents))
        contents (with-meta contents option)]
    (with-meta (f contents) option)))

; =load-template
(defn load-template
  "Load template file, and transform to function.
  Template options are contained as meta data."
  ([filename] (load-template filename true))
  ([filename allow-layout?]
   (let [data (slurp filename)
         option (parse-template-options data)]

     (if-let [layout-name (:layout option)]
       (let [; at first, evaluate parent layout
             parent-layout-fn (load-template (str *layout-dir* layout-name ".clj"))
             ; second, evaluate this layout
             layout-fn (transform data)]
         (if allow-layout?
           (with-meta
             (fn [contents]
               (apply-template parent-layout-fn
                 (apply-template layout-fn contents)))
             (merge (meta parent-layout-fn) option))
           (with-meta layout-fn option)))
       (with-meta (transform data) option)))))

; =layout-file?
(defn layout-file?
  "Check whether file is layout file or not."
  [#^File file]
  (not= -1 (.indexOf (.getAbsolutePath file) *layout-dir*)))

;;; POSTS
; =get-post-options
(defn get-post-options
  "Get post's template options from post file(java.io.File)"
  [#^File file]
  (->> (.getName file) (str *post-dir*) slurp parse-template-options))

; =get-post-title
(defn get-post-title
  "Get post title from post file(java.io.File)."
  [#^File file]
  (->> (.getName file) (str *post-dir*) slurp parse-template-options :title))

; =get-post-url
(defn get-post-url
  "Generate post url from file(java.io.File)."
  [#^File file]
  (str "/" (make-output-filename (str *post* (.getName file)))))

; =get-date
(defn get-date
  "Get date from filename
  ex) YYYY-MM-DD
      YYYY-M-D
      YYYY_MM_DD
      YYYY_M_D"
  [#^File file]
  (let [date (nfirst (re-seq *post-filename-regexp* (.getName file)))]
    (if date
      (apply date-time (map #(Integer/parseInt %)
                            ; last => filename
                            (drop-last date)))
      (last-modified-date file))))

; =get-content
(defn get-content
  "Get post content without layout"
  [#^File file]
  (html (generate-html (file->template-name file)
                       :allow-layout? false)))

; =get-escaped-content
(defn get-escaped-content
  "Get escaped post content without layout"
  [#^File file]
  (-> (get-content file)
    (str/replace #"&" "&")
    (str/replace #"\"" """)
    (str/replace #"<" "<")
    (str/replace #">" ">")))

; =get-posts
(defn get-posts
  "Get posts data from *post-dir* directory."
  []
  (for [file (filter #(has-extension? ".clj" %) (find-files *post-dir*))]
    (merge
      (get-post-options file)
      {:file  file
;       :title (:title options)
       :url   (get-post-url file)
       :date  (get-date file)
       :lazy-content (delay (get-escaped-content file))})))

; =post-file?
(defn post-file?
  "Check whether file is post file or not."
  [#^File file]
  (not= -1 (.indexOf (.getAbsolutePath file) *post-dir*)))

;;; TEMPLATES
; =sort-by-date
(defn- sort-by-date [posts]
  (sort #(after? (:date %) (:date %2)) posts))

; =generate-html
(defn generate-html
  "Generate HTML from template."
  [tmpl-name & {:keys [allow-layout?] :or {allow-layout? true}}]
  (let [filename (str *template-dir* tmpl-name)
        tmpl-fn (load-template filename allow-layout?)
        site-data (merge *site* {:posts (sort-by-date (get-posts))
                                 :date  (get-date (io/file filename))})
        empty-data (with-meta '("") site-data)]

    (apply-template tmpl-fn empty-data)))

; =get-template-files
(defn get-template-files
  "get all template files(java.io.File) from *template-dir*"
  []
  (remove #(or (.isDirectory %)
             (not (has-extension? ".clj" %))
               (layout-file? %))
          (find-files *template-dir*)))

;; COMPILE
; =get-compile-fn
(defn get-compile-fn
  "Get hiccup functon to compile sexp"
  [fmt]
  (case fmt
    "html5" #(html5 %)
    "xhtml" #(xhtml %)
    "html4" #(html4 %)
    #(html %)))

; =make-output-filename
(defn make-output-filename
  "Make output filename from template name"
  [tmpl-name]
  (let [file (template-name->file tmpl-name)
        date (get-date file)]
    (if (post-file? file)
      (format "%04d/%02d/%s" (year date) (month date)
              (delete-extension
                (last (first (re-seq *post-filename-regexp* tmpl-name)))))
      (delete-extension tmpl-name))))

; =compile-template
(defn compile-template
  "Compile a specified template.
  return true if compile is successed"
  [tmpl-name]
  (try
      (let [data (generate-html tmpl-name)
            compile-fn (-> data meta :format get-compile-fn)]
        (write-data
          (str *public-dir* (make-output-filename tmpl-name))
          (compile-fn data))
        true)
    (catch Exception e (.printStackTrace e) false)))

; =compile-all-templates
(defn compile-all-templates
  "Compile all template files.
  return true if all compile is successed"
  []
  (every? #(compile-template %)
          (map file->template-name (get-template-files))))

(ns misaki.core
  "misaki: Jekyll inspired static site generator in Clojure"
  (:use
    [misaki transform config]
    [misaki.util file code]
    [clj-time.core :only [date-time after? month day year]]
    [hiccup.core :only [html]]
    [hiccup.page-helpers :only [html5 xhtml html4]])
  (:require
    html
    conv
    [clojure.string :as str]
    [clojure.java.io :as io])
  (:import
    [java.io File]
    [java.net URLEncoder]))

(declare generate-html)
(declare make-output-filename)

(def ^:dynamic *post-filename-regexp*
  #"(\d{4})[-_](\d{1,2})[-_](\d{1,2})[-_](.+)$")

; =parse-template-options
(defn parse-template-options
  "Parse template options

  ex) template file
      ; @layout default
      ; @title hello, world
      [:h1 \"hello world\"]

      => {:layout \"default\", :title \"hello, world\"}"
  [data]
  (let [lines (map str/trim (str/split-lines data))
        comments (filter #(= 0 (.indexOf % ";")) lines)
        params (remove nil? (map #(re-seq #"^;+\s*@(\w+)\s+(.+)$" %) comments))]

    (into {} (for [[[_ k v]] params] [(keyword k) v]))))

; =apply-template
(defn apply-template
  "Apply contents data to template function."
  [f contents]
  (let [option (merge (meta f) (meta contents))
        contents (with-meta contents option)]
    (with-meta (f contents) option)))

; =load-template
(defn load-template
  "Load template file, and transform to function.
  Template options are contained as meta data."
  ([filename] (load-template filename true))
  ([filename allow-layout?]
   (let [data (slurp filename)
         option (parse-template-options data)]

     (if-let [layout-name (:layout option)]
       (let [; at first, evaluate parent layout
             parent-layout-fn (load-template (str *layout-dir* layout-name ".clj"))
             ; second, evaluate this layout
             layout-fn (transform data)]
         (if allow-layout?
           (with-meta
             (fn [contents]
               (apply-template parent-layout-fn
                 (apply-template layout-fn contents)))
             (merge (meta parent-layout-fn) option))
           (with-meta layout-fn option)))
       (with-meta (transform data) option)))))

; =layout-file?
(defn layout-file?
  "Check whether file is layout file or not."
  [#^File file]
  (not= -1 (.indexOf (.getAbsolutePath file) *layout-dir*)))

;;; POSTS
; =get-post-options
(defn get-post-options
  "Get post's template options from post file(java.io.File)"
  [#^File file]
  (->> (.getName file) (str *post-dir*) slurp parse-template-options))

; =get-post-url
(defn get-post-url
  "Generate post url from file(java.io.File)."
  [#^File file]
  (str "/" (make-output-filename (str *post* (.getName file)))))

; =get-date
(defn get-date
  "Get date from filename
  ex) YYYY-MM-DD
      YYYY-M-D
      YYYY_MM_DD
      YYYY_M_D"
  [#^File file]
  (let [date (nfirst (re-seq *post-filename-regexp* (.getName file)))]
    (if date
      (apply date-time (map #(Integer/parseInt %)
                            ; last => filename
                            (drop-last date)))
      (last-modified-date file))))

; =get-content
(defn get-content
  "Get post content without layout"
  [#^File file]
  (html (generate-html (file->template-name file)
                       :allow-layout? false)))

; =get-escaped-content
(defn get-escaped-content
  "Get escaped post content without layout"
  [#^File file]
  (-> (get-content file)
    (str/replace #"&" "&")
    (str/replace #"\"" """)
    (str/replace #"<" "<")
    (str/replace #">" ">")))

; =get-posts
(defn get-posts
  "Get posts data from *post-dir* directory."
  []
  (for [file (filter #(has-extension? ".clj" %) (find-files *post-dir*))]
    (merge
      (get-post-options file)
      {:file  file
       :url   (get-post-url file)
       :date  (get-date file)
       :lazy-content (delay (get-escaped-content file))})))

; =post-file?
(defn post-file?
  "Check whether file is post file or not."
  [#^File file]
  (not= -1 (.indexOf (.getAbsolutePath file) *post-dir*)))

;;; TEMPLATES
; =sort-by-date
(defn- sort-by-date [posts]
  (sort #(after? (:date %) (:date %2)) posts))

; =generate-html
(defn generate-html
  "Generate HTML from template."
  [tmpl-name & {:keys [allow-layout?] :or {allow-layout? true}}]
  (let [filename (str *template-dir* tmpl-name)
        tmpl-fn (load-template filename allow-layout?)
        site-data (merge *site* {:posts (sort-by-date (get-posts))
                                 :date  (get-date (io/file filename))})
        empty-data (with-meta '("") site-data)]

    (apply-template tmpl-fn empty-data)))

; =get-template-files
(defn get-template-files
  "get all template files(java.io.File) from *template-dir*"
  []
  (remove #(or (.isDirectory %)
               (not (has-extension? ".clj" %))
               (layout-file? %))
          (find-files *template-dir*)))

;; COMPILE
; =get-compile-fn
(defn get-compile-fn
  "Get hiccup functon to compile sexp"
  [fmt]
  (case fmt
    "html5" #(html5 %)
    "xhtml" #(xhtml %)
    "html4" #(html4 %)
    #(html %)))

; =make-output-filename
(defn make-output-filename
  "Make output filename from template name"
  [tmpl-name]
  (let [file (template-name->file tmpl-name)
        date (get-date file)]
    (if (post-file? file)
      (format "%04d/%02d/%s" (year date) (month date)
              (delete-extension
                (last (first (re-seq *post-filename-regexp* tmpl-name)))))
      (delete-extension tmpl-name))))

; =compile-template
(defn compile-template
  "Compile a specified template.
  return true if compile is successed"
  [tmpl-name]
  (try
      (let [data (generate-html tmpl-name)
            compile-fn (-> data meta :format get-compile-fn)]
        (write-data
          (str *public-dir* (make-output-filename tmpl-name))
          (compile-fn data))
        true)
    (catch Exception e (.printStackTrace e) false)))

; =compile-all-templates
(defn compile-all-templates
  "Compile all template files.
  return true if all compile is successed"
  []
  (every? #(compile-template %)
          (map file->template-name (get-template-files))))

delete core/get-post-title

delete core/get-post-title


(ns discuss.components.options
  (:require [om.core :as om :include-macros true]
            [om.dom :as dom :include-macros true]
            [om.next :as nom :refer-macros [defui]]
            [sablono.core :as html :refer-macros [html]]
            [discuss.utils.bootstrap :as bs]
            [discuss.translations :as translations :refer [translate]]
            [discuss.utils.common :as lib]
            [discuss.utils.views :as vlib]))

(defn- option-row
  "Generic row for multiple settings."
  {:deprecated 0.4}
  [description content]
  (dom/div #js {:className "text-center"}
           (dom/div nil description)
           (dom/div nil content)))

(defn- language
  "Component for a single language selection."
  {:deprecated 0.4}
  [language]
  (reify
    om/IRender
    (render [_]
      (dom/span nil
                (bs/button-default-sm #(lib/language-next! (first language)) (second language))
                " "))))

(defn- language-row
  "Language Chooser."
  {:deprecated 0.4}
  []
  (option-row (dom/span nil (vlib/fa-icon "fa-flag") (translate :options :lang :space))
              (apply dom/div nil
                     (map #(om/build language %) translations/available))))

(defn view
  "Main view for options."
  {:deprecated 0.4}
  []
  (reify
    om/IRender
    (render [_]
      (dom/div nil
               (vlib/view-header (translate :options :heading))
               (language-row)))))

;; -----------------------------------------------------------------------------
;; om.next

(defn- language-button
  "Create button to set language."
  [[lang-keyword lang-verbose]]
  (bs/button-default-sm #(lib/language-next! lang-keyword) lang-verbose))

(defui Options
  Object
  (render [this]
          (html [:div (vlib/view-header (translate :options :heading))
                 [:div (vlib/fa-icon "fa-flag") (translate :options :lang :space)]
                 (interpose " " (mapv language-button translations/available))])))
(def options (nom/factory Options))

(ns discuss.components.options
  (:require [om.next :as om :refer-macros [defui]]
            [sablono.core :as html :refer-macros [html]]
            [discuss.utils.bootstrap :as bs]
            [discuss.translations :as translations :refer [translate]]
            [discuss.utils.common :as lib]
            [discuss.utils.views :as vlib]))

(defn- language-button
  "Create button to set language."
  [[lang-keyword lang-verbose]]
  (bs/button-default-sm #(lib/language-next! lang-keyword) lang-verbose))

(defui Options
  Object
  (render [this]
          (html [:div (vlib/view-header (translate :options :heading))
                 [:div (vlib/fa-icon "fa-flag") (translate :options :lang :space)]
                 (interpose " " (mapv language-button translations/available))])))
(def options (om/factory Options))

Remove om.now language components

Remove om.now language components


;; Copyright 2014 Red Hat, Inc, and individual contributors.
;;
;; 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 immutant.scheduling
  "Schedule jobs for execution"
  (:require [immutant.scheduling.internal :refer :all]
            [immutant.internal.options    :refer :all]
            [immutant.internal.util       :as u]
            [immutant.scheduling.options  :refer [resolve-options defoption]]
            [clojure.walk                 :refer [keywordize-keys]])
  (:import org.projectodd.wunderboss.WunderBoss
           [org.projectodd.wunderboss.scheduling
            Scheduling Scheduling$CreateOption Scheduling$ScheduleOption]))

(defn schedule
  "Schedules a function to run according to a specification map
  comprised of any of the following keys:

  * `:in` - a period after which f will be called
  * `:at` - a time after which f will be called
  * `:every` - the period between calls
  * `:until` - stops the calls at a specific time
  * `:limit` - limits the calls to a specific count
  * `:cron` - calls f according to a [Quartz-style](http://quartz-scheduler.org/documentation/quartz-2.2.x/tutorials/tutorial-lesson-06) cron spec

  Units for periods (`:in` and `:every`) are milliseconds, but can
  also be represented as a keyword or a vector of number/keyword
  pairs, e.g. `[1 :week, 4 :days, 2 :hours, 30 :minutes, 59 :seconds]`.

  Date/Time values (`:at` and `:until`) can be a `java.util.Date`,
  millis-since-epoch, or a String in `HH:mm` format.

  For example:

  ```
  (schedule #(println \"I'm running!\")
    {:in [5 :minutes]
     :every [2 :hours, 30 :minutes]
     :until \"17:30\"})
  ```

  The spec can be passed as either an explicit map or as keyword arguments:

  ```
  (schedule #(println \"I'm running!\")
    :at \"08:00\"
    :every :day
    :limit 10)
  ```

  Optional helper functions can be combined to create the spec as well:

  ```
  (schedule #(println \"I'm running!\")
    (-> (in 5 :minutes)
      (every 2 :hours, 30 :minutes)
      (until \"1730\")))
  ```

  Two additional options may be passed in the spec:

  * `:id` - a unique identifier for the scheduled job
  * `:singleton` - a boolean denoting the job's behavior in a cluster [true]

  If called with an `:id` that has already been scheduled, the prior job
  will be replaced. If an id is not provided, a UUID is used instead.

  The return value is a map of the options with any missing defaults
  filled in, including a generated id if necessary.

  TODO: doc scheduler options and scheduler lookup"
  [f & spec]
  (let [opts (->> spec
               u/kwargs-or-map->map
               keywordize-keys
               resolve-options
               (merge create-defaults schedule-defaults))
        id (:id opts (u/uuid))
        scheduler (scheduler (validate-options opts schedule))]
    (.schedule scheduler (name id) f
      (extract-options opts Scheduling$ScheduleOption))
    (-> opts
      (update-in [:ids scheduler] conj id)
      (assoc :id id))))

(set-valid-options! schedule
  (conj (opts->set Scheduling$ScheduleOption Scheduling$CreateOption) :id :ids))

(defn stop
  "Unschedule a scheduled job.

  Options can be passed as either a map or kwargs, but is typically the
  map returned from a {{schedule}} call. If there are no jobs remaining on
  the scheduler the scheduler itself is stopped. Returns true if a job
  was actually removed."
  ([key value & key-values]
     (stop (apply hash-map key value key-values)))
  ([options]
      (let [options (-> options
                      keywordize-keys
                      (validate-options schedule "stop"))
            ids (:ids options {(scheduler options)
                               [(:id options)]})
            stopped? (some boolean (doall (for [[s ids] ids, id ids]
                                            (.unschedule s (name id)))))]
        (doseq [scheduler (keys ids)]
          (when (empty? (.scheduledJobs scheduler))
            (.stop scheduler)))
        stopped?)))

(defoption in
  "Helper that specifies the period after which the job will fire,
  e.g. `(in 5 :minutes)`. See {{schedule}}.")

(defoption at
  "Helper that takes a time after which the job will fire, so it will
  run immediately if the time is in the past; can be a
  `java.util.Date`, millis-since-epoch, or a String in `HH:mm` format.
  See {{schedule}}.")

(defoption every
  "Helper that specifies a period between function calls,
  e.g. `(every 2 :hours)`. See {{schedule}}.")

(defoption until
  "When {{every}} is specified, this helper limits the invocations by
  time; can be a `java.util.Date`, millis-since-epoch, or a String in
  `HH:mm` format, e.g. `(-> (every :hour) (until \"17:00\"))`. See
  {{schedule}}.")

(defoption limit
  "When {{every}} is specified, this helper limits the invocations by
  count, including the first one, e.g. `(-> (every :hour) (limit
  10))`. When {{until}} and `limit` are combined, whichever triggers
  first ends the iteration. See {{schedule}}.")

(defoption cron
  "Helper that takes a Quartz-style cron spec, e.g. `(cron \"0 0 12 ?
   * WED\")`, see the [Quartz docs](http://quartz-scheduler.org/documentation/quartz-2.2.x/tutorials/tutorial-lesson-06)
   for more details.")

(defoption singleton
  "Helper that takes a boolean. If true (the default), only one
   instance of a given job name will run in a cluster.")

(defoption id
  "Helper that takes a String or keyword to use as the unique id for
  the job.")

;; Copyright 2014 Red Hat, Inc, and individual contributors.
;;
;; 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 immutant.scheduling
  "Schedule jobs for execution"
  (:require [immutant.scheduling.internal :refer :all]
            [immutant.internal.options    :refer :all]
            [immutant.internal.util       :as u]
            [immutant.scheduling.options  :refer [resolve-options defoption]]
            [clojure.walk                 :refer [keywordize-keys]])
  (:import org.projectodd.wunderboss.WunderBoss
           [org.projectodd.wunderboss.scheduling
            Scheduling Scheduling$CreateOption Scheduling$ScheduleOption]))

(defn schedule
  "Schedules a function to run according to a specification map
  comprised of any of the following keys:

  * :in - a period after which f will be called
  * :at - a time after which f will be called
  * :every - the period between calls
  * :until - stops the calls at a specific time
  * :limit - limits the calls to a specific count
  * :cron - calls f according to a [Quartz-style](http://quartz-scheduler.org/documentation/quartz-2.2.x/tutorials/tutorial-lesson-06) cron spec

  Units for periods (:in and :every) are milliseconds, but can
  also be represented as a keyword or a vector of number/keyword
  pairs, e.g. `[1 :week, 4 :days, 2 :hours, 30 :minutes, 59 :seconds]`.

  Date/Time values (:at and :until) can be a `java.util.Date`,
  millis-since-epoch, or a String in `HH:mm` format.

  For example:
  ```
  (schedule #(println \"I'm running!\")
    {:in [5 :minutes]
     :every [2 :hours, 30 :minutes]
     :until \"17:30\"})
  ```

  The spec can be passed as either an explicit map or as keyword arguments:
  ```
  (schedule #(println \"I'm running!\")
    :at \"08:00\"
    :every :day
    :limit 10)
  ```

  Optional helper functions can be combined to create the spec as well:
  ```
  (schedule #(println \"I'm running!\")
    (-> (in 5 :minutes)
      (every 2 :hours, 30 :minutes)
      (until \"1730\")))
  ```

  Two additional options may be passed in the spec:

  * :id - a unique identifier for the scheduled job
  * :singleton - a boolean denoting the job's behavior in a cluster [true]

  If called with an :id that has already been scheduled, the prior job
  will be replaced. If an id is not provided, a UUID is used instead.

  The return value is a map of the options with any missing defaults
  filled in, including a generated id if necessary.

  TODO: doc scheduler options and scheduler lookup"
  [f & spec]
  (let [opts (->> spec
               u/kwargs-or-map->map
               keywordize-keys
               resolve-options
               (merge create-defaults schedule-defaults))
        id (:id opts (u/uuid))
        scheduler (scheduler (validate-options opts schedule))]
    (.schedule scheduler (name id) f
      (extract-options opts Scheduling$ScheduleOption))
    (-> opts
      (update-in [:ids scheduler] conj id)
      (assoc :id id))))

(set-valid-options! schedule
  (conj (opts->set Scheduling$ScheduleOption Scheduling$CreateOption) :id :ids))

(defn stop
  "Unschedule a scheduled job.

  Options can be passed as either a map or kwargs, but is typically the
  map returned from a {{schedule}} call. If there are no jobs remaining on
  the scheduler the scheduler itself is stopped. Returns true if a job
  was actually removed."
  ([key value & key-values]
     (stop (apply hash-map key value key-values)))
  ([options]
      (let [options (-> options
                      keywordize-keys
                      (validate-options schedule "stop"))
            ids (:ids options {(scheduler options)
                               [(:id options)]})
            stopped? (some boolean (doall (for [[s ids] ids, id ids]
                                            (.unschedule s (name id)))))]
        (doseq [scheduler (keys ids)]
          (when (empty? (.scheduledJobs scheduler))
            (.stop scheduler)))
        stopped?)))

(defoption in
  "Helper that specifies the period after which the job will fire,
  e.g. `(in 5 :minutes)`. See {{schedule}}.")

(defoption at
  "Helper that takes a time after which the job will fire, so it will
  run immediately if the time is in the past; can be a
  `java.util.Date`, millis-since-epoch, or a String in `HH:mm` format.
  See {{schedule}}.")

(defoption every
  "Helper that specifies a period between function calls,
  e.g. `(every 2 :hours)`. See {{schedule}}.")

(defoption until
  "When {{every}} is specified, this helper limits the invocations by
  time; can be a `java.util.Date`, millis-since-epoch, or a String in
  `HH:mm` format, e.g. `(-> (every :hour) (until \"17:00\"))`. See
  {{schedule}}.")

(defoption limit
  "When {{every}} is specified, this helper limits the invocations by
  count, including the first one, e.g. `(-> (every :hour) (limit
  10))`. When {{until}} and `limit` are combined, whichever triggers
  first ends the iteration. See {{schedule}}.")

(defoption cron
  "Helper that takes a Quartz-style cron spec, e.g. `(cron \"0 0 12 ?
   * WED\")`, see the [Quartz docs](http://quartz-scheduler.org/documentation/quartz-2.2.x/tutorials/tutorial-lesson-06)
   for more details.")

(defoption singleton
  "Helper that takes a boolean. If true (the default), only one
   instance of a given job name will run in a cluster.")

(defoption id
  "Helper that takes a String or keyword to use as the unique id for
  the job.")

Remove redundant backticks

Remove redundant backticks


(ns attercop.spider
  (:require [clojure.string :as s]
            [org.httpkit.client :as http]
            [clojure.core.async
             :refer [chan >! >!! <! <!! go thread
                     close! timeout alts!]]
            [clojurewerkz.urly.core :as urly]
            [taoensso.timbre :as timbre]
            [attercop.enlive-utils :as enlive-utils]))

(defn- normalize-href
  "Normalizes a href attribute so that it always returns an absolute
  URL. The referrer is used to absolutize the URL in case it's
  relative.

  eg.
      (normalize-href \"http://example.com\" \"/foo.html\")
      ;= http://example.com/foo.html
  "
  [referrer href]
  (urly/absolutize href referrer))

(defn- extract-hrefs
  [html-nodes]
  (->> (enlive-utils/extract-hrefs html-nodes)
       (keep identity)
       (map s/trim)))

(defn- url->domain
  [url]
  (.getHost (urly/url-like url)))

(defn- fetch-url
  [{:keys [handle-status-codes user-agent]} url]
  (letfn [(allow? [status]
            (or (and (>= status 200)
                     (< status 300))
                (handle-status-codes status)))]
    @(http/get url
               {:user-agent user-agent}
               (fn [{:keys [status body]}]
                 (if (allow? status)
                   {:url url :html body :status status}
                   (timbre/info (format "Error: [%s] %s" status url)))))))

(defn- run-scrapers
  "Takes a sequence of rules and runs the scraper function on the
  response for the first rule that matches the url. The rest of the
  rules in the sequence if any are ignored. A ':default' rule always
  matches and is expected to be the last rule in the sequence."
  [rules {:keys [url] :as resp}]
  (when-let [rule (first rules)]
    (let [[check {scrape :scrape}] rule]
      (if (or (= check :default) (re-find check url))
        (when scrape
          (scrape resp))
        (recur (rest rules) resp)))))

(defn- follow-url?
  "Checks if the given url is to be followed as per the rules. The
  first rule that matches for the url is considered and the rest are
  ignored."
  [rules url]
  (when-let [rule (first rules)]
    (let [[check {follow :follow}] rule]
      (if (or (= check :default) (re-find check url))
        (boolean follow)
        (recur (rest rules) url)))))

(defn- skip-url?
  "Checks if the url can be skipped even if the rule matched for
  it. This is the case when :scrape and :follow for the rule are both
  nil."
  [rules url]
  (when-let [rule (first rules)]
    (let [[check {:keys [scrape follow]}] rule]
      (if (or (= check :default) (re-find check url))
        (not (or scrape follow))
        (recur (rest rules) url)))))

(defn- pipe-results
  "Takes a pipeline which is a sequence of functions transforming or
  doing something with the result and pipes the result through each of
  the functions in order."
  [pipeline results]
  (doseq [result results]
    (reduce (fn [acc f] (f acc)) result pipeline)))

(defn- init-throttle
  "Takes throttle config ie. a vector of 'max-hits' to be allowed in
  the given 'interval' and sets up throttling mechanism. It returns a
  core.async channel.

  How throttling works:

  A core.async channel is created with buffer size equal to max-hits
  and go block is initiated which periodically takes elements from the
  channel, waiting for some interval which is dynamically calculated
  if the buffer is getting filled too fast.

  The main thread does a blocking push to the channel everytime
  before making the HTTP request.
  "
  [[max-hits interval]]
  (let [ch-throttle (chan max-hits)
        wait (/ interval max-hits)]
    (go (loop []
          (let [begin-ts (System/currentTimeMillis)]
            (dotimes [i max-hits]
              (alts! [ch-throttle (timeout wait)]))
            (let [diff-ts (- (System/currentTimeMillis) begin-ts)]
              (if (< diff-ts interval)
                (Thread/sleep (- interval diff-ts)))))
          (recur)))
    ch-throttle))

(let [default-config {:max-wait 5000
                      :handle-status-codes #{}
                      :rate-limit [5 3000]}]
  (defn start
    "Starts the spider as per the config. Returns a vector of
  channels:

      1. a main channel that does the scraping. The caller function
  can wait for the scraping thread to exit by blocking on this channel.

      2. the urls channel. By closing this channel, the scraper can be
  gracefully shutdown.
    "
    [{:keys [start-urls allowed-domains rules
             pipeline max-wait rate-limit]
      :as config}]
    (let [config (merge default-config config)
          ch-urls (chan)
          ch-resp (chan)
          ch-throttle (init-throttle rate-limit)
          scrape (partial run-scrapers rules)
          start-url-set (set start-urls)
          visited-urls (atom #{})
          follow? (fn [url]
                    (or (start-url-set url)
                        (follow-url? rules url)))
          skip? (fn [url]
                  (or (@visited-urls url)
                      (not (allowed-domains (url->domain url)))
                      (skip-url? rules url)))
          pipe (partial pipe-results pipeline)]
      ;; put urls into the urls channel
      (go (doseq [url start-urls]
            (>! ch-urls url)))
      ;; take urls from urls channel and put into the response channel
      (go (loop []
            (when-let [url (first (alts! [ch-urls (timeout max-wait)]))]
              (>! ch-throttle :ok)
              (thread (if-let [resp (fetch-url config url)]
                        (>!! ch-resp resp)))
              (swap! visited-urls conj url)
              (recur))))
      ;; consume the responses channel and do 2 things:
      ;; 1. scrape the urls and put then into the urls channel,
      ;; 2. apply rules and call the relevant callback fns
      [(go (loop []
             (when-let [{:keys [html url] :as resp}
                        (first (alts! [ch-resp (timeout max-wait)]))]
               (let [html-nodes (enlive-utils/html->nodes html)
                     resp (assoc resp :html-nodes html-nodes)
                     links (when (follow? url)
                             (->> (extract-hrefs html-nodes)
                                  (map (partial normalize-href url))
                                  (remove skip?)))]
                 (doseq [link links]
                   (go (>! ch-urls link)))
                 (when-let [results (scrape resp)]
                   (pipe results)))
               (recur))))
       ch-urls])))

(defn run
  "Runs the scraper as per the given config. Blocks until all urls are scraped.

  Config
  ------

    :name ; [str] human readable name for the scraper

    :allowed-domains ; [set] urls of these will only be considered.

    :start-urls ; [seq] scraping/crawling will start with these

    :rules ; [seq] A rule is a vector of two elements, 1. a regular
  expression or the keyword :default 2. a map with fields :scrape (fn)
  and :follow (bool)

    :pipeline ; [seq] functions transforming or doing something with
  the scraped results.

    :max-wait ; [integer] Timeout for the HTTP requests in ms.
  [Default: 5000]

    :rate-limit ; [vector] (Optional) eg. [m, i] which means, 'm'
  max-hits in 'i' ms [Default: [5 3000]]

    :handle-status-codes ; [set] (Optional) Additional status codes to
  be handled by the scraper besides the standard valid ones ie. 2xx
  and 3xx.

    :graceful-shutdown? ; [bool|integer] (Optional) If non-falsy, the
  spider will be gracefully shutdown. Truthy values may be boolean or
  a number representing time to wait in milliseconds. If boolean, the
  timeout will be same as max-wait [default: 5000]
  "
  [{:keys [graceful-shutdown? max-wait]
    :as config
    :or {graceful-shutdown? 5000}}]
  (let [[ch-main ch-urls] (start config)]
    (when graceful-shutdown?
      (let [wait (if (number? graceful-shutdown?)
                   graceful-shutdown?
                   max-wait)]
        (.addShutdownHook (Runtime/getRuntime)
                          (Thread. (fn []
                                     (timbre/info "Shutting down gracefully")
                                     (close! ch-urls)
                                     (Thread/sleep wait))))))
    (<!! ch-main)))

(ns attercop.spider
  (:require [clojure.string :as s]
            [org.httpkit.client :as http]
            [clojure.core.async
             :refer [chan >! >!! <! <!! go thread
                     close! timeout alts!]]
            [clojurewerkz.urly.core :as urly]
            [taoensso.timbre :as timbre]
            [attercop.enlive-utils :as enlive-utils]))

(defn- normalize-href
  "Normalizes a href attribute so that it always returns an absolute
  URL. The referrer is used to absolutize the URL in case it's
  relative.

  eg.
      (normalize-href \"http://example.com\" \"/foo.html\")
      ;= http://example.com/foo.html
  "
  [referrer href]
  (urly/absolutize href referrer))

(defn- extract-hrefs
  [html-nodes]
  (->> (enlive-utils/extract-hrefs html-nodes)
       (keep identity)
       (map s/trim)))

(defn- url->domain
  [url]
  (.getHost (urly/url-like url)))

(defn- fetch-url
  [{:keys [handle-status-codes user-agent]} url]
  (letfn [(allow? [status]
            (or (and (>= status 200)
                     (< status 300))
                (handle-status-codes status)))]
    @(http/get url
               {:user-agent user-agent}
               (fn [{:keys [status body]}]
                 (if (allow? status)
                   {:url url :html body :status status}
                   (timbre/info (format "Error: [%s] %s" status url)))))))

(defn- run-scrapers
  "Takes a sequence of rules and runs the scraper function on the
  response for the first rule that matches the url. The rest of the
  rules in the sequence if any are ignored. A ':default' rule always
  matches and is expected to be the last rule in the sequence."
  [rules {:keys [url] :as resp}]
  (when-let [rule (first rules)]
    (let [[check {scrape :scrape}] rule]
      (if (or (= check :default) (re-find check url))
        (when scrape
          (scrape resp))
        (recur (rest rules) resp)))))

(defn- follow-url?
  "Checks if the given url is to be followed as per the rules. The
  first rule that matches for the url is considered and the rest are
  ignored."
  [rules url]
  (when-let [rule (first rules)]
    (let [[check {follow :follow}] rule]
      (if (or (= check :default) (re-find check url))
        (boolean follow)
        (recur (rest rules) url)))))

(defn- skip-url?
  "Checks if the url can be skipped even if the rule matched for
  it. This is the case when :scrape and :follow for the rule are both
  nil."
  [rules url]
  (when-let [rule (first rules)]
    (let [[check {:keys [scrape follow]}] rule]
      (if (or (= check :default) (re-find check url))
        (not (or scrape follow))
        (recur (rest rules) url)))))

(defn- pipe-results
  "Takes a pipeline which is a sequence of functions transforming or
  doing something with the result and pipes the result through each of
  the functions in order."
  [pipeline results]
  (doseq [result results]
    (reduce (fn [acc f] (f acc)) result pipeline)))

(defn- init-throttle
  "Takes throttle config ie. a vector of 'max-hits' to be allowed in
  the given 'interval' and sets up throttling mechanism. It returns a
  core.async channel.

  How throttling works:

  A core.async channel is created with buffer size equal to max-hits
  and go block is initiated which periodically takes elements from the
  channel, waiting for some interval which is dynamically calculated
  if the buffer is getting filled too fast.

  The main thread does a blocking push to the channel everytime
  before making the HTTP request.
  "
  [[max-hits interval]]
  (let [ch-throttle (chan max-hits)
        wait (/ interval max-hits)]
    (go (loop []
          (let [begin-ts (System/currentTimeMillis)]
            (dotimes [i max-hits]
              (alts! [ch-throttle (timeout wait)]))
            (let [diff-ts (- (System/currentTimeMillis) begin-ts)]
              (if (< diff-ts interval)
                (Thread/sleep (- interval diff-ts)))))
          (recur)))
    ch-throttle))

(let [default-config {:max-wait 5000
                      :handle-status-codes #{}
                      :rate-limit [5 3000]}]
  (defn start
    "Starts the spider as per the config. Returns a vector of
  channels:

      1. a main channel that does the scraping. The caller function
  can wait for the scraping thread to exit by blocking on this channel.

      2. the urls channel. By closing this channel, the scraper can be
  gracefully shutdown.
    "
    [{:keys [start-urls allowed-domains rules
             pipeline max-wait rate-limit]
      :as config}]
    (let [config (merge default-config config)
          ch-urls (chan)
          ch-resp (chan)
          ch-throttle (init-throttle rate-limit)
          scrape (partial run-scrapers rules)
          start-url-set (set start-urls)
          visited-urls (atom #{})
          follow? (fn [url]
                    (or (start-url-set url)
                        (follow-url? rules url)))
          skip? (fn [url]
                  (or (@visited-urls url)
                      (not (allowed-domains (url->domain url)))
                      (skip-url? rules url)))
          pipe (partial pipe-results pipeline)]
      ;; put urls into the urls channel
      (go (doseq [url start-urls]
            (>! ch-urls url)))
      ;; take urls from urls channel and put into the response channel
      (go (loop []
            (when-let [url (first (alts! [ch-urls (timeout max-wait)]))]
              (>! ch-throttle :ok)
              (thread (if-let [resp (fetch-url config url)]
                        (>!! ch-resp resp)))
              (swap! visited-urls conj url)
              (recur))))
      ;; consume the responses channel and do 2 things:
      ;; 1. scrape the urls and put then into the urls channel,
      ;; 2. apply rules and call the relevant callback fns
      [(go (loop []
             (when-let [{:keys [html url] :as resp}
                        (first (alts! [ch-resp (timeout max-wait)]))]
               (let [html-nodes (enlive-utils/html->nodes html)
                     resp (assoc resp :html-nodes html-nodes)
                     links (when (follow? url)
                             (->> (extract-hrefs html-nodes)
                                  (map (partial normalize-href url))
                                  (remove skip?)))]
                 (doseq [link links]
                   (go (>! ch-urls link)))
                 (when-let [results (scrape resp)]
                   (pipe results)))
               (recur))))
       ch-urls])))

(defn run
  "Runs the scraper as per the given config. Blocks until all urls are scraped.

  Config
  ------

    :name ; [str] human readable name for the scraper

    :allowed-domains ; [set] urls of these will only be considered.

    :start-urls ; [seq] scraping/crawling will start with these

    :rules ; [seq] A rule is a vector of two elements, 1. a regular
  expression or the keyword :default 2. a map with fields :scrape (fn)
  and :follow (bool)

    :pipeline ; [seq] functions transforming or doing something with
  the scraped results.

    :max-wait ; [integer] Timeout for the HTTP requests in ms.
  [Default: 5000]

    :rate-limit ; [vector] (Optional) eg. [m, i] which means, 'm'
  max-hits in 'i' ms [Default: [5 3000]]

    :handle-status-codes ; [set] (Optional) Additional status codes to
  be handled by the scraper besides the standard valid ones ie. 2xx.

    :graceful-shutdown? ; [bool|integer] (Optional) If non-falsy, the
  spider will be gracefully shutdown. Truthy values may be boolean or
  a number representing time to wait in milliseconds. If boolean, the
  timeout will be same as max-wait [default: 5000]
  "
  [{:keys [graceful-shutdown? max-wait]
    :as config
    :or {graceful-shutdown? 5000}}]
  (let [[ch-main ch-urls] (start config)]
    (when graceful-shutdown?
      (let [wait (if (number? graceful-shutdown?)
                   graceful-shutdown?
                   max-wait)]
        (.addShutdownHook (Runtime/getRuntime)
                          (Thread. (fn []
                                     (timbre/info "Shutting down gracefully")
                                     (close! ch-urls)
                                     (Thread/sleep wait))))))
    (<!! ch-main)))

Update docstring

Update docstring


(ns push-ups.db
  (:use [clojure.java.jdbc :only (with-connection create-table)]
        korma.db
        korma.core
        [clj-time.coerce :only (from-string)]
        [clj-time.core :only (to-time-zone time-zone-for-offset)])
  (:require clojure.pprint
            [clojure.tools.logging :as log])
  (:import java.util.UUID))

(def db (if (System/getenv "HEROKU_POSTGRESQL_RED_URL")
          (postgres {:db (System/getenv "HEROKU_POSTGRESQL_RED_URL")})
          (sqlite3 {:db "push-ups.db"})))

(defn setup
  "setup database"
  []
  (with-connection db
                   (create-table :ics_records
                                 [:permalink "varchar(15)" "PRIMARY KEY"]
                                 [:part_1_test_r :integer]
                                 [:part_1_date :datetime]
                                 [:part_2_test_r :integer]
                                 [:part_2_date :datetime]
                                 [:part_3_test_r :datetime]
                                 [:part_3_date :datetime]
                                 [:final_test_r :integer])))

(defentity ics-records
           (table :ics_records)
           (database db))

(defmacro dbsafe
  "catch errors throwed by db, avoid interruption"
  [& forms]
  (let [esym (gensym) ret (gensym)]
  `(try
     (let [~ret (do ~@forms)]
       (when (seq ~ret) ~ret))
     (catch Exception ~esym
       (do
         (log/error ~esym "db operation failed")
         false)))))

(defn gen-permalink
  "generate a unique permalink for ics-record"
  []
  (format "%x" (.hashCode (java.util.UUID/randomUUID))))

(defn- pad-string->num
  [string]
  (read-string
    (if (= (first string) \0)
      (str (last string))
      string)))

(defn from-string-tz
  "convert string into date with timezone"
  [string]
  (let [tz (re-seq #"(\+|-)(\d\d):(\d\d)" string)]
    (when-let [[_ s h m] (first tz)]
      (to-time-zone (from-string string)
                    (case s
                      "-" (time-zone-for-offset (- (pad-string->num h)) (pad-string->num m))
                      "+" (time-zone-for-offset (pad-string->num h) (pad-string->num m)))))))

(defn new-ics-record
  "create a new ics record and insert into database"
  [permalink initial-test-result start-date]
  (dbsafe
    (insert ics-records
            (values {:permalink permalink
                     :part_1_test_r initial-test-result
                     :part_1_date (str start-date)}))))

(defn get-ics-record
  "get ics record with permalink"
  [permalink]
  (dbsafe
    (->> (select ics-records
                 (where {:permalink permalink}))
      (first)
      ((fn [entity]
         (for [[k v] entity]
           (if (and v (.endsWith (str k) "date"))
             {k (from-string-tz v)}
             {k v}))))
      (into {}))))

(defn update-ics-record
  "Update ics record with specified permalink"
  [permalink values]
  (dbsafe
    (update ics-records
            (set-fields (into {} (map (fn [[k v]]
                                        (if (and v (.endsWith (str k) "date"))
                                          {k (str v)}
                                          {k v}))
                                      values)))
            (where {:permalink permalink}))))

(ns push-ups.db
  (:use [clojure.java.jdbc :only (with-connection create-table)]
        korma.db
        korma.core
        [clj-time.coerce :only (from-string)]
        [clj-time.core :only (to-time-zone time-zone-for-offset)])
  (:require clojure.pprint
            [clojure.tools.logging :as log]
            [clojure.string :as string])
  (:import java.util.UUID
           (java.net URI)))

(def db
  (if-let [url (System/getenv "HEROKU_POSTGRESQL_RED_URL")]
    (let [db-uri (java.net.URI. url)]
      (->> (string/split (.getUserInfo db-uri) #":")
           (#(identity {:db (last (string/split url #"\/"))
                        :host (.getHost db-uri)
                        :port (.getPort db-uri)
                        :user (% 0)
                        :password (% 1)
                        :ssl true}))
           (postgres)))
    (sqlite3 {:db "push-ups.db"})))

(defn setup
  "setup database"
  []
  (with-connection db
                   (create-table :ics_records
                                 [:permalink "varchar(15)" "PRIMARY KEY"]
                                 [:part_1_test_r :integer]
                                 [:part_1_date :datetime]
                                 [:part_2_test_r :integer]
                                 [:part_2_date :datetime]
                                 [:part_3_test_r :datetime]
                                 [:part_3_date :datetime]
                                 [:final_test_r :integer])))

(defentity ics-records
           (table :ics_records)
           (database db))

(defmacro dbsafe
  "catch errors throwed by db, avoid interruption"
  [& forms]
  (let [esym (gensym) ret (gensym)]
  `(try
     (let [~ret (do ~@forms)]
       (when (seq ~ret) ~ret))
     (catch Exception ~esym
       (do
         (log/error ~esym "db operation failed")
         false)))))

(defn gen-permalink
  "generate a unique permalink for ics-record"
  []
  (format "%x" (.hashCode (java.util.UUID/randomUUID))))

(defn- pad-string->num
  [string]
  (read-string
    (if (= (first string) \0)
      (str (last string))
      string)))

(defn from-string-tz
  "convert string into date with timezone"
  [string]
  (let [tz (re-seq #"(\+|-)(\d\d):(\d\d)" string)]
    (when-let [[_ s h m] (first tz)]
      (to-time-zone (from-string string)
                    (case s
                      "-" (time-zone-for-offset (- (pad-string->num h)) (pad-string->num m))
                      "+" (time-zone-for-offset (pad-string->num h) (pad-string->num m)))))))

(defn new-ics-record
  "create a new ics record and insert into database"
  [permalink initial-test-result start-date]
  (dbsafe
    (insert ics-records
            (values {:permalink permalink
                     :part_1_test_r initial-test-result
                     :part_1_date (str start-date)}))))

(defn get-ics-record
  "get ics record with permalink"
  [permalink]
  (dbsafe
    (->> (select ics-records
                 (where {:permalink permalink}))
      (first)
      ((fn [entity]
         (for [[k v] entity]
           (if (and v (.endsWith (str k) "date"))
             {k (from-string-tz v)}
             {k v}))))
      (into {}))))

(defn update-ics-record
  "Update ics record with specified permalink"
  [permalink values]
  (dbsafe
    (update ics-records
            (set-fields (into {} (map (fn [[k v]]
                                        (if (and v (.endsWith (str k) "date"))
                                          {k (str v)}
                                          {k v}))
                                      values)))
            (where {:permalink permalink}))))

fix db for heroku

fix db for heroku