在clojure中爲對象的特定實例創建代理

Question

我想創建一個代理對象，它使用閉包（讓/代理）爲對象的某些方法添加一些功能，我可以做這件事，不幸的是，我希望重新編寫原始對象的所有方法o我得到一個UnsupportedOpretationException這裏是一個例子： ;;真正的對象

(def realcon (java.sql.DriverManager/getConnection "jdbc:h2:tcp://localhost:9092/test")) 


(def con 
    (let [msg "FG>" 
      xcon rcon] 
     (proxy [java.sql.Connection] [] 
      (createStatement [] 
       (println msg) ;; access to closure context ! 
       (.createStatement xcon))))) 

(def stmt (.createStatement con)) 
;;output FG> 

(def rs (.executeQuery stmt "select count(*) from serie_sat")) 

如果我invoque從java.sql.Connection中的任何其他方法，我得到UnsupportedOperationException異常我可以自己動手完成的所有方法的代理，但可能有一個尤爲明顯的方式！

謝謝

Answer 1

我剛寫了我生命中最荒謬的宏來支持這個功能。可能有一種更簡單的方法 - 如果我能想到它，我一定會發布它 - 但是這給了我一種很酷，很狡猾的感覺，而且實際上似乎工作，所以...在這裏。

編輯：這是一個更簡單的方法;定義一個函數返回一個代表所有方法的常規代碼proxy（手工編寫或自動創建 - 代碼delegating-proxy包含一種方法），在個別實例上使用update-proxy來替換需要替換的方法。這顯然不如瘋狂的宏觀，所以後者應該保持在低於。

這裏是新的，簡化的方法（仍然不是非常清楚，由於與位置參數的數量限制一些問題和可變參數）：

