X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=parse-2002.lisp;h=8bbb00915f2ea7781115ce95241ff794e43ce9d3;hb=ebbaacd0a589db2c590846742da33e3b4bf25d02;hp=79119fd9639192d15c498a00b4b6fe739256ab93;hpb=74e8c7ab60e8d315d20406e3a37ad5cac6abf8cd;p=umlisp.git diff --git a/parse-2002.lisp b/parse-2002.lisp index 79119fd..8bbb009 100644 --- a/parse-2002.lisp +++ b/parse-2002.lisp @@ -8,7 +8,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: parse-2002.lisp,v 1.6 2003/05/06 06:09:29 kevin Exp $ +;;;; $Id: parse-2002.lisp,v 1.7 2003/05/06 07:17:35 kevin Exp $ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. @@ -279,7 +279,7 @@ (let ((cols '())) (with-umls-file (line "MRCOLS") (destructuring-bind (col des ref min av max fil dty) line - (let ((c (make-umls-col + (let ((c (make-instance 'ucol :col col :des des :ref ref @@ -289,8 +289,8 @@ :fil fil :dty dty ;; new in 2002 UMLS :sqltype "VARCHAR" ; default data type - :parsefunc #'add-sql-quotes - :custom-value-func nil + :parse-fun #'add-sql-quotes + :custom-value-fun nil :quotechar "'"))) (add-datatype-to-col c (datatype-for-col col)) (push c cols)))) @@ -300,17 +300,10 @@ "Initialize umls columns for custom columns" (let ((cols '())) (dolist (customcol +custom-cols+) - (let ((c (make-umls-col :col (nth 1 customcol) - :des "" - :ref 0 - :min 0 - :max (nth 3 customcol) - :av 0 - :dty nil - :fil (nth 0 customcol) - :sqltype (nth 2 customcol) - :parsefunc #'add-sql-quotes - :custom-value-func (nth 4 customcol) + (let ((c (make-instance 'ucol + :col (nth 1 customcol) :des "" :ref 0 :min 0 :max (nth 3 customcol) + :av 0 :dty nil :fil (nth 0 customcol) :sqltype (nth 2 customcol) + :parse-fun #'add-sql-quotes :custom-value-fun (nth 4 customcol) :quotechar "'"))) (add-datatype-to-col c (datatype-for-col (nth 1 customcol))) (push c cols))) @@ -326,7 +319,7 @@ (destructuring-bind (nam des ref fil) line (setq nam (escape-column-name nam)) (dolist (file (delimited-string-to-list fil #\,)) - (let ((c (make-umls-col + (let ((c (make-instance 'ucol :col nam :des des :ref ref @@ -336,8 +329,8 @@ :fil file :dty nil :sqltype "VARCHAR" ; default data type - :parsefunc #'add-sql-quotes - :custom-value-func nil + :parse-fun #'add-sql-quotes + :custom-value-fun nil :quotechar "'"))) (add-datatype-to-col c (datatype-for-col nam)) (push c cols))))) @@ -375,7 +368,7 @@ append a unique number (starting at 2) onto a column name that is repeated in th (let ((files '())) (with-umls-file (line files-filename) (destructuring-bind (fil des fmt cls rws bts) line - (let ((f (make-umls-file + (let ((f (make-instance 'ufile :fil fil :table (substitute #\_ #\. fil) :des des @@ -386,20 +379,16 @@ append a unique number (starting at 2) onto a column name that is repeated in th :fields (concatenate 'list (umls-field-string-to-list fmt) (custom-colnames-for-filename fil))))) - (setf (umls-file-colstructs f) (umls-cols-for-umls-file f)) + (setf (ucols f) (ucols-for-umls-file f)) (push f files)))) (nreverse files))) (defun init-custom-files () - (let ((ffile (make-umls-file :fil "MRXW.NONENG" - :des "Custom NonEnglish Index" - :table "MRXW_NONENG" - :cls 5 - :rws 0 - :bts 0 - :fields (umls-file-fields (find-umls-file "MRXW.ENG"))))) - (setf (umls-file-colstructs ffile) - (umls-cols-for-umls-file ffile)) + (let ((ffile (make-instance 'ufile + :fil "MRXW.NONENG" :des "Custom NonEnglish Index" :table "MRXW_NONENG" + :cls 5 :rws 0 :bts 0 :fields (fields (find-umls-file "MRXW.ENG"))))) + (setf (ucols ffile) + (ucols-for-umls-file ffile)) (list ffile))) (defun datatype-for-col (colname) @@ -408,32 +397,32 @@ append a unique number (starting at 2) onto a column name that is repeated in th (defun add-datatype-to-col (col datatype) "Add data type information to column" - (setf (umls-col-datatype col) datatype) + (setf (datatype col) datatype) (case datatype - (sql-u (setf (umls-col-sqltype col) "INTEGER" - (umls-col-parsefunc col) #'parse-ui - (umls-col-quotechar col) "")) - (sql-s (setf (umls-col-sqltype col) "SMALLINT" - (umls-col-parsefunc col) #'parse-integer - (umls-col-quotechar col) "")) - (sql-l (setf (umls-col-sqltype col) "BIGINT" - (umls-col-parsefunc col) #'parse-integer - (umls-col-quotechar col) "")) - (sql-i (setf (umls-col-sqltype col) "INTEGER" - (umls-col-parsefunc col) #'parse-integer - (umls-col-quotechar col) "")) - (sql-f (setf (umls-col-sqltype col) "NUMERIC" - (umls-col-parsefunc col) #'read-from-string - (umls-col-quotechar col) "")) + (sql-u (setf (sqltype col) "INTEGER" + (parse-fun col) #'parse-ui + (quotechar col) "")) + (sql-s (setf (sqltype col) "SMALLINT" + (parse-fun col) #'parse-integer + (quotechar col) "")) + (sql-l (setf (sqltype col) "BIGINT" + (parse-fun col) #'parse-integer + (quotechar col) "")) + (sql-i (setf (sqltype col) "INTEGER" + (parse-fun col) #'parse-integer + (quotechar col) "")) + (sql-f (setf (sqltype col) "NUMERIC" + (parse-fun col) #'read-from-string + (quotechar col) "")) (t ; Default column type, optimized text storage - (setf (umls-col-parsefunc col) #'add-sql-quotes - (umls-col-quotechar col) "'") - (when (and (umls-col-max col) (umls-col-av col)) - (if (> (umls-col-max col) 255) - (setf (umls-col-sqltype col) "TEXT") - (if (< (- (umls-col-max col) (umls-col-av col)) 4) - (setf (umls-col-sqltype col) "CHAR") ; if average bytes wasted < 4 - (setf (umls-col-sqltype col) "VARCHAR"))))))) + (setf (parse-fun col) #'add-sql-quotes + (quotechar col) "'") + (when (and (cmax col) (av col)) + (if (> (cmax col) 255) + (setf (sqltype col) "TEXT") + (if (< (- (cmax col) (av col)) 4) + (setf (sqltype col) "CHAR") ; if average bytes wasted < 4 + (setf (sqltype col) "VARCHAR")))))))