gen-sproc.clj

gistfile1.clj

(ns iws-oracle.defsproc.generate
  (:require [clojure.java.jdbc :as jdbc]
            [clojure.string :as str]
            [schema.core :as s]
            [schema.macros :as sm]
            [iws-oracle.defsproc :refer :all]
            [iws-oracle.test.core-test :as ct]))

(def args-sql (str "select * from all_arguments where lower "
                   "(object_name) = lower (?)"))

(def args-schema
  [(->> {:owner s/Str
         :object-name s/Str
         :package-name s/Str
         :object-id s/Num
         :overload s/Str
         :subprogram-id s/Num
         :argument-name s/Str
         :position s/Num
         :sequence s/Num
         :data-level s/Num
         :data-type s/Str
         :defaulted s/Str
         :default-value  s/Str
         :default-length s/Num
         :in-out s/Str
         :data-length s/Num
         :data-precision s/Num
         :data-scale s/Num
         :radix s/Num
         :character-set-name s/Str
         :type-owner s/Str
         :type-name s/Str
         :type-subname s/Str
         :type-link s/Str
         :pls-type s/Str
         :char-length s/Num
         :char-used s/Str}
        (map (juxt key #(s/either (s/pred nil?) (val %))))
        (into {}))])

(defmacro with-conn
  "
  Convenience macro for testing execution of def-sproc fns. Makes a connection
  to the metadata's :schema, executes exp with connection as last argument.

  Ex: (gen/with-conn (p-dgetuserbyemail \"[email protected]\"))
  "
  [[def-sproc-fn & args]]
  `(let [db-user# (:schema (meta ~def-sproc-fn))]
     (jdbc/with-connection (ct/get-db-spec db-user#)
       (apply ~def-sproc-fn (conj (vector ~@args) (jdbc/connection))))))

(defn sanitize
  "Foo_Bar => foo-bar"
  [w]
  (some-> w str/lower-case (str/escape {\_ \-})))

(def sanitize-kw (comp keyword sanitize name))

(sm/defn ^:always-validate select-args :- args-schema
  [fn-or-proc-name :- s/Str
   db-user :- s/Keyword]
  (jdbc/with-connection (ct/get-db-spec db-user)
    (with-open [stmt (.prepareStatement (jdbc/connection) args-sql)]
      (doto stmt
        (.setString 1 (str/lower-case fn-or-proc-name))
        (.execute))
      (->> stmt 
           .getResultSet
           resultset-seq
           (map #(map (juxt (comp sanitize-kw key) val) %))
           (map (partial into {}))
           doall))))

(defn fn-return?
  [arg-map]
  (zero? (:position arg-map)))

(defn arg->param
  "Turn an arg map into the map needed by def-sproc form for :params, :returns.
   Also has a :return? element, to indicate whether this is a parameter (in or
   out, or a return value."
  [arg]
  {:name (or (some-> arg :argument-name sanitize-kw) (-> (gensym) name keyword))
   :type (case (:data-type arg)
           "VARCHAR2" :string
           "NUMBER" :int
           "DATE" :date
           "REF CURSOR" :cursor
           :else (throw (ex-info "invalid :date-type" arg)))
   :output (= (:in-out arg) "OUT")
   :return? (fn-return? arg)})

(defn args->params
  "Turn an unsorted seq of arg maps into a sorted vector of def-sproc params."
  [args]
  (->> args
       ;; Start removing duplicates
       (group-by :object-id)
       (first)
       (val)
       ;; Done w/ duplicates
       (sort-by :sequence)
       (map arg->param)
       (vec)))

(defn gen-def-sproc-map
  "
  Generates the def-sproc spec map of a proc or fn.

  Ex: => (gen/gen-def-sproc-map \"f_ihasrole\" :webicon)

  {:sproc \"webicon.f_ihasrole\",
   :params [{:name \"i-iuserid\", :type :int, :output false}
            {:name \"i-srole\", :type :string, :output false}],
   :returns [{:name \"G__4864\", :type :int, :output true}]}
  "
  [fn-or-proc-name db-user]
  (let [params (args->params (select-args fn-or-proc-name db-user))]
    {:sproc (str (name db-user) "." fn-or-proc-name)
     :params (vec (filter (complement :return?) params))
     :returns (vec (filter :return? params))}))

(defn gen-def-sproc
  "
  Generates the def-sproc form for a proc or fn.

  Ex: => (eval (gen/gen-def-sproc \"p_dgetuserbyemail\" :webicon))
      => ;; Test the fn
      => (gen/with-conn (p-dgetuserbyemail \"[email protected]\"))

  [({:userid 302597M ... })]
  "
  [fn-or-proc-name
   db-user]
  (let [def-sproc-map (gen-def-sproc-map fn-or-proc-name db-user)
        params (->> def-sproc-map
                    ((juxt :params :returns))
                    (apply concat))
        outputs (map (comp symbol name :name) (filter :output params))
        inputs (map :name (filter (complement :output) params))]
    (let [def-sproc-name (-> fn-or-proc-name sanitize symbol)]
      `(do (def-sproc ~def-sproc-name ~def-sproc-map [~@inputs]
             [~@outputs])
           (def ~def-sproc-name
             (with-meta ~def-sproc-name {:schema ~db-user}))))))