;;; delegates all methods 
(defmacro delegating-proxy [o class-and-ifaces ctor-args] 
    (let [oname (gensym) 
     impls (->> class-and-ifaces 
        (map resolve) 
        (mapcat #(.getDeclaredMethods ^Class %)) 
        (group-by #(.getName ^java.lang.reflect.Method %)) 
        (vals) 
        (map (fn delegating-impls [^java.lang.reflect.Method ms] 
          (let [mname (symbol (.getName ^java.lang.reflect.Method (first ms))) 
           arity-groups (partition-by #(count (.getParameterTypes ^java.lang.reflect.Method %)) ms) 
           max-arity (max-key #(count (.getParameterTypes ^java.lang.reflect.Method %)) ms)] 
          `(~mname 
           ~@(remove 
           nil? 
           (map (fn [agroup] 
             (let [param-types (.getParameterTypes ^java.lang.reflect.Method (first agroup)) 
               vararg? (and (seq param-types) (or (.isArray ^Class (last param-types)) (<= 20 (count param-types)))) 
               arity ((if vararg? dec identity) (count param-types)) 
               params (vec (repeatedly arity gensym)) 
               params (if vararg? (conj params '& (gensym)) params)] 
              (when-not (and vararg? (not= arity max-arity)) 
              (list params `(. ~oname (~mname ~@params)))))) 
             arity-groups)))))))] 
    `(let [~oname ~o] 
     (proxy ~class-and-ifaces ~ctor-args ~@impls)))) 

一個演示：

user> (def p (delegating-proxy (fn [& args] :foo) [clojure.lang.IFn] [])) 
#'user/p 
user> (update-proxy p {"applyTo" (fn [& args] :bar)}) 
#<Object$IFn$4c646ebb user.proxy$java.lang.Object$IFn$4c646ebb@1c445f88> 
user> (p 1) 
:foo 
user> (apply p (seq [1])) 
:bar 

---

編輯：原始宏如下。

首先，一個演示：

user> (.invoke (delegating-proxy (fn [x y] (prn x y)) 
       [clojure.lang.IFn] [] 
       (invoke [x] :foo)) 
       :bar) 
:foo 
user> (.invoke (delegating-proxy (fn [x y] (prn x y)) 
       [clojure.lang.IFn] [] 
       (invoke [x] :foo)) 
       :bar :quux) 
:bar :quux 
nil 

delegating-proxy接受對象，將通過在呼籲執行不顯式實現其次是定期proxy參數的方法將其委託。

二，代碼。我認爲可以肯定的是，潛藏在那裏的各種缺陷都是存在的。其實它的一般形狀就在那裏;沒有潛伏。如果對某人來說足夠有用，它可能會被測試&改進到一定程度的保證健壯性。

The Gist比較容易閱讀。

(defmacro delegating-proxy [o class-and-ifaces ctor-args & impls] 
    (let [oname (gensym)] 
    (letfn [(delegating-impls [^java.lang.reflect.Method ms] 
       (let [mname (symbol (.getName ^java.lang.reflect.Method (first ms))) 
        arity-groups (partition-by #(count (.getParameterTypes ^java.lang.reflect.Method %)) ms) 
        max-arity (max-key #(count (.getParameterTypes ^java.lang.reflect.Method %)) ms)] 
       `(~mname 
        ~@(remove 
        nil? 
        (map (fn [agroup] 
          (let [param-types (.getParameterTypes ^java.lang.reflect.Method (first agroup)) 
            vararg? (and (seq param-types) (or (.isArray ^Class (last param-types)) (<= 20 (count param-types)))) 
            arity ((if vararg? dec identity) (count param-types)) 
            params (vec (repeatedly arity gensym)) 
            params (if vararg? (conj params '& (gensym)) params)] 
           (when-not (and vararg? (not= arity max-arity)) 
           (list params `(. ~oname (~mname ~@params)))))) 
          arity-groups))))) 
      (combine-impls [eimpls dimpls] 
       (map (fn [e d] 
        (let [e (if (vector? (second e)) 
           (list (first e) (next e)) 
           e)] 
         (list* (first e) (concat (next e) (next d))))) 
        eimpls 
        dimpls))] 
     (let [klass (resolve (first class-and-ifaces)) 
      methods (->> class-and-ifaces 
         (map resolve) 
         (mapcat #(.getDeclaredMethods ^Class %))) 
      eimpl-specs (set (map (juxt first (comp count second)) impls)) 
      rm-fn (fn rm-fn [^java.lang.reflect.Method m] 
         (contains? eimpl-specs [(symbol (.getName m)) (count (.getParameterTypes m))])) 
      dimpls (->> methods 
         (remove rm-fn) 
         (remove #(let [mods (.getModifiers ^java.lang.reflect.Method %)] 
            (or (java.lang.reflect.Modifier/isPrivate mods) 
             (java.lang.reflect.Modifier/isProtected mods)))) 
         (sort-by #(.getName ^java.lang.reflect.Method %)) 
         (partition-by #(.getName ^java.lang.reflect.Method %)) 
         (map delegating-impls)) 
      dimpl-names (set (map first dimpls)) 
      eimpl-names (set (map first eimpl-specs)) 
      {eonly false eboth true} (group-by (comp boolean dimpl-names first) impls) 
      {donly false dboth true} (group-by (comp boolean eimpl-names first) dimpls) 
      all-impls (concat eonly donly (combine-impls eboth dboth))] 
     `(let [~oname ~o] 
      (proxy ~class-and-ifaces ~ctor-args 
      ~@all-impls)))))) 

Answer 2

非常感謝您通過查看您的答案讓我學到了很多，然後我發現了一些小錯誤。

1. 在函數delegating-impls中，該參數是一個Method對象的數組，該對象的類型cast是錯誤的。這意味着最大值不是一個數字，也不包含最大值。

這讓我理解了與de varargs有關的代碼。並認識到在Java中的var arg構造函數（...）將las參數預先設置爲一個數組，問題是該對象有一個方法，例如2個參數，另一個方法帶有一個參數，然後是可變參數（...），最後我們得到2個相同的方法arity，委託代理宏的代碼永遠不會輸入： （when-not（and vararg？（not = arity max-arity）），因爲max-arity不是數字！所以代理對象省略了任何帶數組的方法作爲最後一個參數

這讓我重寫了委託代理，並且結束了以下代碼，如果沒有可變參數（vararg（...）參數，那麼工作正常，否則此方法將不會由代理執行覆蓋

這裏是代碼：

 

(defmacro instance-proxy [obj mtd-re-filter pre-func post-func] 
    (let [cls (class (eval obj)) 
      interfaces (.getInterfaces cls) 
      ifaces (into [] (map #(symbol (.getName %)) interfaces)) 
      oname (gensym) 
      info (gensym) 
      impls (->> ifaces 
        (map resolve) 
        (mapcat #(.getDeclaredMethods ^Class %)) 
        (group-by #(.getName ^java.lang.reflect.Method %)) 
        (vals) 
        (map (fn delegating-impls [ms] ;; ms is an array of "Method" objects 
           (let [mname (symbol (.getName ^java.lang.reflect.Method (first ms))) 
            arity-groups (partition-by #(count (.getParameterTypes ^java.lang.reflect.Method %)) ms)] 
            `(~mname 
            ~@(remove 
             nil? 
             (map (fn [agroup] 
               (let [param-types (.getParameterTypes ^java.lang.reflect.Method (first agroup)) 
                 arity (count param-types) 
                 vararg? (and 
                    (seq param-types) 
                    (.isArray ^Class (last param-types))) 
                 params (vec (repeatedly arity gensym))] 
                (when-not vararg? 
                 (if (re-matches mtd-re-filter (name mname)) 
                  (list params 
                   `(swap! ~info ~pre-func) 
                  `(let [result# (. ~oname (~mname ~@params))] 
                    (swap! ~info ~post-func) 
                    result#)) 
                  (list params `(. ~oname (~mname ~@params))))))) 
              arity-groups)))))))] 
     `(let [~oname ~obj 
       ~info (atom {})] 
      (proxy ~ifaces [] ~@impls)))) 

;;The code abobe is used like so: 

(defn pre-test [m] 
     (println "ejecutando pre") 
     (assoc m :t0 (System/currentTimeMillis))) 

(defn post-test [m] 
     (println "ejecutando post " m) 
     (let [now (System/currentTimeMillis) 
       mm (assoc m :t1 now :delta (- now (:t0 m)))] 
       (println mm) 
       mm)) 

(def rcon (java.sql.DriverManager/getConnection "jdbc:h2:tcp://localhost:9092/test")) 

(def pcon (instance-proxy rcon #"prepareStatement" pre-test post-test)) 

(def stmt (.prepareStatement pcon "select * from SERIE_SAT")) 



;;ejecutando pre 
;;ejecutando post {:t0 1330046744318} 
;;{:delta 3, :t1 1330046744321, :t0 1330046744318} 
;;#'mx.interware.analyzer.driver/stmt 

;;Here we obtain the statistics in a non-intrusive way wich was the objective of this code ! 

這就是所有的現在，再次感謝非常聰明的宏！

Saludos

Answer 3

下面是使用reify代替自proxy的替代，根據本docs，它的「在其約束不是禁止所有情況下優選的。」

(defmacro override-delegate 
    [type delegate & body] 
    (let [d (gensym) 
     overrides (group-by first body) 
     methods (for [m (.getMethods (resolve type)) 
         :let [f (-> (.getName m) 
           symbol 
           (with-meta {:tag (-> m .getReturnType .getName)}))] 
         :when (not (overrides f)) 
         :let [args (for [t (.getParameterTypes m)] 
            (with-meta (gensym) {:tag (.getName t)}))]] 
        (list f (vec (conj args 'this)) 
        `(. ~d ~f ~@(map #(with-meta % nil) args))))] 
    `(let [~d ~delegate] 
     (reify ~type ~@body ~@methods)))) 


;; Modifying your example slightly... 
(def realcon (java.sql.DriverManager/getConnection "jdbc:h2:tcp://localhost:9092/test")) 
(def con 
    (let [msg "FG>"] 
    (override-delegate java.sql.Connection realcon 
     (createStatement [this] 
     (println msg) 
     (.createStatement realcon))))) 

的override-delegate宏觀預期身體包含您想覆蓋的方法的reify規格。任何你不重寫的代碼都會被調用。所有由該宏生成的reify規範將包括每個方法參數和返回值的類型提示。

我的實現有一個警告：它只檢查方法名稱在body中，忽略重載方法的參數arity/type。所以在上面的示例中，java.sql.Connection接口提供了多個createStatement重載，但那些接受參數的接口將不會被定義爲con。擴展宏以解決重載問題不會太困難，但是當我需要這種行爲時，我通常不得不重寫所有這些。