(and type-node (accept-node-q type-node))
(accept-node-q accept-tree))))
+(defun q-ok (media-type accept-tree)
+ (let ((q (q media-type accept-tree)))
+ (and q (> q 0) q)))
+
(defun insert (range q tree)
(labels ((ensure-node (range tree)
(cond
\f
;;; FIXME: tiebreaker predicate (maybe defaulting to string<)?
(defclass accept-specializer (extended-specializer)
- ((media-type :initarg :media-type :reader media-type)))
+ ((media-type :initarg :media-type :type string :reader media-type)))
(defmethod print-object ((o accept-specializer) s)
(print-unreadable-object (o s :type t)
(format s "~S" (media-type o))))
(:metaclass sb-mop:funcallable-standard-class))
(define-extended-specializer accept (gf arg)
+ (declare (ignore gf))
(make-instance 'accept-specializer :media-type arg))
(defmethod sb-pcl:unparse-specializer-using-class
((gf accept-generic-function) (specializer accept-specializer))
(defmethod generalizer-of-using-class ((gf accept-generic-function) (arg tbnl:request))
(make-instance 'accept-generalizer
:header (tbnl:header-in :accept arg)
- :next (class-of arg)))
+ :next (call-next-method)))
(defmethod generalizer-equal-hash-key
((gf accept-generic-function) (g accept-generalizer))
`(accept-generalizer ,(header g)))
(defmethod specializer-accepts-generalizer-p ((gf accept-generic-function) (s accept-specializer) (generalizer accept-generalizer))
- (values (q (media-type s) (tree generalizer)) t))
+ (values (q-ok (media-type s) (tree generalizer)) t))
(defmethod specializer-accepts-generalizer-p ((gf accept-generic-function) (s accept-specializer) generalizer)
(values nil t))
(defmethod specializer-accepts-generalizer-p ((gf accept-generic-function) (s sb-mop:specializer) (generalizer accept-generalizer))
(defmethod specializer-accepts-p ((specializer accept-specializer) obj)
nil)
(defmethod specializer-accepts-p ((specializer accept-specializer) (obj tbnl:request))
- (q (media-type specializer) (parse-accept-string (tbnl:header-in :accept obj))))
+ (q-ok (media-type specializer) (parse-accept-string (tbnl:header-in :accept obj))))
(defmethod specializer< ((gf accept-generic-function) (s1 accept-specializer) (s2 accept-specializer) generalizer)
(cond
(defmethod generalizer-of-using-class ((gf accept-generic-function) (s string))
(make-instance 'accept-generalizer
:header s
- :next (class-of s)))
+ :next (call-next-method)))
(defmethod specializer-accepts-p ((s accept-specializer) (string string))
- (q (media-type s) (parse-accept-string string)))
+ (q-ok (media-type s) (parse-accept-string string)))
(defmethod handle-content-type ((x tbnl:request))
(setf (tbnl:content-type*) *actual-content-type*))