From dfe736a8b98b522797004f510fbb10f6e26525cb Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 20 Apr 2008 17:55:08 -0500
Subject: [PATCH] eliminate tons of code duplication
---
extra/db/postgresql/postgresql.factor | 20 ------------------
extra/db/queries/queries.factor | 29 +++++++++++++++++++++++++--
extra/db/sqlite/sqlite.factor | 25 -----------------------
3 files changed, 27 insertions(+), 47 deletions(-)
diff --git a/extra/db/postgresql/postgresql.factor b/extra/db/postgresql/postgresql.factor
index 0401913a8d..fc3b08d9b9 100755
--- a/extra/db/postgresql/postgresql.factor
+++ b/extra/db/postgresql/postgresql.factor
@@ -197,26 +197,6 @@ M: postgresql-db <insert-nonnative-statement> ( class -- statement )
M: postgresql-db insert-tuple* ( tuple statement -- )
query-modify-tuple ;
-M: postgresql-db <update-tuple-statement> ( class -- statement )
- [
- "update " 0% 0%
- " set " 0%
- dup remove-id
- [ ", " 0% ]
- [ dup column-name>> 0% " = " 0% bind% ] interleave
- " where " 0%
- find-primary-key
- dup column-name>> 0% " = " 0% bind%
- ] query-make ;
-
-M: postgresql-db <delete-tuple-statement> ( class -- statement )
- [
- "delete from " 0% 0%
- " where " 0%
- find-primary-key
- dup column-name>> 0% " = " 0% bind%
- ] query-make ;
-
M: postgresql-db <select-by-slots-statement> ( tuple class -- statement )
[
"select " 0%
diff --git a/extra/db/queries/queries.factor b/extra/db/queries/queries.factor
index d0b379ab76..79c1909c05 100644
--- a/extra/db/queries/queries.factor
+++ b/extra/db/queries/queries.factor
@@ -1,7 +1,7 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel namespaces sequences namespaces.lib db
-db.tuples db.types ;
+USING: accessors kernel math namespaces sequences random
+math.bitfields.lib namespaces.lib db db.tuples db.types ;
IN: db.queries
: maybe-make-retryable ( statement -- statement )
@@ -17,3 +17,28 @@ IN: db.queries
M: db begin-transaction ( -- ) "BEGIN" sql-command ;
M: db commit-transaction ( -- ) "COMMIT" sql-command ;
M: db rollback-transaction ( -- ) "ROLLBACK" sql-command ;
+
+: where-primary-key% ( specs -- )
+ " where " 0%
+ find-primary-key dup column-name>> 0% " = " 0% bind% ;
+
+M: db <update-tuple-statement> ( class -- statement )
+ [
+ "update " 0% 0%
+ " set " 0%
+ dup remove-id
+ [ ", " 0% ] [ dup column-name>> 0% " = " 0% bind% ] interleave
+ where-primary-key%
+ ] query-make ;
+
+M: db <delete-tuple-statement> ( specs table -- sql )
+ [
+ "delete from " 0% 0%
+ " where " 0%
+ find-primary-key
+ dup column-name>> 0% " = " 0% bind%
+ ] query-make ;
+
+M: db random-id-quot ( -- quot )
+ [ 63 [ 2^ random ] keep 1 - set-bit ] ;
+
diff --git a/extra/db/sqlite/sqlite.factor b/extra/db/sqlite/sqlite.factor
index 5ceff51325..b948fb1696 100755
--- a/extra/db/sqlite/sqlite.factor
+++ b/extra/db/sqlite/sqlite.factor
@@ -156,10 +156,6 @@ M: sqlite-db bind# ( spec obj -- )
M: sqlite-db bind% ( spec -- )
dup 1, column-name>> ":" prepend 0% ;
-: where-primary-key% ( specs -- )
- " where " 0%
- find-primary-key dup column-name>> 0% " = " 0% bind% ;
-
GENERIC: where ( specs obj -- )
: interval-comparison ( ? str -- str )
@@ -200,24 +196,6 @@ M: string where ( spec obj -- ) object-where ;
2dup slot-name>> swap get-slot-named where
] interleave drop ;
-M: sqlite-db <update-tuple-statement> ( class -- statement )
- [
- "update " 0%
- 0%
- " set " 0%
- dup remove-id
- [ ", " 0% ] [ dup column-name>> 0% " = " 0% bind% ] interleave
- where-primary-key%
- ] query-make ;
-
-M: sqlite-db <delete-tuple-statement> ( specs table -- sql )
- [
- "delete from " 0% 0%
- " where " 0%
- find-primary-key
- dup column-name>> 0% " = " 0% bind%
- ] query-make ;
-
M: sqlite-db <select-by-slots-statement> ( tuple class -- statement )
[
"select " 0%
@@ -230,9 +208,6 @@ M: sqlite-db <select-by-slots-statement> ( tuple class -- statement )
dup empty? [ 2drop ] [ where-clause ] if ";" 0%
] query-make ;
-M: sqlite-db random-id-quot ( -- quot )
- [ 64 [ 2^ random ] keep 1 - set-bit ] ;
-
M: sqlite-db persistent-table ( -- assoc )
H{
{ +native-id+ { "integer primary key" "integer primary key" f } }