From 2c9ea9a124eef9fd988f70988ca346be9dc139b8 Mon Sep 17 00:00:00 2001 From: Sergey Poznyakoff Date: Sat, 18 Mar 2006 20:54:21 +0000 Subject: Update to match new db structure git-svn-id: file:///home/puszcza/svnroot/ellinika/trunk@370 941c8c0f-9102-463b-b60b-cd22ce0e6858 --- scm/dictrans.scm | 131 ++++++++++++++++++++++++++++++++++--------------------- 1 file changed, 81 insertions(+), 50 deletions(-) (limited to 'scm/dictrans.scm') 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) -- cgit v1.2.1