Changeset main,2

Timestamp:

10/03/2007 05:22:12 AM (19 years ago)

Author:

David Owen <dsowen@…>

branch-nick:

xbase

revision id:

dsowen@fugue88.ws-20071003052212-1hkdi6br2hfdiyzl

Message:

Generates SQL to create tables.
Doesn't handle memos yet.

File:

• main/xbase.lisp (modified) (5 diffs)

main/xbase.lisp

@@ -31 +31 @@
                             :initial-element 0)))
       (read-sequence v stream)
-      (string-trim '(#\Nul) (map 'string #'code-char v))))
+      (string-trim '(#\Nul #\Space) (map 'string #'code-char v))))
   (:method ((type (eql 'date)) stream &optional format)
     (assert (stringp format))
@@ -130 +130 @@
      ,@(mapcar #'slot-from-field descs)))
 
+(defun sql-column (desc)
+  (with-slots (name type size precision) desc
+    (format nil "~A ~A"
+            name
+            (cond
+              ((string= type "C")
+               (format nil "VARCHAR(~A)" size))
+              ((string= type "N")
+               (if (= precision 0)
+                   (cond
+                     ((< size 10) "INTEGER")
+                     ((< size 19) "BIGINT")
+                     (t "NUMERIC(~A)" size))
+                   (format nil "NUMERIC(~A,~A)" (1- size) precision)))
+              ((string= type "D")
+               "DATE")
+              ((string= type "M")
+               (warn "MEMOs aren't implemented yet.")
+               "NUMERIC(10)")
+              (t (error "Bad type ~S." type))))))
+
+(defun sql-create (name descs)
+  (format nil "CREATE TABLE ~A(~{~A~@{,~A~}~});"
+          name
+          (mapcar 'sql-column descs)))
+
+(defstruct dbf-desc
+  name
+  filename
+  sql-create)
+
 (defvar *dbfs* (make-hash-table :test 'eq))
 
@@ -135 +166 @@
   (let ((descs (nth-value 1 (read-dbf-structure filename))))
     `(progn
-       (setf (gethash ',name *dbfs*) ,filename)
+       (setf (gethash ',name *dbfs*)
+             (make-dbf-desc :name ',name
+                            :filename ,filename
+                            :sql-create ,(sql-create name descs)))
        ,(struct-from-field-descs name descs))))
 
@@ -141 +175 @@
 
 ;;; Now file stuff.
-
-
 
 (defun read-records (in type &optional records)
@@ -156 +188 @@
       (read-records in type))))
 
-(define-dbf-struct unit-type "/home/dsowen/scott/main/db/brisutyp.dbf")
-(define-dbf-struct vendor "/home/dsowen/scott/main/db/brisvend.dbf")
+(define-dbf-struct unit-type "/home/dsowen/scott/local/bent-data/bentutyp.dbf")
+(define-dbf-struct vendor "/home/dsowen/scott/local/bent-data/bentvend.dbf")
+(define-dbf-struct phone "/home/dsowen/scott/local/bent-data/bentphon.dbf")
+(define-dbf-struct tenent-change "/home/dsowen/scott/local/bent-data/benttchg.dbf")