File: data.lisp

package info (click to toggle)
cl-ixf 20160929-1
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 96 kB
  • sloc: lisp: 674; makefile: 13
file content (85 lines) | stat: -rw-r--r-- 3,451 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
;;;
;;; Read IBM ixf files data.
;;;

(in-package #:ixf)

(defun parse-ixf-data (ixf column data)
  "Read data at given POSITION in DATA, with given LENGTH and DATA-TYPE."

  (let* ((data-type (ixf-column-type column))
         (length    (ixf-column-length column))
         (pos       (- (ixf-column-pos column) 1))
         (nullable  (ixf-column-nullable column))
         (encoding  (ixf-column-encoding column))
         (babel:*default-character-encoding* encoding))

    (unless (and nullable (parse-ixf-null data pos))
      (when nullable (setf pos (+ 2 pos)))
      (case data-type
        (#. +integer+   (parse-ixf-integer data pos))
        (#. +smallint+  (parse-ixf-smallint data pos))
        (#. +bigint+    (parse-ixf-bigint data pos))

        (#. +decimal+   (let* ((length    (format nil "~5,'0d" length))
                               (precision (parse-integer length :end 3))
                               (scale     (parse-integer length :start 3)))
                          (parse-ixf-decimal data pos precision scale)))

        (#. +float+     (parse-ixf-float data pos length))

        (#. +timestamp+ (parse-ixf-timestamp data pos length))
        (#. +time+      (parse-ixf-time data pos))
        (#. +date+      (parse-ixf-date data pos))

        (#. +char+      (parse-ixf-string data pos length))

        (#. +varchar+   (let ((length (parse-ixf-smallint data pos)))
                          ;; The current length indicators are 2-byte integers
                          ;; in a form specified by the IXFTMFRM field.
                          (parse-ixf-string data (+ pos 2) length)))

        (#. +blob-location-spec+   (parse-ixf-lls data pos))
        (#. +dbclob-location-spec+
            (parse-ixf-lls data pos
                           :relative-to (pathname
                                         (ixf-file-stream ixf))
                           :element-type 'character
                           :external-format encoding))
        (#. +dbblob-location-spec+ (parse-ixf-lls data pos))))))

(defmethod maybe-read-record ((ixf ixf-file) (col ixf-column) d-id)
  "Compare current D-ID value with expected (ixf-column-d-id col) and read
   another record when they don't match"
  (cond ((= (ixf-column-d-id col) d-id)
         ;; column still in current record
         nil)

        ((= (ixf-column-d-id col) (+ 1 d-id))
         ;; now we need the next D record...
         (let ((next-record (read-next-record (ixf-file-stream ixf))))
           (assert (char= #\D (get-record-property :type next-record)))
           next-record))

        (t
         (error "Lost sync: current d-id is ~a, next column to be read on ~d."
                d-id (ixf-column-d-id col)))))

(defmethod read-next-row ((ixf ixf-file) first-record)
  "Read next IXF row: each row in the table is represented by one or more
   records, so keep reading D records as we need them."
  (let ((table  (ixf-file-table ixf)))
    (loop
       :with row := (make-array (ixf-table-ncol table))
       :for i :below (ixf-table-ncol table)
       :for column :across (ixf-table-columns table)

       :for record
       := first-record
       :then (or (maybe-read-record ixf column current-d-id) record)

       :for current-d-id := (get-record-property :IXFDRID record)
       :for data := (get-record-property :IXFDCOLS record)

       :do (setf (svref row i) (parse-ixf-data ixf column data))
       :finally (return row))))