diff options
author | Sergey Poznyakoff <gray@gnu.org.ua> | 2005-02-09 11:06:34 +0000 |
---|---|---|
committer | Sergey Poznyakoff <gray@gnu.org.ua> | 2005-02-09 11:06:34 +0000 |
commit | 2d8e6979d8f9ef46a94091cb6f7735af9f6fc58a (patch) | |
tree | 3aa28f6699f4f94e6e621b4a546bf32ad7d09a51 | |
parent | 22068cecd6b41b0b5e5c376f02f951acf1cb9c06 (diff) | |
download | ellinika-2d8e6979d8f9ef46a94091cb6f7735af9f6fc58a.tar.gz ellinika-2d8e6979d8f9ef46a94091cb6f7735af9f6fc58a.tar.bz2 |
(insert-categories): New function. Fills
category table.
(CLASS,D,TD): New tags
(check-node): Bail out if the topic is not declared.
git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@293 941c8c0f-9102-463b-b60b-cd22ce0e6858
-rw-r--r-- | scm/dictrans.scm | 120 |
1 files changed, 95 insertions, 25 deletions
diff --git a/scm/dictrans.scm b/scm/dictrans.scm index 1a5320a..5250368 100644 --- a/scm/dictrans.scm +++ b/scm/dictrans.scm @@ -1,7 +1,8 @@ #! =GUILE_BINDIR=/guile -s +=AUTOGENERATED= !# ;;;; This file is part of Ellinika -;;;; Copyright (C) 2004 Sergey Poznyakoff +;;;; Copyright (C) 2004, 2005 Sergey Poznyakoff ;;;; ;;;; Ellinika is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -173,6 +174,9 @@ (xmltrans:set-default-end-handler lingua:default-end) +;;; Themes class list +(define class-list '()) + ;;; Current node (define current-node #f) @@ -339,7 +343,7 @@ (define (k-expect) (set! expected-k #f)) -;;; +;;;; NODE (xmltrans:start-tag "NODE" (tag attr) @@ -526,6 +530,41 @@ (current-article-set #:article text))) #f) + +;;; CLASS +(xmltrans:end-tag + "CLASS" + (tag attr text) + (expect-context tag "DICT") + (let ((id (xmltrans:attr attr "ID")) + (descr (xmltrans:attr attr "DESCR")) + (tds (xmltrans:attr attr "__TDS__"))) + (set! class-list (cons + (list id descr tds) + class-list))) + #f) + +;;; D +(xmltrans:end-tag + "D" + (tag attr text) + (expect-context tag "CLASS") + ;; FIXME: Check for duplicates + (xmltrans:set-attr #t "DESCR" text) + #f) + +;;; TD +(xmltrans:end-tag + "TD" + (tag attr text) + (expect-context tag "CLASS") + (xmltrans:set-attr #t "__TDS__" + (cons + text + (or (xmltrans:attr #t "__TDS__") '()))) + #f) + + ;;; Formatting elements (xmltrans:end-tag "C" @@ -605,6 +644,7 @@ (run-query conn "DELETE FROM dict") (run-query conn "DELETE FROM topic") (run-query conn "DELETE FROM topic_tab") + (run-query conn "DELETE FROM category") (run-query conn "DELETE FROM pending_links")) (define (pending-fixup conn) @@ -649,7 +689,42 @@ (number->string count) ",now())")))) - +;;; Insert (or update) topics and topic categories +(define (insert-categories conn) + (for-each + (lambda (cat) + (let ((cn (let ((res (run-query conn + (string-append + "SELECT category FROM category WHERE title=\"" + (escape-string (list-ref cat 0)) + "\"")))) + (cond + ((not (null? res)) + (run-query conn (string-append "UPDATE category SET descr=\"" + (escape-string (list-ref cat 1)) + "' WHERE category=" + (caar res))) + (caar res)) + (else + (run-query conn (string-append + "INSERT INTO category (title,description) VALUES (\"" + (escape-string (list-ref cat 0)) + "\",\"" + (escape-string (or (list-ref cat 1) "")) + "\")")) + (number->string (query-number conn "SELECT LAST_INSERT_ID()"))))))) + (for-each + (lambda (topic) + (run-query conn + (string-append "INSERT INTO topic (title,category) VALUES(\"" + (escape-string topic) + "\"," + cn + ")"))) + (list-ref cat 2)))) + class-list)) + +;;; (define dict-index 0) (define (check-node conn node) @@ -749,28 +824,21 @@ ;;; Insert topics (for-each (lambda (t) - (let ((index (or - (query-number - conn - (format - #f - "SELECT ident FROM topic WHERE title=\"~A\"" - (escape-string t))) - (begin - (run-query - conn - (format - #f - "INSERT INTO topic (title) VALUES (\"~A\")" - (escape-string t))) - (query-number conn "SELECT LAST_INSERT_ID()"))))) - (run-query - conn - (format - #f - "INSERT INTO topic_tab VALUES(~A,~A)" - index - dict-index)))) + (let ((index (query-number + conn + (format + #f + "SELECT ident FROM topic WHERE title=\"~A\"" + (escape-string t))))) + (if (not index) + (xmltrans:parse-error (node-get #:locus node) "Undefined topic") + (run-query + conn + (format + #f + "INSERT INTO topic_tab VALUES(~A,~A)" + index + dict-index))))) (p-article-get #:topic p-article)) ;;; Insert articles @@ -914,6 +982,8 @@ Informational options: (cleanup-db conn)) (get-dict-index conn) + + (insert-categories conn) (for-each (lambda (node) |