steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

sqlite: various tuple-db bug fixes

cvs
Chris Double 2005-10-05 23:13:57 +00:00
parent 05bea5a1b5
commit 211c60c210
1 changed files with 22 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
contrib/sqlite/tuple-db.factor
View File

@ -36,12 +36,24 @@ TUPLE: db-field name bind-name slot type ;
! a tuple are mapped to the fields of a sqlite database. ! a tuple are mapped to the fields of a sqlite database.
TUPLE: mapping tuple table fields one-to-one one-to-many ; TUPLE: mapping tuple table fields one-to-one one-to-many ;
: sanitize-conversions ( -- alist )
[
[[ CHAR: - "_" ]]
[[ CHAR: ? "p" ]]
] ;
: sanitize ( string -- string )
#! Convert a string so it can be used as a table or field name.
[
[ dup sanitize-conversions assoc [ % ] [ , ] ?if ] each
] "" make ;
: tuple-fields ( class -- seq ) : tuple-fields ( class -- seq )
#! Given a tuple class return a list of the fields #! Given a tuple class return a list of the fields
#! within that tuple. Ignores the delegate field. #! within that tuple. Ignores the delegate field.
[ word-name length 1+ ] keep [ word-name length 1+ ] keep
"slots" word-prop 1 swap tail [ ( name-len @{ slot getter setter }@ ) "slots" word-prop 1 swap tail [ ( name-len @{ slot getter setter }@ )
[ 1 swap nth word-name tail dup ":" swap append ] keep [ 1 swap nth word-name tail sanitize dup ":" swap append ] keep
0 swap nth 0 swap nth
"text" "text"
<db-field> <db-field>
@ -50,7 +62,7 @@ TUPLE: mapping tuple table fields one-to-one one-to-many ;
: default-mapping ( class -- mapping ) : default-mapping ( class -- mapping )
#! Given a tuple class, create a default mappings object. It assumes #! Given a tuple class, create a default mappings object. It assumes
#! there are no one-to-one or one-to-many relationships. #! there are no one-to-one or one-to-many relationships.
dup [ word-name ] keep tuple-fields f f <mapping> ; dup [ word-name sanitize ] keep tuple-fields f f <mapping> ;
! The mappings variable holds a hashtable mapping the tuple symbol ! The mappings variable holds a hashtable mapping the tuple symbol
! to the mapping object, describing how that tuple is stored ! to the mapping object, describing how that tuple is stored
@ -59,16 +71,19 @@ SYMBOL: mappings
: init-mappings ( -- ) : init-mappings ( -- )
#! #!
{{ }} mappings set ; {{ }} mappings global set-hash ;
: get-mappings ( -- hashtable )
mappings global hash ;
: set-mapping ( mapping -- ) : set-mapping ( mapping -- )
#! Store a database mapping so that the persistence system #! Store a database mapping so that the persistence system
#! knows how to store instances of the relevant tuple in the database. #! knows how to store instances of the relevant tuple in the database.
dup mapping-tuple mappings get set-hash ; dup mapping-tuple get-mappings set-hash ;
: get-mapping ( class -- mapping ) : get-mapping ( class -- mapping )
#! Return the database mapping for the given tuple class. #! Return the database mapping for the given tuple class.
mappings get hash ; get-mappings hash ;
! The 'persistent' tuple will be set to the delegate of any tuple ! The 'persistent' tuple will be set to the delegate of any tuple
! instance stored in the database. It contains the database key ! instance stored in the database. It contains the database key
@ -272,4 +287,4 @@ M: mapping select-sql ( tuple mapping -- select )
rot sqlite-finalize nip ; rot sqlite-finalize nip ;
mappings get [ init-mappings ] unless get-mappings [ init-mappings ] unless