Hi Leslie,
Sorry, I didn't see your reply as I wasn't subscribed. We're now
updating the web front end for our application again, and I managed to
dig up the reply on google groups. Hopefully I'm now subscribed too.
"Leslie P. Polzer" <[email protected]> writes:
>> Very rough and ready.
>
> Then it's at least a candidate for contrib/ right away.
You're welcome to it, for what it is.
>> The worst part about this is overwriting the object-id method
>> completely.
>
> Fair enough.
>
>
>> Suggestions and whatnot welcome -- it works for our small mock up
>
> This first approximation is suprisingly simple. How do you
> add new objects (or prevent new instances from getting added
> automatically)?
I didn't consider that, evidently ;-)
At the moment our web interface only displays things. It cannot actually
modify them. The interface is therefore correspondingly basic.
>> but we're not sure if we'll stay with weblocks
>
> Can we help you in your decision process?
>
> In any case I'd be glad to know with what you will end up
> and what influenced your decision.
Frankly the reason I chose weblocks was the awesome i-search bar.
To my horror, now we are updating the application again for more
intensive use and I wanted to put in the isearch, I discover that it is
now disabled! How can I enable i-search? Do you have an example of it
for any backend?
>> (our program is mostly for generating lots of RRD graphs -- if you
>> want an example of doing that with weblocks I can send it along).
>
> Yes please. I have a personal interest in such a thing and it would
> probably also make a nice additional demo.
Well here's the rather preliminary weblocks relevant code. I'm sure
you'd be able to figure out a much better way of doing it and I'd
appreciate any hints on a more weblocksy way to go about it.
If you're really interested I can ask my boss if we can release some of
the brains of it (the stuff in netstatus.manager is proprietary
unfortunately).
(defun graph-tmp-path ()
(merge-pathnames "tmp/" (compute-public-files-path :weblocks)))
(defvar *graph-tmp-html-path* "/pub/tmp/")
(defun clean-graph-tmp-path ()
(ensure-directories-exist (graph-tmp-path))
(loop for file in (directory (merge-pathnames "*" (graph-tmp-path)))
do (when (> (- (get-universal-time) (file-write-date file)) 300)
(delete-file file))))
(defun router-graph-show (k router)
(let ((counter 0))
(flet ((gen-filename ()
(format nil "tmp-router-~D-~D.png" (random 100000) (incf
counter))))
(clean-graph-tmp-path)
(labels ((graph-router (router)
(let ((graphs (netstatus.manager::sourcegroup-graphs router)))
(when graphs
(let ((files
(loop for g in graphs collect (gen-filename))))
(loop for g in graphs
for f in files
do (netstatus.manager::generate-graph g router
(merge-pathnames f (graph-tmp-path))))
(with-html
(:h2 (str (netstatus.manager::title router))))
(loop for f in files
for g in graphs do
(with-html
(:div
(:h3 (str (netstatus.manager::graph-def-title
g)))
(:img :src (concatenate 'string (string
*graph-tmp-html-path*) f)))))
(typecase router
(netstatus.manager::router
(loop for if in (netstatus.manager::router-interfaces
router) do
(graph-router if)))))))))
(graph-router router))))
(render-link
(lambda(&rest args)
(declare (ignore args))
(answer k)) "Back"))
(defun router-graph (obj router)
(declare (ignore obj))
(do-page
(lambda(k)(router-graph-show k router))))
(defun make-routers-page ()
(make-instance 'composite :widgets
(list
(make-instance 'datagrid
:on-drilldown '(graph . router-graph)
:name 'routers-grid
:data-class 'router
:view 'router-table-view
:item-data-view 'router-data-view
:item-form-view 'router-form-view))))
>
>
> Some things I noticed:
>
>> (defgeneric strictly-less-p (a b)
>> (defgeneric equivalentp (a b)
>> (defun order-objects-in-memory (seq order-by)
>> (defun range-objects-in-memory (seq range)
>
> Did you copy those from the memory store?
Yes.
> We should really make this available for all stores
> in store-utils.lisp.
Yes, that would definitely be a good idea. I notice the elephant
backend just ::'s the symbols from weblocks-memory.
>> (defmethod find-persistent-objects ((store db.allegrocache::database)
>> class-name &key
>> order-by range &allow-other-keys)
>> (order-objects-in-memory
>> (range-objects-in-memory
>> (let (val)
>> (let ((db.allegrocache:*allegrocache* store))
>> (db.allegrocache:doclass* (x (find-class class-name))
>> (push x val)))
>> val) range) order-by))
>
> I suppose we'd want to delegate ordering and ranging to AC later
> for efficiency...
It turns out that the network AllegroCache wasn't very suitable for the
usage we need (frequent modifications involving all objects in the
database), and we've been using anardb.
http://cl-www.msi.co.jp/projects/anardb/index.html
I basically copied the old code I had with allegrocache for the database
link.
--~--~---------~--~----~------------~-------~--~----~
You received this message because you are subscribed to the Google Groups
"weblocks" group.
To post to this group, send email to [email protected]
To unsubscribe from this group, send email to
[email protected]
For more options, visit this group at
http://groups.google.com/group/weblocks?hl=en
-~----------~----~----~----~------~----~------~--~---
(in-package #:weblocks)
(macrolet ((define-class-store-for-all-anardb-classes ()
`(progn
,@(loop for class-name in (mapcar 'class-name
(moptilities:subclasses 'anardb:store-object))
collect `(defmethod class-store ((name (eql
',class-name))) :anardb)))))
(define-class-store-for-all-anardb-classes))
(defmethod object-id ((obj anardb:store-object))
(anardb:store-object-id obj))
(defmethod count-persistent-objects ((store (eql :anardb))
class-name &key &allow-other-keys)
(let ((val 0))
(anardb:do-all-instances (x class-name)
(incf val))
val))
(defmethod find-persistent-object-by-id ((store (eql :anardb))
class-name id)
(anardb:retrieve-instance-by-id class-name id))
(defgeneric strictly-less-p (a b)
(:documentation
"Returns true if 'a' is strictly less than 'b'. This function is
used by the framework for sorting data.")
(:method (a b)
(strictly-less-p (format nil "~A" a) (format nil "~A" b)))
(:method ((a number) (b number))
(< a b))
(:method ((a string) (b string))
(not (null (string-lessp a b))))
(:method ((a null) (b null))
nil)
(:method (a (b null))
t)
(:method ((a null) b)
nil))
(defgeneric equivalentp (a b)
(:documentation
"Returns true if 'a' is in some sense equivalent to 'b'. This
function is used by the framework for sorting data.")
(:method (a b)
(equalp a b)))
(defun order-objects-in-memory (seq order-by)
"Orders objects in 'seq' according to 'order-by'."
(if (and seq
order-by)
(stable-sort seq
(if (equalp (cdr order-by) :asc)
#'strictly-less-p
(lambda (a b)
(and (not (strictly-less-p a b))
(not (equivalentp a b)))))
:key (curry-after #'slot-value-by-path (car order-by)))
seq))
;;;;;;;;;;;;;
;;; Range ;;;
;;;;;;;;;;;;;
(defun range-objects-in-memory (seq range)
"Selects only the objects in 'range' from 'seq'."
(if (and seq
range)
(let ((len (length seq)))
(subseq seq (min len (car range)) (min len (cdr range))))
seq))
(defmethod find-persistent-objects ((store (eql :anardb)) class-name &key
order-by range &allow-other-keys)
(order-objects-in-memory
(range-objects-in-memory
(anardb:retrieve-all-instances class-name) range) order-by))
