Greg Slepak avatar Greg Slepak committed 00a6833

more improvements to the ORM stuff

Comments (0)

Files changed (2)

example-site/dragonfly-framework/plugins-inactive/db/database_orm.lsp

 ;; @author Greg Slepak
 
 (DF:activate-plugin "db/database_utils")
+
 (new-class 'DB.OBJ)
-(context DB.OBJ)
 
-(constant 'SELECT_SQL	"SELECT %s FROM %s WHERE %s LIMIT 1"
-          'UPDATE_SQL	"UPDATE %s SET %s=? WHERE %s LIMIT 1")
+(constant (global 'DBOBJ_SELECT_SQL)	"SELECT %s FROM %s WHERE %s LIMIT 1"
+		  (global 'DBOBJ_SELECT_SQL2)	"SELECT * FROM %s" ; quasi-hack to obtain the col names b/c INSERT doesn't tell us. we don't actually retrieve the rows.
+          (global 'DBOBJ_UPDATE_SQL)	"UPDATE %s SET %s=? WHERE %s" ; LIMIT isn't supported for UPDATE unless sqlite3 was compiled with the option
+		  (global 'DBOBJ_INSERT_SQL)	"INSERT INTO %s (%s) VALUES (%s)"
+		  (global 'DBOBJ_INSERT_SQL2)	"INSERT INTO %s VALUES (%s)"
+		  (global 'DBOBJ_ROWID_COL)		"ROWID")
 
-(define (DB.OBJ:DB.OBJ _db _table cols _finder)
-	(if (= @self @class)
-		(autorelease (instantiate @class _db _table cols _finder))
-		(begin
-			(set 'db _db 'table _table 'finder _finder)
-			(setf revert-set (assoc-row-with-db db (format SELECT_SQL (join cols ",") table finder)))
-			(when (setf change-set revert-set)
-				(dolist (col (map first revert-set)) ; we don't use 'cols' so that we can pass in things like '("*")
-					(letex (attr-sym (sym col) attr-str col)
-						(define (attr-sym value from-revert-set)
-							(if value
-								(begin
-									(setf (<- attr-str change-set) value)
-									(setf dirty true))
-								(if from-revert-set
-									(<- attr-str revert-set)
-									(<- attr-str change-set))))))))))
-
-(define (DB.OBJ:refetch)
-	(set 'dirty nil
-	     'revert-set (assoc-row-with-db db (format SELECT_SQL (join (map first revert-set) ",") table finder))
-	     'change-set revert-set
-	)
-)
-
-(define (DB.OBJ:save , diff)
-	(unless (null? (setf diff (difference change-set revert-set)))
-		(when (db:execute-update (format UPDATE_SQL table (join (map first diff) "=?,") finder) (map last diff))
-			(set 'revert-set change-set 'dirty nil)
+; The returned object is NOT autoreleased! YOU are responsible for releasing it when you're done with it!
+(define (create-dbobj db table data , qs sql cols result)
+	(setf qs (join (dup "?" (length data) true) ","))
+	(if (list? (first data))
+		(when (db:execute-update (format DBOBJ_INSERT_SQL table (join (map first data) ",") qs) (map last data))
+			(instantiate DB.OBJ db table data (string DBOBJ_ROWID_COL "=" (db:rowid))))
+		(when (setf sql (db:prepare-sql (format DBOBJ_SELECT_SQL2 table)))
+			(setf cols (map sql:col-name (sequence 0 (-- (sql:col-count)))))
+			(when (db:execute-update (format DBOBJ_INSERT_SQL2 table qs) data)
+				(setf result (instantiate DB.OBJ db table (transpose (list cols data)) (string DBOBJ_ROWID_COL "=" (db:rowid))))
+			)
+			(deallocate sql)
+			result
 		)
 	)
 )
 
+; The returned object is NOT autoreleased! YOU are responsible for releasing it when you're done with it!
+(define (find-dbobj db table cols finder , data)
+	(when (setf data (assoc-row-with-db db (format DBOBJ_SELECT_SQL (join cols ",") table finder)))
+		(instantiate DB.OBJ db table data finder)))
+
+(global 'create-dbobj 'find-dbobj)
+
+(context DB.OBJ)
+
+(define (DB.OBJ:DB.OBJ _db _table data _finder)
+	(set 'db _db 'table _table 'finder _finder)
+	(when (setf change-set (setf revert-set data))
+		(dolist (col (map first revert-set))
+			(letex (attr-sym (sym col) attr-str col)
+				(define (attr-sym value from-revert-set)
+					(if value
+						(begin
+							(setf (<- attr-str change-set) value)
+							(setf dirty true))
+						(if from-revert-set
+							(<- attr-str revert-set)
+							(<- attr-str change-set))))))))
+
+(define (DB.OBJ:refetch)
+	(set 'dirty      nil
+	     'revert-set (assoc-row-with-db db (format DBOBJ_SELECT_SQL (join (map first revert-set) ",") table finder))
+	     'change-set revert-set))
+
+(define (DB.OBJ:save , diff)
+	(unless (null? (setf diff (difference change-set revert-set)))
+		(when (db:execute-update (format DBOBJ_UPDATE_SQL table (join (map first diff) "=?,") finder) (map last diff))
+			(set 'revert-set change-set 'dirty nil))))
+
 (context MAIN)

example-site/views/dragonfly_sqlite3.html

 					</tr>
 				<% )) %>
 			</table>
+			<%
+				(setf obj (find-dbobj db "people" '("name" "age") "ROWID=1"))
+			%>
+			<p>
+				I've found a person called <%=(obj:name)%> in the table '<%=obj:table%>' at location <%=obj:finder%>, this person is <%=(obj:age)%> years old.
+			</p>
+			<p>
+				Let's set their age to 10.<%(obj:age 10) (obj:save)%>
+			</p>
+			<p>
+				They are now <%=(obj:age)%> years old.
+			</p>
+			<p>
+				Further, I can create a new person. See:
+				<%
+					(release obj)
+					(setf obj (create-dbobj db "people" '("Sue" 57)))
+				%>
+			</p>
+			<p>
 			<table>
 				<tr class="header"><td>ID</td><td>Name</td><td>Age</td></tr>
 				<% (for-query-with-db db "SELECT rowid,name,age FROM people" %>
 					</tr>
 				<% ) %>
 			</table>
-			<%
-				(setf obj (instantiate DB.OBJ db "people" '("name" "age") "ROWID=1"))
-			%>
-			<p>
-				I've found a person called <%=(obj:name)%> in the table '<%=obj:table%>' at location <%=obj:finder%>, this person is <%=(obj:age)%> years old.
-			</p>
-			<p>
-				Let's set their age to 10.<%(obj:age 10) (obj:save)%>
-			</p>
-			<p>
-				They are now <%=(obj:age)%> years old.
 			</p>
 		</p>
 		<p>
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.