- drop term-site association, it was wrong idea from the beginning. If it's needed...
authorMaciej Pasternacki <maciej@pasternacki.net>
Wed, 17 Dec 2008 23:24:40 +0000 (18 00:24 +0100)
committerMaciej Pasternacki <maciej@pasternacki.net>
Wed, 17 Dec 2008 23:24:40 +0000 (18 00:24 +0100)
- minor polishing of taxonomy.

src/taxonomy.lisp

index 87db263..5cd8204 100644 (file)
 
 (defpackage #:trane-taxonomy
   (:use #:common-lisp #:trane-common #:iterate #:postmodern)
-  (:export #:taxonomy #:taxonomy-name #:taxonomy-slug #:site-dao-class
-           #:item-dao-class #:taxonomy-value-mixin
-           #:taxonomy-cl-store-value-mixin #:valued-taxonomy
+  (:export #:taxonomy #:taxonomy-name #:taxonomy-slug
+           #:item-dao-class #:valued-taxonomy
            #:cl-store-valued-taxonomy #:deftaxonomy #:ensure-taxonomy
            #:ensure-term #:term #:term-text
-           #:slug #:term-site-id #:term-taxonomy-name
-           #:description #:parent-id #:term-taxonomy #:term-site
+           #:slug #:term-taxonomy-name
+           #:description #:term-taxonomy
            #:id #:find-terms #:new-term #:apply-term
            #:term-value #:item-terms #:order-item-terms
            #:unbind-term :term-item-ids #:term-items
 
 (defclass taxonomy ()
   ((name :initarg :name :reader taxonomy-name)
-   (site-dao-class :initarg :site-dao-class :reader site-dao-class)
    (item-dao-class :initarg :item-dao-class :reader item-dao-class))
   (:documentation "Base taxonomy class.
 
 Taxonomy has a name (symbol or string, which is transformed to a
-keyword by DEFTAXONOMY), and refers to DAO classes of taxonomy's
-SITE and ITEM.  DAO classes are required to have an integer
-primary key, accessible by reader named ID."))
+keyword by DEFTAXONOMY), and refers to DAO classes of taxonomy's ITEM.
+DAO classes are required to have an integer primary key, accessible by
+reader named ID."))
 
 (defmethod print-object ((taxonomy taxonomy) stream)
   (print-unreadable-object (taxonomy stream :type t :identity t)
@@ -104,33 +102,24 @@ NAME is symbol or string, which will be transformed to a keyword anyway."
   ((term-id :col-type serial :reader id)
    (term-text :col-type (varchar 255) :initarg :text :accessor term-text :documentation "Full text of term")
    (term-slug :col-type (varchar 255) :accessor slug :documentation "URL-friendly version of term text, initially chosen by database")
-   (site-id :col-type integer :reader term-site-id :initarg :site-id :documentation "ID of term's site")
    (term-taxonomy :col-type (varchar 32) :col-default "" :reader term-taxonomy-name :initarg :taxonomy-name :documentation "Name of term's taxonomy")
    (term-description :col-type (or db-null text) :accessor description :initarg :description :documentation "Textual description of a term"))
   (:metaclass dao-class)
   (:keys term-id)
-  (:documentation "Class for a term associated with taxonomy and a site."))
+  (:documentation "Class for a term associated with taxonomy."))
 
 ;;; TODO: pathnames (relative and absolute) as EXECUTE* parameters.
-(defun setup-taxonomy-sql (&key site item)
+(defun setup-taxonomy-sql (&key item)
   "List of SQL statements, suitable for TRANE-COMMON:EXECUTE*, to initialize database for Trane Taxonomy module.
 
-SITE and ITEM are optional arguments that, if given, specify foreign
-key reference on term's site and associated item_id columns.  Any of
-those can be a DAO class or a symbol naming one, or a list literally
-specifying S-SQL's foreign key (as for :CREATE-TABLE
-sql-op :REFERENCES constraint)."
+ITEM is an optional arguments that, if given, specifies foreign key
+reference on term's associated item_id columns.  It can be a DAO
+class, a symbol naming one, or a list literally specifying S-SQL's
+foreign key (as for :CREATE-TABLE sql-op :REFERENCES constraint)."
   (list (dao-table-definition 'term)
-        `(:alter-table ,(dao-table-name 'term) :add :unique term-text site-id term-taxonomy)
-        `(:alter-table ,(dao-table-name 'term) :add :unique term-slug site-id term-taxonomy)
+        `(:alter-table ,(dao-table-name 'term) :add :unique term-text term-taxonomy)
+        `(:alter-table ,(dao-table-name 'term) :add :unique term-slug term-taxonomy)
         `(:alter-table ,(dao-table-name 'term) :add :check (:raw "(term_slug SIMILAR TO '[a-z0-9-]+')"))
-        (when site
-          `(:alter-table ,(dao-table-name 'term) :add :foreign-key (site-id) 
-                         ,@ (etypecase site
-                              ((or symbol class)
-                               (list (dao-table-name site)))
-                              (list site))))
-
         `(:create-table
           item-term       ; FIXME:name
           ((item-id :type int ,@ (etypecase item
@@ -146,7 +135,7 @@ sql-op :REFERENCES constraint)."
         ;; Create new term.  Signals error if term exists.
         ;; FIXME: count existing slugs starting with new slug
         "CREATE OR REPLACE FUNCTION new_term(
-    the_text VARCHAR, the_slug VARCHAR, the_site_id INTEGER, the_taxonomy VARCHAR)
+    the_text VARCHAR, the_slug VARCHAR, the_taxonomy VARCHAR)
 RETURNS term
 AS $body$
 DECLARE
@@ -154,8 +143,8 @@ DECLARE
     i INTEGER;
 BEGIN
     BEGIN
-        INSERT INTO term(term_text, term_slug, site_id, term_taxonomy)
-             VALUES (the_text, the_slug, the_site_id, the_taxonomy);
+        INSERT INTO term(term_text, term_slug, term_taxonomy)
+             VALUES (the_text, the_slug, the_taxonomy);
     EXCEPTION
     WHEN unique_violation THEN
         SELECT count(*) FROM term WHERE term_slug LIKE the_slug||'%' INTO i;
@@ -164,8 +153,8 @@ BEGIN
             IF i > 999 THEN RAISE EXCEPTION 'Afraid of infinite loop.';
             END IF;
             BEGIN
-                INSERT INTO term(term_text, term_slug, site_id, term_taxonomy)
-                     VALUES (the_text, the_slug||'-'||i, the_site_id, the_taxonomy);
+                INSERT INTO term(term_text, term_slug, term_taxonomy)
+                     VALUES (the_text, the_slug||'-'||i, the_taxonomy);
             EXCEPTION WHEN unique_violation THEN
                 IF POSITION('_slug_' IN SQLERRM) <> 0 THEN CONTINUE; END IF;
                 RAISE EXCEPTION 'Duplicate term.  How to re-raise from PL/PgSQL?';
@@ -178,16 +167,13 @@ BEGIN
 END;
 $body$ LANGUAGE plpgsql;"
 
-        ;; Selects or inserts term named `the_text' for site `the_site_id' in
-        ;; taxonomy `the_taxonomy'.  Returns found/new term.  No support for
-        ;; description or parent for new term, this function is intended to
-        ;; work with simple terms only (e.g. tags).
+        ;; Selects or inserts term named `the_text' in taxonomy
+        ;; `the_taxonomy'.  Returns found/new term.  No support for
+        ;; description or parent for new term, this function is
+        ;; intended to work with simple terms only (e.g. tags).
         "CREATE OR REPLACE FUNCTION ensure_term(
     the_text VARCHAR,
     suggested_slug VARCHAR,
-    the_site_id INTEGER,        -- CUSTOMIZE? function with the_site
-                                -- VARCHAR which selects id by slug
-                                -- and calls this one
     the_taxonomy VARCHAR)
 RETURNS term
 AS $body$
@@ -196,10 +182,9 @@ DECLARE
 BEGIN
     SELECT INTO res * FROM term
           WHERE term_text=the_text
-            AND site_id=the_site_id
             AND term_taxonomy=the_taxonomy;
     IF NOT FOUND
-    THEN res = new_term(the_text, suggested_slug, the_site_id, the_taxonomy);
+    THEN res = new_term(the_text, suggested_slug, the_taxonomy);
     END IF;
     RETURN res;
 END;
@@ -228,18 +213,12 @@ $body$ LANGUAGE PLPGSQL;"))
   (print-unreadable-object (term stream :type t :identity t)
     (princ (slug term) stream)))
 
-(defun taxonomy (term)
+(defun term-taxonomy (term)
   "TERM's taxonomy object"
   (ensure-taxonomy (term-taxonomy-name term)))
 
-(defun term-site (term)
-  "TERM's site object, if TERM is associated with a SITE."
-  (let ((id (term-site-id term)))
-    (when id
-      (get-dao (site-dao-class (taxonomy term)) id))))
-
-(defun ensure-term (taxonomy site &key text slug create-p)
-  "Find or create term in taxonomy TAXONOMY for site SITE.
+(defun ensure-term (taxonomy &key text slug create-p)
+  "Find or create term in taxonomy TAXONOMY.
 
 TEXT is a full text of term; if TEXT is given, CREATE-P is
 non-NIL and term is not found, new term is inserted into
@@ -254,33 +233,27 @@ creation."
   (first
    (if text
        (if create-p
-           (query-dao 'term (:select '* :from (:ensure-term text (or slug (slugify text)) (id site) (taxonomy-slug taxonomy))))
+           (query-dao 'term (:select '* :from (:ensure-term text (or slug (slugify text)) (taxonomy-slug taxonomy))))
            (select-dao 'term (:and (:= 'term-text text)
-                                   (:= 'site-id (id site))
                                    (:= 'term-taxonomy (taxonomy-slug taxonomy)))))
        (progn
          (when create-p
            (warn "CREATE-P is meaningful only with TEXT defined."))
          (select-dao 'term (:and (:= 'term-slug slug)
-                                 (:= 'site-id (id site))
                                  (:= 'term-taxonomy (taxonomy-slug taxonomy))))))))
 
-(defun new-term (taxonomy site text &optional parent)
-  "Create new term in SITE for TAXONOMY, with full name TEXT."
+(defun new-term (taxonomy text &optional parent)
+  "Create new term in TAXONOMY, with full name TEXT."
   (first (query-dao 'term
                     (:select '* :from
-                             (:new-term text (id site) (taxonomy-slug taxonomy) (if parent (slug parent) :null))))))
+                             (:new-term text (taxonomy-slug taxonomy) (if parent (slug parent) :null))))))
 
-(defun find-terms-where-clause (&key taxonomy site text slug
+(defun find-terms-where-clause (&key taxonomy text slug
                                 &aux (query ()))
   (when taxonomy
     (push (list := 'term-taxonomy (taxonomy-slug taxonomy))
           query))
 
-  (when site
-    (push (list := 'site-id (id site))
-          query))
-
   (when text
     (push (list := 'term-text text) query))
 
@@ -293,12 +266,11 @@ creation."
 
   query)
 
-(defun find-terms (&key taxonomy site text slug)
+(defun find-terms (&key taxonomy text slug)
   "Find list of terms satisfying given keywords."
   (query-dao 'term
              (sql-compile `(:order-by (select '* :from 'term
                                               :where ,(find-terms-where-clause :taxonomy taxonomy
-                                                                               :site site
                                                                                :text text
                                                                                :slug slug))
                                       'term-text))))