File: types.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 (172 lines) | stat: -rw-r--r-- 6,036 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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
;;;
;;; Tools to handle IBM PC version of IXF file format
;;;
;;; http://www-01.ibm.com/support/knowledgecenter/SSEPGG_10.5.0/com.ibm.db2.luw.admin.dm.doc/doc/r0004669.html

(in-package :ixf)

(defconstant +bigint+          492)
(defconstant +blob+            404)
(defconstant +clob+            408)
(defconstant +blob-file+       916)
(defconstant +clob-file+       920)
(defconstant +dbclob-file+     924)
(defconstant +char+            452)
(defconstant +date+            384)
(defconstant +dbclob+          412)
(defconstant +decimal+         484)
(defconstant +decfloat+        996)
(defconstant +float+           480)
(defconstant +graphic+         468)
(defconstant +integer+         496)
(defconstant +longvarchar+     456)
(defconstant +longvargraphic+  472)
(defconstant +smallint+        500)
(defconstant +time+            388)
(defconstant +timestamp+       392)
(defconstant +varchar+         448)
(defconstant +vargraphic+      464)
(defconstant +blob-location-spec+   960)
(defconstant +dbclob-location-spec+ 964)
(defconstant +dbblob-location-spec+ 968) ; unnamed in the spec?

(defun parse-ixf-null (data pos)
  "Read a NULL indicator and returns t when the value is NULL."
  ;;
  ;; The null indicator is a two-byte value set to x'0000' for not null, and
  ;; x'FFFF' for null.
  ;;
  (and (= #xff (aref data pos))
       (= #xff (aref data (+ 1 pos)))))


;;;
;;; Reading numbers
;;;
(defun unsigned-to-signed (byte n)
  (declare (type fixnum n) (type unsigned-byte byte))
  (logior byte (- (mask-field (byte 1 (1- (* n 8))) byte))))

(defun parse-ixf-smallint (data pos)
  "Read a 2-byte integer."
  (unsigned-to-signed (logior (ash (aref data (+ 1 pos)) 8) (aref data pos)) 2))

(defun parse-ixf-unsigned-integer (data pos)
  "Read an unsigned 4-byte integer."
  (logior (ash (aref data (+ pos 3)) 24)
          (ash (aref data (+ pos 2)) 16)
          (ash (aref data (+ pos 1)) 8)
          (aref data pos)))

(defun parse-ixf-unsigned-bigint (data pos)
  "Read an unsigned 8-byte integer."
  (logior (parse-ixf-unsigned-integer data pos)
          (ash (parse-ixf-unsigned-integer data (+ 4 pos)) 32)))

(defun parse-ixf-integer (data pos)
  "Read a signed 4-byte integer."
  (unsigned-to-signed (parse-ixf-unsigned-integer data pos) 4))

(defun parse-ixf-bigint (data pos)
  "Read a signed 8-byte integer."
  (unsigned-to-signed (parse-ixf-unsigned-bigint data pos) 8))

(defun parse-ixf-decimal (data pos precision scale)
  "Read a DECIMAL BCD IBM format.

   The right documentation to be able to make sense of the data seems to be
   found at http://www.simotime.com/datapk01.htm, at least it allows
   progress to be made."

  (let* ((nbytes (floor (+ precision 2) 2))
         (bytes  (subseq data pos (+ pos nbytes)))
         (sign   (if (= #xD (ldb (byte 4 0) (aref bytes (- nbytes 1))))
                     -1 1)))
    (* sign
       (/
        (loop :for byte :across bytes
           :for num :from 1
           :for pow  := (expt 10 precision) :then (floor pow 100)
           :for high := (ldb (byte 4 4) byte)
           :for low  := (ldb (byte 4 0) byte)
           :when (= num nbytes) :sum (* high pow)
           :else :sum (+ (* high pow) (* low (/ pow 10))))
        (expt 10 scale)))))

(defun parse-ixf-float (data pos length)
  "Parse a FLOATING POINT machine IBM format."
  (cond
    ((= 4 length)
     (ieee-floats:decode-float32 (parse-ixf-unsigned-integer data pos)))

    ((= 8 length)
     (ieee-floats:decode-float64 (parse-ixf-unsigned-bigint data pos)))))


;;;
;;; Reading encoded strings
;;;
(defun parse-ixf-string (data pos length)
  "Read an encoded string in data from pos to length."
  (babel:octets-to-string data :start pos :end (+ pos length)))


;;;
;;; Reading ascii-encoded date and time strings
;;;
(defun parse-ixf-timestamp (data pos length)
  "Read an IXF timestamp string.

   From the docs:

   Each time stamp is a character string of the form
   yyyy-mm-dd-hh.mm.ss.nnnnnn (year month day hour minutes seconds
   fractional seconds).

   Starting with Version 9.7, the timestamp precision is contained in the
   IXFCLENG field of the column descriptor record, and cannot exceed 12.
   before Version 9.7, IXFCLENG is not used, and should contain blanks.

   Valid characters within TIMESTAMP are invariant in all PC ASCII code
   pages; therefore, IXFCSBCP and IXFCDBCP are not significant, and should
   be zero."
  (let ((datestring
         (map 'string #'code-char (subseq data pos (+ pos length 20)))))

    (cl-ppcre:register-groups-bind ((#'parse-integer year month day hour min sec frac))
        ("(....)-(..)-(..)-(..).(..).(..).(\\d+)" datestring)
      (let ((ns (* frac (expt 10 (- 9 length)))))
        (local-time:encode-timestamp ns sec min hour day month year)))))

(defun parse-ixf-time (data pos)
  "Read an IXF time ascii string."
  (let ((timestring (map 'string #'code-char (subseq data pos (+ pos 8)))))
    (substitute #\: #\. timestring)))

(defun parse-ixf-date (data pos)
  "Read an IXF date ascii string."
  (map 'string #'code-char (subseq data pos (+ pos 10))))


;;;
;;; external BLOB and CLOBs
;;;
(defun parse-ixf-lls (data pos
                      &key
                        relative-to
                        (element-type    '(unsigned-byte 8))
                        (external-format :ascii))
  "Parse a LOB Location Specifier."
  (let ((lls (babel:octets-to-string data :start pos)))
    (cl-ppcre:register-groups-bind (filename (#'parse-integer offset length))
        ("^(.*)\\.(\\d+)\\.(\\d+)/$" lls)
      (with-open-file (blob (make-pathname :defaults relative-to
                                           :name filename
                                           :type nil)
                            :direction :input
                            :element-type element-type
                            :external-format external-format)
        (file-position blob offset)
        (let ((bytes (make-array length :element-type element-type)))
          (read-sequence bytes blob)
          bytes)))))