aboutsummaryrefslogtreecommitdiff
path: root/scm
diff options
context:
space:
mode:
authorSergey Poznyakoff <gray@gnu.org.ua>2005-02-09 11:06:34 +0000
committerSergey Poznyakoff <gray@gnu.org.ua>2005-02-09 11:06:34 +0000
commit2d8e6979d8f9ef46a94091cb6f7735af9f6fc58a (patch)
tree3aa28f6699f4f94e6e621b4a546bf32ad7d09a51 /scm
parent22068cecd6b41b0b5e5c376f02f951acf1cb9c06 (diff)
downloadellinika-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
Diffstat (limited to 'scm')
-rw-r--r--scm/dictrans.scm120
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)

Return to:

Send suggestions and report system problems to the System administrator.