【问题标题】:Create a proxy for an specific instance of an object in clojure在 clojure 中为对象的特定实例创建代理
【发布时间】:2012-02-23 14:35:30
【问题描述】:

我正在尝试创建一个代理对象,为对象的某些方法添加一些功能,使用闭包(let / proxy)我可以做这件事,不幸的是我不得不重新编写所有方法原始对象 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"))

如果我从 java.sql.Connection 调用任何其他方法,我会得到 UnsupportedOperationException 我可以手动代理所有方法,但可能有更好的方法!。

谢谢

【问题讨论】:

    标签: object proxy clojure instance


    【解决方案1】:

    这里有一个使用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 中的方法 names,忽略重载方法的参数 arity/type。所以在上面的例子中,java.sql.Connection 接口提供了多个createStatement 重载,不会为con 定义任何接受参数的重载。扩展宏以解决重载问题并不太难,但是当我需要这种行为时,我通常必须覆盖所有这些行为。

    【讨论】:

    • 太好了,谢谢!我最终需要对多个接口的支持,这对您的代码来说是一个相对较小的更改。将第一个参数名称复数后,只需 s/(.getMethods (resolve type))/(mapcat #(.getMethods (resolve %)) types)/s/~type/~@types/
    【解决方案2】:

    我刚刚编写了我一生中最荒谬的宏来支持这个功能。可能有一种更简单的方法——如果我能想到一个,我一定会发布它——但这给了我一种很酷、很迷幻的感觉,而且实际上似乎很有效,所以……就这样吧。

    编辑:这是一个更简单的方法;定义一个返回常规 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))))))
    

    【讨论】:

      【解决方案3】:

      非常感谢你看到你的回答我学到了很多,然后我发现了一些小错误。

      1. 在delegating-impls函数中,参数是Method对象的数组,做类型转换是错误的。这意味着 max-arity 不是一个数字,也不包含最大的 arity。

      这让我理解了与 de varargs 相关的代码。并意识到 java (...) 中的 var arg 构造函数将 las 参数预设为一个数组,问题是该对象有一个方法,例如 2 个参数,另一种方法,一个参数后跟一个 vararg (. ..) 我们最终得到了 2 个相同数量的方法,委托代理宏的代码永远不会进入: (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 !

      暂时就这些了,再次感谢非常聪明的宏!

      感谢

      【讨论】:

        猜你喜欢
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 2012-05-10
        • 2019-02-26
        • 2012-08-04
        • 2016-05-23
        • 2018-01-02
        • 1970-01-01
        相关资源
        最近更新 更多