summaryrefslogtreecommitdiffabout
path: root/scm/dictrans.scm
authorSergey Poznyakoff <gray@gnu.org.ua>2006-03-18 20:54:21 (GMT)
committer Sergey Poznyakoff <gray@gnu.org.ua>2006-03-18 20:54:21 (GMT)
commit2c9ea9a124eef9fd988f70988ca346be9dc139b8 (patch) (side-by-side diff)
treedb0d42a847d703d186d3e8247e0f376c6939f260 /scm/dictrans.scm
parent07d7fc9a5255ae20b43de916fe035c72f4506c23 (diff)
downloadellinika-2c9ea9a124eef9fd988f70988ca346be9dc139b8.tar.gz
ellinika-2c9ea9a124eef9fd988f70988ca346be9dc139b8.tar.bz2
Update to match new db structure
git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@370 941c8c0f-9102-463b-b60b-cd22ce0e6858
Diffstat (limited to 'scm/dictrans.scm') (more/less context) (ignore whitespace changes)
-rw-r--r--scm/dictrans.scm131
1 files changed, 81 insertions, 50 deletions
diff --git a/scm/dictrans.scm b/scm/dictrans.scm
index 115ea58..dd12f9e 100644
--- a/scm/dictrans.scm
+++ b/scm/dictrans.scm
@@ -545,11 +545,12 @@
"CLASS"
(tag attr text)
(expect-context tag "DICT")
- (let ((id (xmltrans:attr attr "ID"))
+ (let ((lang (xmltrans:attr #t "LANG"))
+ (id (xmltrans:attr attr "ID"))
(descr (xmltrans:attr attr "DESCR"))
(tds (xmltrans:attr attr "__TDS__")))
(set! class-list (cons
- (list id descr tds)
+ (list id descr lang tds)
class-list)))
#f)
@@ -705,37 +706,52 @@
;;; Insert (or update) topics and topic categories
(define (insert-categories conn)
+ (debug 1 "Inserting categories")
(for-each
(lambda (cat)
+ (debug 1 "CAT " cat)
(let ((cn (let ((res (run-query conn
(string-append
"SELECT category FROM category WHERE title=\""
(escape-string (list-ref cat 0))
- "\""))))
+ "\" AND lang='"
+ (escape-string (list-ref cat 2))
+ "'"))))
(cond
((not (null? res))
- (run-query conn (string-append "UPDATE category SET descr=\""
- (escape-string (list-ref cat 1))
- "' WHERE category="
- (caar res)))
+ (run-query conn
+ (string-append
+ "UPDATE category SET description=\""
+ (escape-string (or (list-ref cat 1) ""))
+ "\", title=\"" (escape-string (list-ref cat 0))
+ "\" WHERE category="
+ (caar res)))
(caar res))
(else
(run-query conn (string-append
- "INSERT INTO category (title,description) VALUES (\""
+ "INSERT INTO category (title,description,lang) VALUES (\""
(escape-string (list-ref cat 0))
"\",\""
(escape-string (or (list-ref cat 1) ""))
+ "\",\""
+ (escape-string (list-ref cat 2))
"\")"))
(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))))
+ (let ((xt (escape-string topic)))
+ (if (null? (run-query conn
+ (string-append
+ "SELECT * FROM topic "
+ "WHERE title=\"" xt "\" "
+ "AND category=" cn)))
+ (run-query conn
+ (string-append "INSERT INTO topic (title,category) VALUES(\""
+ xt
+ "\","
+ cn
+ ")")))))
+ (list-ref cat 3))))
class-list))
;;;
@@ -755,7 +771,8 @@
key
"' AND pos="
(number->string (p-article-get #:pos p-article))
- " AND dict.ident=locus.ident"))))
+ " AND dict.ident=locus.ident"
+ " AND locus.lang='" lang "'"))))
(if (not (null? res))
(begin
(xmltrans:parse-error
@@ -785,41 +802,53 @@
(lambda (p-article)
(for-each
(lambda (key)
- (let ((sound (ellinika:sounds-like key)))
- (set! dict-index (1+ dict-index))
- ;;; Insert 'heading' info
- (run-query
- conn
- (cond
- ((node-get #:forms node) =>
- (lambda (f)
+ (let ((sound (ellinika:sounds-like key))
+ (word-index (query-number
+ conn
+ (string-append
+ "SELECT dict.ident from dict "
+ "WHERE dict.word='" key "' "
+ "AND pos="
+ (number->string (p-article-get #:pos p-article))))))
+ (cond
+ ((not word-index)
+ (set! dict-index (1+ dict-index))
+ (set! word-index dict-index)
+
+ ;;; Insert 'heading' info
+ (run-query
+ conn
+ (cond
+ ((node-get #:forms node) =>
+ (lambda (f)
+ (format
+ #f
+ "INSERT INTO dict (ident,word,sound,pos,forms) VALUES(~A,\"~A\",\"~A\",~A,\"~A\")"
+
+ word-index
+ key
+ sound
+ (p-article-get #:pos p-article)
+ f)))
+ (else
(format
#f
- "INSERT INTO dict (ident,word,sound,pos,forms) VALUES(~A,\"~A\",\"~A\",~A,\"~A\")"
-
- dict-index
+ "INSERT INTO dict (ident,word,sound,pos) VALUES(~A,\"~A\",\"~A\",~A)"
+ word-index
key
sound
- (p-article-get #:pos p-article)
- f)))
- (else
- (format
- #f
- "INSERT INTO dict (ident,word,sound,pos) VALUES(~A,\"~A\",\"~A\",~A)"
- dict-index
- key
- sound
- (p-article-get #:pos p-article)))))
+ (p-article-get #:pos p-article)))))))
;;; Insert source information
(let ((loc (node-get #:locus node)))
(run-query
conn
(format #f
- "INSERT INTO locus (ident,file,line) VALUES(~A,\"~A\",~A)"
- dict-index
+ "INSERT INTO locus (ident,file,line,lang) VALUES(~A,\"~A\",~A,\"~A\")"
+ word-index
(car loc)
- (cdr loc))))
+ (cdr loc)
+ lang)))
;;; Insert cross-references
(for-each
@@ -838,21 +867,22 @@
;;; Insert topics
(for-each
(lambda (t)
- (let ((index (query-number
- conn
- (format
- #f
- "SELECT ident FROM topic WHERE title=\"~A\""
- (escape-string t)))))
- (if (not index)
+ (let ((topic-index (query-number
+ conn
+ (format
+ #f
+ "SELECT t.ident FROM topic t, category c WHERE t.title=\"~A\" AND t.category=c.category AND c.lang='~A'"
+ (escape-string t)
+ (escape-string lang)))))
+ (if (not topic-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)))))
+ topic-index
+ word-index)))))
(p-article-get #:topic p-article))
;;; Insert articles
@@ -863,7 +893,7 @@
conn
(format #f
"INSERT INTO articles VALUES (~A, ~A, '~A', \"~A\")"
- dict-index
+ word-index
article-index
lang
text))
@@ -1002,6 +1032,7 @@ Informational options:
(insert-categories conn)
+ (debug 1 "Inserting nodes")
(let ((lang #f))
(for-each
(lambda (node)

Return to:

Send suggestions and report system problems to the System administrator.