(handler-case
(when (or alwaysclear (null *umls-files*))
(setf *umls-cols* nil *umls-files* nil)
- (gen-ucols)
(gen-ufiles)
+ (gen-ucols)
+ (set-ucols-for-ufiles *umls-files*)
(ensure-field-lengths))
- (error (e)
- (setf *umls-cols* nil *umls-files* nil)
- (error e)))
+ (error (e)
+ (warn "Error reading ucols+ufiles: ~A." e)
+ (setf *umls-cols* nil *umls-files* nil)
+ nil))
t)
(defun ufile-pathname (ufile &optional (extension ""))
"Return pathname for a umls filename with an optional extension"
(assert (typep ufile 'ufile))
- (let ((dirs (append (list (dir ufile))
- (awhen (subdir ufile) (list it)))))
+ (let* ((dirs (append (list (dir ufile))
+ (awhen (subdir ufile) (list it))))
+ (name-list (delimited-string-to-list (fil ufile) #\.))
+ (name (if (second name-list)
+ (first name-list)
+ (concatenate 'string (first name-list) (or extension ""))))
+ (type (when (second name-list)
+ (concatenate 'string (second name-list) (or extension "")))))
(merge-pathnames
- (make-pathname :name (concatenate 'string (fil ufile) extension)
+ (make-pathname :name name :type type
:directory (cons :relative dirs))
*umls-path*)))
"Return pathname for a umls filename with an optional extension"
(etypecase filename
(string
+ (let* ((name-list (delimited-string-to-list filename #\.))
+ (name (if (second name-list)
+ (first name-list)
+ (concatenate 'string (first name-list) (or extension ""))))
+ (type (when (second name-list)
+ (concatenate 'string (second name-list) (or extension "")))))
(merge-pathnames
- (make-pathname :name (concatenate 'string filename extension))
+ (make-pathname :name name :type type)
(case (schar filename 0)
- ((#\M #\m)
- *meta-path*)
- ((#\L #\l)
- *lex-path*)
- ((#\S #\s)
- *net-path*)
- (t
- *umls-path*))))
+ ((#\M #\m)
+ *meta-path*)
+ ((#\L #\l)
+ *lex-path*)
+ ((#\S #\s)
+ *net-path*)
+ (t
+ *umls-path*)))))
(pathname
filename)))
"Returns a list of FILENAME MAX AV"
(declare (optimize (speed 3) (safety 0)))
(let (fields-max fields-av num-fields (count-lines 0))
+ (declare (fixnum count-lines))
(with-umls-ufile (line ufile)
(unless num-fields
(setq num-fields (length line))
(setq fields-max (make-array num-fields :element-type 'fixnum
:initial-element 0))
- (setq fields-av (make-array num-fields :element-type 'number
+ (setq fields-av (make-array num-fields :element-type '(or integer float)
:initial-element 0)))
(dotimes (i num-fields)
(declare (fixnum i))
(if *octet-sql-storage*
(ext:convert-string-to-bytes str charset:utf-8)
str))))
+ #-(and clisp unicode) (declare (string str))
+ (declare (type (integer 0 10000000) len))
(incf (aref fields-av i) len)
(when (> len (aref fields-max i))
(setf (aref fields-max i) len))))
(defun find-ufile (filename)
"Returns umls-file structure for a filename"
- (find-if #'(lambda (f) (string-equal filename (fil f))) *umls-files*))
+ (find-if #'(lambda (f) (string= filename (fil f))) *umls-files*))
+
+(defun position-field-file (filename fieldname)
+ "Returns the position of a field in a file"
+ (let ((ufile (find-ufile filename)))
+ (unless ufile
+ (warn "Unable to find ufile for filename ~A." filename)
+ (return-from position-field-file nil))
+ (let ((pos (position fieldname (fields ufile) :test #'string=)))
+ (unless pos
+ (warn "Unable to find field ~A in ufile ~S." fieldname ufile)
+ (return-from position-field-file nil))
+ pos)))
(defun find-ucols-for-ufile (ufile)
"Returns list of umls-cols for a file structure"
:des des :cls cls
:rws rws :bts bts :fields fields
:table (filename-to-tablename file))))
- (setf (ucols ufile) (find-ucols-for-ufile ufile))
ufile)))
+(defun set-ucols-for-ufiles (ufiles)
+ (dolist (ufile ufiles)
+ (setf (ucols ufile) (find-ucols-for-ufile ufile))))
+
(defun datatype-for-colname (colname)
"Return datatype for column name"
(second (find colname +col-datatypes+ :key #'car :test #'string-equal)))
(defun canonicalize-column-type (type)
(cond
+ ((string-equal type "TINYINT")
+ (case *umls-sql-type*
+ (:mysql "TINYINT")
+ ((:postgresql :postgresql-socket) "INT1")
+ (:oracle "NUMBER(3,0)")
+ (t "INTEGER")))
((string-equal type "SMALLINT")
(case *umls-sql-type*
(:mysql "SMALLINT")
(sql-i (setf (sqltype col) (canonicalize-column-type "INTEGER")
(parse-fun col) #'parse-integer
(quote-str col) ""))
+ (sql-t (setf (sqltype col) (canonicalize-column-type "TINYINT")
+ (parse-fun col) #'parse-integer
+ (quote-str col) ""))
(sql-f (setf (sqltype col) (canonicalize-column-type "NUMERIC")
(parse-fun col) #'read-from-string
(quote-str col) ""))