;;; ndb-config.scm version 0.2, time-stamp: <2001-08-14 19:46:26 ttn> ;;; Commentary: ;; From stats.txt: ;; ;; * # ;; name => (list l=1 e:string) ;; gnu => (#f #t) ;; license => (#f list l=1 l=2 l=3 l>3 e:string) ;; category => (list l=1 e:string) ;; location => (#f list l=1 e:string e:list e:l=2 e:l=3) ;; description => (list l=1 l=2 l=3 l>3 e:string e:list e:l=2 e:l=3) ;; maintainer => (#f list l=1 l=2 e:string e:list e:l=3) ;; status => (#f list l=1 l=2 l=3 l>3 e:string) ;; keywords => (#f list l=1 l=2 l=3 l>3 e:string) ;; requires => (#f list l=1 l=2 l>3 e:string e:list e:l=2) ;; mailing-list => (#f list l=1 l=2 l=3 l>3 e:string e:list e:l=3) ;; authors => (#f list l=1 l=2 l=3 l>3 e:string e:list e:l=3) ;; password => (#f list l=1 e:string) ;; ;; * # ;; name => text ;; gnu => bool ;; license => text[] ;; category => text ;; location => text[][] ;; description => text[][] ;; maintainer => text[][] ;; status => text[] ;; keywords => text[] ;; requires => text[][] ;; mailing-list => text[][] ;; authors => text[][] ;; password => text ;; ;; Note that we don't use the suggested representations exactly. ;;; To-Do: ;; - keys (primary, foreign) ;; - triggers ;; - constraints ;;; History: ;; vers date comments ;; 0.1 2001-04-09 -- initial stab after months of infrastructure dev ;; 0.2 2001-04-11 -- remove `require' table, it's now a column in `entry'; ;; add to-do, history and design notes ;;; Code: (use-modules (database postgres) (ttn pgtype)) (use-modules (ttn echo) (ttn pgtable)) (define *ndb-name* "guile_projects") (define all-table-managers '()) (defmacro define-table (name defs) (let ((mgr-name (symbol-append 'm: name)) (table-name (symbol->string name))) `(begin (define ,mgr-name (pgtable-manager *ndb-name* ,table-name ,defs)) (set! all-table-managers ;; maintain ordering: least-dependent first (append all-table-managers (list ,mgr-name)))))) ;; The `text[][]' column types are so that we can "embed" markup. ;; ;; Scheme list: ;; ("see " (url "http://x.y.z" "homepage") " for more info") ;; ;; PG text array: ;; {{"see "},{"url","http://x.y.z"},{" for more info"}} ;; ;; We then use FIELD[][1] to determine which table (`email' or `url') to look ;; up for the rest of the markup info, and FIELD[][2] for the key. There is a ;; better way, using foreign keys, but at this time, (ttn pgtable) doesn't ;; support column definitions more complicated than (NAME . TYPE). We need to ;; choose whether to try to live with this (and if so, for how long) or to go ;; back and improve (ttn pgtable). ;; ;; Thus, the embedded markup representation will most likely change as (ttn ;; pgtable) evolves, although the column names probably won't. Keep an eye on ;; the History comments somewhere above. (define-table entry ;; A project ENTRY has a NAME and may be sufficiently free to be included on ;; the GNU subset (depends on the LICENSE). The project resides at some ;; LOCATION and can be summarized with a DESCRIPTION. The project ;; MAINTAINER (who can supply the PASSWORD) is the one who updates its ;; STATUS. Discussion regarding a project occurs on the MAILINGLIST. The ;; project was written by its AUTHORS and REQUIRES other project packages. '((name text "primary key") (gnu bool) (license text) (location text[][]) (description text[][]) (maintainer text[][]) (status text[][]) (mailinglist text[][]) (authors text[][]) (requires text[][]) (password text))) (define-table category ;; A CATEGORY has some ENTRY in it. '((category text) (entry text "references entry(name)"))) (define-table keyword ;; A KEYWORD points to some ENTRY. '((keyword text) (entry text "references entry(name)"))) ;; If we have `url' and `email' share the same sequence, all the `text[][]' ;; type columns in `entry' can be simply reduced to `text[]'. An array ;; element that looks like a number can be used as the key to some kind of ;; "UNION SELECT". (Is this correct? Hmmmmm.) (define-table url ;; A URL may have some verbose TEXT description. '((url text) (text text))) (define-table email ;; An EMAIL ADDR is used by someone with a NAME. '((addr text) (name text))) ;;; ;;; reflection and other hazardous meta-rials ;;; (define-db-col-type 'name "???" ; like text? identity identity) (define-db-col-type 'oid "-1" number->string string->number) (define-db-col-type 'integer "0" number->string string->number) (define-db-col-type 'char "?" (lambda (c) (make-string 1 c)) (lambda (s) (string-ref s 0))) (define-db-col-type 'smallint "0" number->string string->number) (define-db-col-type 'boolean "f" (lambda (x) (if x "t" "f")) (lambda (s) (if (string=? s "f") #f #t))) (define-db-col-type 'aclitem "?" identity identity) (define-db-col-type-array-variant 'aclitem[] 'aclitem double-quote identity) (define M:pg-class (pgtable-manager *ndb-name* "pg_class" '((relname . name) (reltype . oid) (relowner . integer) (relam . oid) (relpages . integer) (reltuples . integer) (rellongrelid . oid) (relhasindex . boolean) (relisshared . boolean) (relkind . char) (relnatts . smallint) (relchecks . smallint) (reltriggers . smallint) (relukeys . smallint) (relfkeys . smallint) (relrefs . smallint) (relhaspkey . boolean) (relhasrules . boolean) (relacl . aclitem[])))) (define (describe-table name) (let* ((pgdb (M:pg-class 'pgdb)) (res ((M:pg-class 'select) '(relname relhasindex relkind relchecks reltriggers relhasrules) (string-append "where relname='" name "'"))) (res2 (pg-exec pgdb (string-append " SELECT a.attname, t.typname, a.attlen, a.atttypmod," " a.attnotnull, a.atthasdef, a.attnum" " FROM pg_class c, pg_attribute a, pg_type t" " WHERE c.relname = '" name "'" " AND a.attnum > 0" " AND a.attrelid = c.oid" " AND a.atttypid = t.oid" " ORDER BY a.attnum")))) (echo "[[[" name "]]]") (display-table (tuples-result->table res)) (display-table (tuples-result->table res2)))) (for-each describe-table (list "entry" "entry_pkey" "category" "keyword" "email" "url" "pg_class")) (and (string=? "ndb-config.scm" (car (command-line))) (exit 0)) ;;; ndb-config.scm ends here