X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=parse-common.lisp;h=96f7b8ddef77cd7a026bb5579a4c8efb3dd516ba;hb=3db136b81ed93cbffde0597bf684d2366860e0f2;hp=ba7aef61c816e8b8d4bf6897254dcfefabe9efc1;hpb=8e895602ced5ab847ecc36c1eaa7be1c9a872a22;p=umlisp.git

diff --git a/parse-common.lisp b/parse-common.lisp
index ba7aef6..96f7b8d 100644
--- a/parse-common.lisp
+++ b/parse-common.lisp
@@ -45,10 +45,16 @@
 (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*)))
 
@@ -56,17 +62,23 @@
 "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)))
 
@@ -265,6 +277,12 @@ append a unique number (starting at 2) onto a column name that is repeated in th
 
 (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")
@@ -320,6 +338,9 @@ append a unique number (starting at 2) onto a column name that is repeated in th
     (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) ""))