r11209: fix test
[umlisp.git] / data-structures.lisp
1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
4 ;;;;
5 ;;;; Name:    data-structures.lisp
6 ;;;; Purpose:  Basic data objects for UMLisp
7 ;;;; Author:   Kevin M. Rosenberg
8 ;;;; Created:  Apr 2000
9 ;;;;
10 ;;;; $Id$
11 ;;;;
12 ;;;; This file, part of UMLisp, is
13 ;;;;    Copyright (c) 2000-2006 by Kevin M. Rosenberg, M.D.
14 ;;;;
15 ;;;; UMLisp users are granted the rights to distribute and use this software
16 ;;;; as governed by the terms of the GNU General Public License.
17 ;;;; *************************************************************************
18
19 (in-package #:umlisp)
20
21 ;;; Paths for files
22
23 (defparameter *umls-path*
24   (make-pathname :directory '(:absolute "srv" "umls" "2006AC"))
25   "Path for base of UMLS data files")
26
27 (defparameter *meta-path*
28     (merge-pathnames
29      (make-pathname :directory '(:relative "META"))
30      *umls-path*))
31
32 (defparameter *lex-path*
33     (merge-pathnames
34      (make-pathname :directory '(:relative "LEX"))
35      *umls-path*))
36
37 (defparameter *net-path*
38     (merge-pathnames
39      (make-pathname :directory '(:relative "NET"))
40      *umls-path*))
41
42 (defun umls-path! (p)
43   (setq *umls-path* p))
44
45
46 ;;; Structures for parsing UMLS text files
47
48 (defparameter *umls-files* nil
49   "List of umls file structures. Used when parsing text files.")
50 (defparameter *umls-cols* nil
51   "List of meta column structures. Used when parsing text files.")
52
53
54 ;; Special variables
55
56 (defvar *has-fixnum-class* (when (ignore-errors (find-class 'fixnum)) t))
57
58 (defvar *octet-sql-storage* t
59   "Used to deciding field lengths. Use nil if using UTF-8 database encoding. But, UTF-8 will cause MySQL to double the bytes used for fixed field sizes.")
60   
61 ;; Preliminary objects to replace structures
62
63 (defclass ufile ()
64   ((subdir :initarg :subdir :accessor subdir)
65    (dir :initarg :dir :accessor dir)
66    (fil :initarg :fil :accessor fil)
67    (table :initarg :table :accessor table)
68    (des :initarg :des :accessor des)
69    (fmt :initarg :fmt :accessor fmt)
70    (cls :initarg :cls :accessor cls)
71    (rws :initarg :rws :accessor rws)
72    (bts :initarg :bts :accessor bts)
73    (fields :initarg :fields :accessor fields)
74    (ucols :initarg :ucols :accessor ucols))
75   (:default-initargs :fil nil :table nil :des nil :fmt nil :cls nil :rws nil :bts nil
76                      :fields nil :ucols nil :subdir nil :dir nil)
77   (:documentation "UMLS File"))
78
79 (defclass ucol ()
80   ((col :initarg :col :accessor col)
81    (des :initarg :des :accessor des)
82    (ref :initarg :ref :accessor ref)
83    (min :initarg :min :accessor cmin)
84    (av :initarg :av :accessor av)
85    (max :initarg :max :accessor cmax)
86    (fil :initarg :fil :accessor fil)
87    (sqltype :initarg :sqltype :accessor sqltype)
88    (dty :initarg :dty :accessor dty :documentation "new in 2002: suggested SQL datatype")
89    (parse-fun :initarg :parse-fun :accessor parse-fun)
90    (quote-str :initarg :quote-str :accessor quote-str)
91    (datatype :initarg :datatype :accessor datatype)
92    (custom-value-fun :initarg :custom-value-fun :accessor custom-value-fun))
93   (:default-initargs :col nil :des nil :ref nil :min nil :av nil :max nil :fil nil
94                      :sqltype nil :dty nil :parse-fun nil :datatype nil
95                      :custom-value-fun nil)
96   (:documentation "UMLS column"))
97
98
99 (defmethod print-object ((obj ufile) (s stream))
100   (print-unreadable-object (obj s :type t)
101     (format s "~A" (fil obj))))
102
103 (defmethod print-object ((obj ucol) (s stream))
104   (print-unreadable-object (obj s :type t)
105     (format s "~A" (col obj))))
106
107