Object 为clojure中对象的特定实例创建代理
我正在尝试创建一个代理对象,该对象使用闭包(let/proxy)为对象的某些方法添加一些功能。我可以这样做,不幸的是,我不得不从原始对象重新编写所有方法。我得到一个不受支持的保留异常。以下是一个示例: ;; 实物Object 为clojure中对象的特定实例创建代理,object,proxy,clojure,instance,Object,Proxy,Clojure,Instance,我正在尝试创建一个代理对象,该对象使用闭包(let/proxy)为对象的某些方法添加一些功能。我可以这样做,不幸的是,我不得不从原始对象重新编写所有方法。我得到一个不受支持的保留异常。以下是一个示例: ;; 实物 (def realcon (java.sql.DriverManager/getConnection "jdbc:h2:tcp://localhost:9092/test")) (def con (let [msg "FG>" xcon rcon
(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,我可以手动代理所有方法,但可能有更好的方法
谢谢我刚刚写了我一生中最荒谬的宏来支持这个功能。可能有一个更简单的方法——如果我能想出一个,我一定会发布它——但这给了我一种冷静、烦躁的感觉,而且实际上似乎很有效,所以。。。来吧 编辑:这里有一个更简单的方法;定义一个函数,返回一个常规的
代理
,该函数委托所有方法(手工编写或自动创建它--委托代理
的代码包含这样做的方法),在单个实例上使用更新代理
,只替换需要替换的方法。这显然没有疯狂宏那么酷,因此后者将保持在下面
这是一种新的简化方法(由于位置参数计数限制和varargs存在一些问题,因此仍不十分清楚):
委托代理
接受一个对象,当调用该对象以执行未显式实现的方法时,该对象将被委托,该方法后跟常规的代理
参数
第二,代码。我认为可以肯定的是,这里潜伏着各种各样的缺陷。实际上,它的大致形状就在那里;没有潜伏。如果它对某人足够有用,那么它可能会被测试并改进为某种程度的可靠健壮性
比较容易阅读
(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))))))
(defmacro委托代理[o类和ifaces-actor-args&impls]
(让[oname(gensym)]
(letfn[(委托执行[^java.lang.reflect.Method ms]
(让[mname(符号(.getName^java.lang.reflect.Method(第一个ms)))
算术组(按#(计数(.getParameterTypes^java.lang.reflect.Method%))ms划分)
最大arity(最大键#(计数(.getParameterTypes^java.lang.reflect.Method%))ms)
`(~mname)
~@(删除)
无
(地图(fn[agroup]
(让[param-types(.getParameterTypes^java.lang.reflect.Method(first-Up))
vararg?(and(seq param types)(或(.isArray^Class(last param types))(非常感谢您看到您的答案我学到了很多,然后我发现了一些小错误
在函数委托impls中,参数是一个方法对象数组,类型转换是错误的。这意味着max arity不是一个数字,并且不包含最大arity
这让我理解了与de varargs有关的代码,并意识到java(…)中的var arg构造函数将las参数预设为数组,问题是对象有一个方法,例如有2个参数,另一个方法有一个参数后跟一个vararg(…)最后,我们得到了两个相同arity的方法,委托代理宏的代码从未进入:
(如果不是(并且vararg?(not=arity max arity))因为max arity不是一个数字!所以代理对象会忽略任何将数组作为最后一个参数的方法
这花费了我对委托代理进行了重写,我最终得到了以下代码,如果没有vararg(…)参数,这些代码可以正常工作,否则代理实现将不包括这些方法
代码如下:
现在就这些,再次感谢非常聪明的宏
Saludos这里有一种替代方法,使用具体化而不是代理
,因为根据,它“在其约束条件不受禁止的所有情况下都更可取。”
override delegate
宏希望主体包含要重写的方法的reify
规范。任何未重写的规范都将在委托上调用。宏生成的所有reify
规范将包括每个方法参数和返回值的类型提示
我的实现有一个警告:它只检查主体中的方法名称,忽略重载方法的参数arity/type。因此在上面的示例中,java.sql.Connection
接口提供了多个createStatement
重载,所有接受参数的方法都不会被定义为重载con
。扩展宏以解释重载并不太困难,但当我需要此行为时,我通常必须覆盖所有这些行为。非常好,谢谢!我最终需要支持多个接口,这是对代码的一个相对较小的更改。将第一个参数名称复数化后,只需s/(.getMethods(resolve type))/(mapcat#(.getMethods(resolve%))类型)/
和s/~type/~@types/
。
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
(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))))))
(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 !
(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)))))