Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
submarine
submarine
Commits
77622df1
Commit
77622df1
authored
Aug 13, 2007
by
ryszard.szopa
Browse files
refactoring: new file, dao.lisp
darcs-hash:d8c79de74708239a5040b73e5b16f2faca43fa05
parent
fa3ca659
Changes
3
Hide whitespace changes
Inline
Side-by-side
dao.lisp
0 → 100644
View file @
77622df1
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; -*-
(
in-package
:submarine
)
;;
;; DAO
;;
;;
(
defclass
dao
()
((
id
:type
integer
:accessor
get-id
:initarg
:id
))
(
:indices
)
(
:metaclass
db-class
)
(
:documentation
"Base class for any PostgreSQL aware classes."
))
(
defgeneric
save-dao
(
object
)
(
:documentation
"Save a dao: update it when it already exists, insert it otherwise."
)
(
:method
((
dao
dao
))
(
if
(
dao-exists-p
dao
)
(
update-dao
dao
)
(
insert-dao
dao
))))
(
defgeneric
save-all-foreign-daos
(
dao
)
(
:documentation
"Saves recursively all daos in the slots of DAO"
)
(
:method
((
dao
dao
))
(
iter
(
for
slot
in
(
non-transient-slots-of
dao
))
(
let
((
s-value
(
slot-value
dao
slot
)))
(
when
(
typep
s-value
'dao
)
(
save-dao
s-value
))))))
(
defgeneric
dao-exists-p
(
dao
)
(
:documentation
"Return a boolean indicating whether the given dao
exists in the database."
)
(
:method
((
dao
dao
))
(
with-class-connection
(
dao
)
(
and
(
slot-boundp
dao
'id
)
(
postmodern::query
(
:select
(
:exists
(
:select
1
:from
(
class-name-of
dao
)
:where
(
:=
'id
(
get-id
dao
)))))
:single
)))))
(
defun
set-fields
(
object
)
(
iter
(
for
field
in
(
slots-of
object
))
(
appending
`
(
',field
,
(
slot-value-or-id-if-foreign
object
field
)))))
(
defun
id-seq-name
(
class
)
(
intern
(
format
nil
"~A-ID-SEQ"
(
class-name
class
))
:keyword
))
(
defgeneric
insert-dao
(
dao
)
(
:documentation
"Insert the given dao into the database."
)
(
:method
((
dao
dao
))
(
with-class-connection
(
dao
)
(
unless
(
slot-boundp
dao
'id
)
(
setf
(
slot-value
dao
'id
)
(
postmodern::sequence-next
(
id-seq-name
(
class-of
dao
)))))
(
postmodern::execute
(
sql-compile
`
(
:insert-into
,
(
class-name-of
dao
)
:set
,@
(
set-fields
dao
)))))))
(
defgeneric
update-dao
(
dao
)
(
:documentation
"Update the dao's representation in the database
with the values in the given object."
))
(
defmethod
update-dao
((
dao
dao
))
(
with-class-connection
(
dao
)
(
postmodern::execute
(
sql-compile
`
(
:update
,
(
class-name-of
dao
)
:set
,@
(
set-fields
dao
)
:where
(
:=
'id
(
get-id
dao
)))))))
(
defgeneric
delete-dao
(
dao
)
(
:documentation
"Delete the given dao from the database."
))
;(defun get-dao (type id)
; (select object type &optional test)
db.lisp
View file @
77622df1
...
...
@@ -145,77 +145,4 @@ table ~A. This may indicate that something is wrong." (first column) (second col
:format-control
"Column ~A in table ~A does not exist."
:format-arguments
(
list
(
car
field
)
class-name
)))))))
(
values
))))
;;
;; DAO
;;
;;
(
defclass
dao
()
((
id
:type
integer
:accessor
get-id
:initarg
:id
))
(
:indices
)
(
:metaclass
db-class
)
(
:documentation
"Base class for any PostgreSQL aware classes."
))
(
defgeneric
save-dao
(
object
)
(
:documentation
"Save a dao: update it when it already exists, insert it otherwise."
)
(
:method
((
dao
dao
))
(
if
(
dao-exists-p
dao
)
(
update-dao
dao
)
(
insert-dao
dao
))))
(
defgeneric
save-all-foreign-daos
(
dao
)
(
:documentation
"Saves recursively all daos in the slots of DAO"
)
(
:method
((
dao
dao
))
(
iter
(
for
slot
in
(
non-transient-slots-of
dao
))
(
let
((
s-value
(
slot-value
dao
slot
)))
(
when
(
typep
s-value
'dao
)
(
save-dao
s-value
))))))
(
defgeneric
dao-exists-p
(
dao
)
(
:documentation
"Return a boolean indicating whether the given dao
exists in the database."
)
(
:method
((
dao
dao
))
(
and
(
slot-boundp
dao
'id
)
(
postmodern::query
(
:select
(
:exists
(
:select
1
:from
(
class-name-of
dao
)
:where
(
:=
'id
(
get-id
dao
)))))
:single
))))
(
defun
set-fields
(
object
)
(
iter
(
for
field
in
(
slots-of
object
))
(
appending
`
(
',field
,
(
slot-value-or-id-if-foreign
object
field
)))))
(
defun
id-seq-name
(
class
)
(
intern
(
format
nil
"~A-ID-SEQ"
(
class-name
class
))
:keyword
))
(
defgeneric
insert-dao
(
dao
)
(
:documentation
"Insert the given dao into the database."
)
(
:method
((
dao
dao
))
(
unless
(
slot-boundp
dao
'id
)
(
setf
(
slot-value
dao
'id
)
(
postmodern::sequence-next
(
id-seq-name
(
class-of
dao
)))))
(
postmodern::execute
(
sql-compile
`
(
:insert-into
,
(
class-name-of
dao
)
:set
,@
(
set-fields
dao
))))))
(
defgeneric
update-dao
(
dao
)
(
:documentation
"Update the dao's representation in the database
with the values in the given object."
))
(
defmethod
update-dao
((
dao
dao
))
(
postmodern::execute
(
sql-compile
`
(
:update
,
(
class-name-of
dao
)
:set
,@
(
set-fields
dao
)
:where
(
:=
'id
(
get-id
dao
))))))
(
defgeneric
delete-dao
(
dao
)
(
:documentation
"Delete the given dao from the database."
))
(
defclass
test1
(
dao
)
((
foo
:type
integer
:accessor
foo
:initarg
:foo
))
(
:metaclass
db-class
))
(
defclass
test2
(
dao
)
((
foreign-foo
:type
test1
:initarg
:foo
)
(
transient-slot
:type
integer
:transient
t
))
(
:metaclass
db-class
))
; (select object type &optional test)
submarine.asd
View file @
77622df1
...
...
@@ -12,4 +12,5 @@
((
:file
"package"
)
(
:file
"utilities"
)
(
:file
"mop"
)
(
:file
"db"
)))
\ No newline at end of file
(
:file
"db"
)
(
:file
"dao"
)))
\ No newline at end of file
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment