[Bese-devel] Small announcement (ucw tutorial)
Vladimir Sekissov
svg at surnet.ru
Tue Mar 14 13:44:10 UTC 2006
Good day, Friedrich,
frido> Well people have blamed me for quite a few things, for
frido> good or bad reason. Altough I do not feel up to the task understanding
frido> UCW really, I've started to write a tutorial (actual) about it.
frido> It's not much there but I hope that I will get to some point within
frido> the next 2 or so hours. I have not idea on how much time I'll spend on
frido> it, because other things are more important. I find that ucw is the
frido> "rigth" thing to some extend, that I disagree with quite a few things
frido> it a personal problem. I though about setting up a wiki myself but
frido> decided to use cliki instead. So if you are interested on how someone
frido> has approached and understand UCW (not from the inner developers
frido> circle) then feel fee to visit the pages at:
frido> http://www.cliki.net/ucw%20Tutorial
frido>
frido> They are just in their infancy and more rough then good. But I'll try
frido> to polish them over time, if you feel you should add something, do so
frido> it's a Wiki ;-)
Thank you for the useful initiative.
I have some tips how to use CLSQL with UCW about.
It is surprisingly not very easy to use stateful concurent application
with CLSQL.
To avoid conflicts on access to database it would be good idea to use
fresh connection every time and rewrite clsql-sys::view-database
method the following way:
(defmethod clsql-sys::view-database ((obj clsql:standard-db-object))
"In web environment we can't rely on database OBJ was retrieved with.
It can be used by another thread at this time.
Assume that user always set clsql:*default-database* to right value."
(when (call-next-method)
clsql:*default-database*))
I wrote a package DATA-SRC to simplify database access using pooling
connections. It also takes care about reconnection after database
lost.
It is in attachment.
Usage:
(defvar *mydb-src*
(data-src:parse-src-uri "postgresql://username:password@localhost/mydb:5432"))
;; locally bind clsql:*default-databse* to fresh pooling connection
(data-src:with-connection (nil *mydb-src*)
...
(data-src:with-transaction (*mydb-src*)
...))
;; or both in one macro
(data-src:with-commit (nil *mydb-src*)
...)
;; CLSQL uses lazy policy on handling one-to-many join slots
;; Wrap rendering of components which use CLSQL objects with
;; connection
(defmethod ucw:render :wrap-around ((c my-db-component))
(data-src:with-connection (nil *mydb-src*)
(call-next-method)))
Best Regards,
Vladimir Sekissov
-------------- next part --------------
(in-package :cl-user)
(require :cl-ppcre)
(require :arnesi)
(require :clsql)
(require :ftp)
(defpackage :data-src
(:use :cl
:it.bese.arnesi
:puri
:wsutil)
(:export :data-src
:sql-src
:src-scheme
:parse-src-uri
:connection-spec
:default-connection
:connect
:disconnect
:connection
:insert-record
:update-record
:write-record
:delete-record
:with-connection
:with-transaction
:with-commit
))
(in-package :data-src)
(defvar *data-src-scheme->class-table*
(make-hash-table))
(defclass data-src (puri:uri)
((username :accessor username
:initarg :username
:initform ""
:documentation "")
(password :accessor password
:initarg :password
:initform ""
:documentation "")
(options :accessor options
:initarg :options
:initform nil
:documentation "")
(connection-variable :accessor connection-variable
:initarg :connection-variable
:allocation :class
:initform nil
:documentation
"Name of dynamic variable open connection to data source
is set to by default where place is desired."))
(:documentation "Data source specification."))
(defmethod src-scheme ((ds data-src))
(puri:uri-scheme ds))
(defun data-src-scheme-class (scheme)
(aif (gethash scheme *data-src-scheme->class-table*)
(find-class it)
(error "couldn't find data src for scheme ~a" scheme)))
(defsetf data-src-scheme-class (scheme) (class)
`(setf (gethash ,scheme *data-src-scheme->class-table*) ,class))
(let ((uri-regexp (ppcre:create-scanner "^(\\w+://)(\\w+):(\\w+)@(.*)")))
(defun parse-src-uri (src-uri &rest initargs)
(declare (type string src-uri))
(let (username password)
(ppcre:register-groups-bind (scheme user pass path)
(uri-regexp src-uri)
(setf src-uri (strcat scheme path)
username user
password pass))
(let ((ds (puri:parse-uri src-uri :class 'data-src)))
(apply #'change-class
ds
(data-src-scheme-class (puri:uri-scheme ds))
(plist-union initargs (list :username username :password password)))
ds))))
(defgeneric connect (data-src &key &allow-other-keys)
(:method ((uri string) &rest args)
(multiple-value-bind (uri-args conn-args)
(split-plist (rcurry #'member '(:username :password :options)) args)
(apply #'connect (apply #'parse-src-uri uri uri-args) conn-args)))
(:documentation "Connect to data source DATA-SRC.
If DATA-SRC is a string then create data-src object before.
Returns data source."))
(defgeneric disconnect (connection)
(:documentation "Disconnect from data source CONNECTION."))
(defgeneric default-connection (data-src)
(:documentation "Returns default connection DATA-SRC associated with.")
(:method ((ds data-src))
(symbol-value (connection-variable ds))))
(defmethod (setf default-connection) (new (ds data-src))
(setf (symbol-value (connection-variable ds)) new))
(defgeneric update-record (connection dest key-alist attr-alist)
(:documentation "Update record in DEST corresponding to KEY-ALIST
from ATTR-ALIST using CONNECTION.
Returns T on success."))
(defgeneric insert-record (connection dest attr-alist)
(:documentation "Insert record ATTR-ALIST into DEST using CONNECTION."))
(defgeneric delete-record (connection dest key-alist)
(:documentation "Delete record from DEST corresponding to KEY-ALIST
using CONNECTION.
Returns T on success."))
(defgeneric with-data-transaction (connection function)
(:method ((ds data-src) function)
(with-slots (connection-variable) ds
(assert connection-variable ()
"Data source ~a doesn't provide connection variable name" ds)
(with-data-transaction (symbol-value connection-variable) function)))
(:documentation "Execute FUNCTION using CONNECTION transactional context."))
(defmacro with-connection ((conn-var data-src &rest conn-args) &rest body)
"Create connection to DATA-SRC, bind it to CONN-VAR variable,
execute BODY and disconnect after. If CONN-VAR is NIL connection is
bound with (connection-variable DATA-SRC) dynamic variable.
Returns the result of BODY."
(rebinding (data-src)
(if conn-var
`(let ((,conn-var (connect ,data-src , at conn-args)))
(unwind-protect
(progn , at body)
(disconnect ,conn-var)))
(with-unique-names ((cvn "-conn-var-name"))
`(let ((,cvn (connection-variable ,data-src)))
(assert ,cvn ()
"Nor user or source variable for connection are specified.")
(progv (list ,cvn)
(list (connect ,data-src , at conn-args))
(unwind-protect
(progn , at body)
(disconnect (symbol-value ,cvn)))))))))
(defmacro with-transaction ((connection) &rest body)
"Execute BODY in CONNECTION transactional context
Returns the result of BODY."
`(with-data-transaction ,connection
#'(lambda () , at body)))
(defmacro with-commit ((conn-var data-src) &rest body)
(rebinding (data-src)
`(with-connection (,conn-var ,data-src)
(with-transaction (,data-src)
, at body))))
(setf (data-src-scheme-class :postgresql) 'sql-src)
(defclass sql-src (data-src)
((connection-variable
:allocation :class
:initform 'clsql:*default-database*))
(:documentation "SQL data source."))
(defmethod connection-spec ((ds sql-src))
`(,(puri:uri-host ds)
,(second (puri:uri-parsed-path ds))
,(username ds)
,(password ds)
,(aif (puri:uri-port ds) (prin1-to-string it))
,(options ds)))
(defmethod connect ((ds sql-src) &key make-default (pool t))
(flet ((alivep (conn)
(handler-case (progn
(clsql:query "select 1" :database conn)
t)
(clsql:sql-database-error (c)
(declare (ignore c))
nil)))
(do-connect ()
(clsql:connect (connection-spec ds)
:database-type (puri:uri-scheme ds)
:pool pool
:make-default make-default)))
(let ((c (do-connect)))
(unless (alivep c)
(clsql:disconnect-pooled t)
(setf c (do-connect)))
c)))
(defmethod disconnect ((connection clsql:database))
(clsql:disconnect :database connection))
(defmethod with-data-transaction ((connection clsql:database) function)
(clsql:with-transaction (:database connection)
(funcall function)))
(defmethod update-record ((db clsql:database) dest-table key-alist attr-alist)
(let* ((tbl (clsql:sql-expression :table dest-table))
(where (apply
#'clsql:sql-operation 'and
(mapcar #'(lambda (av)
(clsql:sql-operation
'=
(clsql:sql-expression :attribute (first av))
(second av)))
key-alist)))
(exists (car (clsql:select 1
:from tbl
:flatp t
:where where
:limit 1
:database db))))
(when exists
(clsql:update-records tbl
:av-pairs attr-alist
:where where
:database db))
(if exists t nil)))
(defmethod insert-record ((db clsql:database) dest-table attr-alist)
(let ((tbl (clsql:sql-expression :table dest-table)))
(clsql:insert-records :into tbl :av-pairs attr-alist :database db)))
(defmethod write-record ((db clsql:database) dest-table key-alist attr-alist)
(unless (update-record db dest-table key-alist attr-alist)
(insert-record db dest-table (append key-alist attr-alist))))
(defmethod delete-record ((db clsql:database) dest-table key-alist)
(let* ((tbl (clsql:sql-expression :table dest-table))
(where (apply
#'clsql:sql-operation 'and
(mapcar #'(lambda (av)
(clsql:sql-operation
'=
(clsql:sql-expression :attribute (first av))
(second av)))
key-alist)))
(exists (car (clsql:select 1
:from tbl
:flatp t
:where where
:limit 1
:database db))))
(when exists
(clsql:delete-records :from tbl :where where :database db)
t)))
;;
;; FTP
;;
(setf (data-src-scheme-class :ftp) 'ftp-src)
(defclass ftp-src (data-src)
((connection-variable
:allocation :class
:initform '*default-ftp-connection*))
(:documentation "FTP data source."))
(defmethod connect ((ds ftp-src) &rest rest-args)
(apply #'make-instance
'ftp:ftp-connection
:hostname (uri-host ds)
:port (or (uri-port ds) 21)
(append (options ds)
(plist-union rest-args
(list
:username (username ds)
:password (password ds))))))
(defmethod disconnect ((connection ftp:ftp-connection))
(ftp:close-connection connection))
(defmethod with-data-transaction ((connection ftp:ftp-connection) function)
(declare (ignore connection))
(funcall function))
More information about the bese-devel
mailing list