pax_global_header00006660000000000000000000000064126007414620014514gustar00rootroot0000000000000052 comment=e2ffdb0408b3c37d4eddd76c3a16881d5b6a98bf cl-ixf-20160929-git/000077500000000000000000000000001260074146200137355ustar00rootroot00000000000000cl-ixf-20160929-git/README.md000066400000000000000000000002451260074146200152150ustar00rootroot00000000000000# Tools to handle IBM PC version of IXF file format See http://www-01.ibm.com/support/knowledgecenter/SSEPGG_10.5.0/com.ibm.db2.luw.admin.dm.doc/doc/r0004667.html. cl-ixf-20160929-git/data.lisp000066400000000000000000000065731260074146200155520ustar00rootroot00000000000000;;; ;;; 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)))) cl-ixf-20160929-git/encodings.lisp000066400000000000000000000026521260074146200166040ustar00rootroot00000000000000;;; ;;;IXF File format encodings ;;; ;;; See http://www-01.ibm.com/software/globalization/ccsid/ccsid_registered.html (in-package #:ixf) (defvar *ixf-encodings-mapping* '(("09580" . :GBK) ("00932" . :CP932) ("29626" . :EUCJP) ("13242" . :EUCJP) ("00952" . :EUCJP) ("00953" . :EUCJP) ("00954" . :EUCJP) ("01252" . :CP1252) ("01251" . :CP1251) ;; ( . :UCS-2BE) ;; ( . :UCS-2LE) ;; ( . :UCS-2) ("01233" . :UTF-32BE) ("01235" . :UTF-32LE) ("01237" . :UTF-32) ("01201" . :UTF-16BE) ("01203" . :UTF-16LE) ("01205" . :UTF-16) ;; ( . :UTF-8B) ("01209" . :UTF-8) ;; ( . :ISO-8859-16) ("00923" . :ISO-8859-15) ;; ( . :ISO-8859-14) ("00921" . :ISO-8859-13) ;; ( . :ISO-8859-11) ;; ( . :ISO-8859-10) ("00920" . :ISO-8859-9) ("05012" . :ISO-8859-8) ("00916" . :ISO-8859-8) ("00813" . :ISO-8859-7) ("09005" . :ISO-8859-7) ("01089" . :ISO-8859-6) ("00915" . :ISO-8859-5) ("00914" . :ISO-8859-4) ("00913" . :ISO-8859-3) ("00912" . :ISO-8859-2) ("00819" . :ISO-8859-1) ("04133" . :EBCDIC-US) ("00437" . :ASCII)) "A alist of mapping from IBM CCSID to babel encodings.") (defun babel-encoding-for-code-page (code-page) "Return a babel encoding for given CODE-PAGE." (when code-page (or (cdr (assoc code-page *ixf-encodings-mapping* :test #'string=)) (error "Unknown Code Page ~s" code-page)))) cl-ixf-20160929-git/ixf.asd000066400000000000000000000031501260074146200152130ustar00rootroot00000000000000;;;; cl-ifx.asd (asdf:defsystem #:ixf :serial t :description "Tools to handle IBM PC version of IXF file format" :author "Dimitri Fontaine " :license "WTFPL" :version "0.1.0" :depends-on (#:split-sequence ; split sequences #:md5 ; check archive checksums #:alexandria ; utils #:babel ; Encoding conversions #:local-time ; Parsing timestamps #:cl-ppcre ; Regular expressions #:ieee-floats ; Decoding IEEE Floats ) :components ((:file "package") (:file "records" :depends-on ("package")) (:file "types" :depends-on ("package")) (:file "encodings" :depends-on ("package")) (:file "structs" :depends-on ("package" "records" "types" "encodings")) (:file "data" :depends-on ("package" "structs" "records" "types")) (:file "ixf" :depends-on ("package" "records" "types" "structs" "data")))) cl-ixf-20160929-git/ixf.lisp000066400000000000000000000027571260074146200154270ustar00rootroot00000000000000;;; ;;; API to read IBM ixf files. ;;; (in-package #:ixf) (defmacro with-ixf-stream ((var stream) &body body) "Executes BODY with VAR an IXF-FILE instance made from STREAM." `(let ((,var (make-ixf-file :stream ,stream))) (read-headers ,var) ,@body)) (defmacro with-ixf-file ((var filename) &body body) "Executes BODY with VAR an IXF-FILE instance made from FILENAME stream contents." `(with-open-file (s ,filename :element-type '(unsigned-byte 8)) (with-ixf-stream (,var s) ,@body))) (defun map-data (ixf map-fn) "Call map-fn on each row of data read from STREAM given IXF definition." (let ((stream (ixf-file-stream ixf))) (loop :while (< (file-position stream) (file-length stream)) :for record := (read-next-record stream) :when (data-record-p record) :do (funcall map-fn (read-next-row ixf record))))) (defmethod read-data ((ixf ixf-file)) "Return the data read from IXF as a list of vectors of values." (let ((stream (ixf-file-stream ixf))) (loop :while (< (file-position stream) (file-length stream)) :for record := (read-next-record stream) :when (data-record-p record) :collect (read-next-row ixf record)))) (defun read-ixf-file (filename) "Read FILENAME as an IXF file and return the IXF definition (table name, columns names and types, etc) and all its content as a list of vectors, each vector being a table's row, as mutliple values." (with-ixf-file (ixf filename) (values ixf (read-data ixf)))) cl-ixf-20160929-git/package.lisp000066400000000000000000000033131260074146200162210ustar00rootroot00000000000000(defpackage #:ixf (:use :cl) (:import-from #:split-sequence #:split-sequence) (:export #:with-ixf-stream #:with-ixf-file #:read-headers #:map-data #:read-data #:read-ixf-file #:read-next-record #:read-next-row ;; header structures #:ixf-header #:ixf-header-date #:ixf-header-time #:ixf-header-count #:ixf-header-code-page #:ixf-header-encoding #:ixf-column #:ixf-column-name #:ixf-column-nullable #:ixf-column-has-default #:ixf-column-default #:ixf-column-pkey-pos #:ixf-column-type #:ixf-column-desc #:ixf-table #:ixf-table-name #:ixf-table-creator #:ixf-table-source #:ixf-table-ncol #:ixf-table-columns #:ixf-table-pkey-name #:ixf-table-desc #:make-ixf-file #:ixf-file #:ixf-file-p #:ixf-file-header #:ixf-file-table ;; data types #:+bigint+ #:+blob+ #:+clob+ #:+blob-file+ #:+clob-file+ #:+dbclob-file+ #:+char+ #:+date+ #:+dbclob+ #:+decimal+ #:+decfloat+ #:+float+ #:+graphic+ #:+integer+ #:+longvarchar+ #:+longvargraphic+ #:+smallint+ #:+time+ #:+timestamp+ #:+varchar+ #:+vargraphic+ #:+blob-location-spec+ #:+dbclob-location-spec+ #:+dbblob-location-spec+)) cl-ixf-20160929-git/records.lisp000066400000000000000000000300271260074146200162710ustar00rootroot00000000000000;;; ;;; 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/r0004667.html (in-package :ixf) (defstruct (ixf-field (:conc-name field-) (:constructor make-field (name size type))) name size type) #| HEADER RECORD FIELD NAME LENGTH TYPE COMMENTS ---------- ------- --------- ------------- IXFHRECL 06-BYTE CHARACTER record length IXFHRECT 01-BYTE CHARACTER record type = 'H' IXFHID 03-BYTE CHARACTER IXF identifier IXFHVERS 04-BYTE CHARACTER IXF version IXFHPROD 12-BYTE CHARACTER product IXFHDATE 08-BYTE CHARACTER date written IXFHTIME 06-BYTE CHARACTER time written IXFHHCNT 05-BYTE CHARACTER heading record count IXFHSBCP 05-BYTE CHARACTER single byte code page IXFHDBCP 05-BYTE CHARACTER double byte code page IXFHFIL1 02-BYTE CHARACTER reserved |# (defvar *ixf-header* (list (make-field :IXFHRECL 06 'integer) (make-field :IXFHRECT 01 'character) (make-field :IXFHID 03 'string) (make-field :IXFHVERS 04 'string) (make-field :IXFHPROD 12 'string) (make-field :IXFHDATE 08 'string) (make-field :IXFHTIME 06 'string) (make-field :IXFHHCNT 05 'integer) (make-field :IXFHSBCP 05 'string) (make-field :IXFHDBCP 05 'string) (make-field :IXFHFIL1 02 'string)) "Definition of the IXF Header record.") #| TABLE RECORD FIELD NAME LENGTH TYPE COMMENTS ---------- ------- --------- ------------- IXFTRECL 006-BYTE CHARACTER record length IXFTRECT 001-BYTE CHARACTER record type = 'T' IXFTNAML 003-BYTE CHARACTER name length IXFTNAME 256-BYTE CHARACTER name of data IXFTQULL 003-BYTE CHARACTER qualifier length IXFTQUAL 256-BYTE CHARACTER qualifier IXFTSRC 012-BYTE CHARACTER data source IXFTDATA 001-BYTE CHARACTER data convention = 'C' IXFTFORM 001-BYTE CHARACTER data format = 'M' IXFTMFRM 005-BYTE CHARACTER machine format = 'PC' IXFTLOC 001-BYTE CHARACTER data location = 'I' IXFTCCNT 005-BYTE CHARACTER 'C' record count IXFTFIL1 002-BYTE CHARACTER reserved IXFTDESC 030-BYTE CHARACTER data description IXFTPKNM 257-BYTE CHARACTER primary key name IXFTDSPC 257-BYTE CHARACTER reserved IXFTISPC 257-BYTE CHARACTER reserved IXFTLSPC 257-BYTE CHARACTER reserved |# (defvar *ixf-table* (list (make-field :IXFTRECL 006 'integer) (make-field :IXFTRECT 001 'character) (make-field :IXFTNAML 003 'integer) (make-field :IXFTNAME 256 'string) (make-field :IXFTQULL 003 'integer) (make-field :IXFTQUAL 256 'string) (make-field :IXFTSRC 012 'string) (make-field :IXFTDATA 001 'character) (make-field :IXFTFORM 001 'character) (make-field :IXFTMFRM 005 'string) (make-field :IXFTLOC 001 'character) (make-field :IXFTCCNT 005 'integer) (make-field :IXFTFIL1 002 'string) (make-field :IXFTDESC 030 'string) (make-field :IXFTPKNM 257 'string) (make-field :IXFTDSPC 257 'string) (make-field :IXFTISPC 257 'string) (make-field :IXFTLSPC 257 'string)) "Definition of the IXF Table record.") #| COLUMN DESCRIPTOR RECORD FIELD NAME LENGTH TYPE COMMENTS ---------- ------- --------- ------------- IXFCRECL 006-BYTE CHARACTER record length IXFCRECT 001-BYTE CHARACTER record type = 'C' IXFCNAML 003-BYTE CHARACTER column name length IXFCNAME 256-BYTE CHARACTER column name IXFCNULL 001-BYTE CHARACTER column allows nulls IXFCDEF 001-BYTE CHARACTER column has defaults IXFCSLCT 001-BYTE CHARACTER column selected flag IXFCKPOS 002-BYTE CHARACTER position in primary key IXFCCLAS 001-BYTE CHARACTER data class IXFCTYPE 003-BYTE CHARACTER data type IXFCSBCP 005-BYTE CHARACTER single byte code page IXFCDBCP 005-BYTE CHARACTER double byte code page IXFCLENG 005-BYTE CHARACTER column data length IXFCDRID 003-BYTE CHARACTER 'D' record identifier IXFCPOSN 006-BYTE CHARACTER column position IXFCDESC 030-BYTE CHARACTER column description IXFCLOBL 020-BYTE CHARACTER lob column length IXFCUDTL 003-BYTE CHARACTER UDT name length IXFCUDTN 256-BYTE CHARACTER UDT name IXFCDEFL 003-BYTE CHARACTER default value length IXFCDEFV 254-BYTE CHARACTER default value IXFCREF 001-BYTE CHARACTER reference type IXFCNDIM 002-BYTE CHARACTER number of dimensions IXFCDSIZ varying CHARACTER size of each dimension |# (defvar *ixf-column* (list (make-field :IXFCRECL 006 'integer) (make-field :IXFCRECT 001 'character) (make-field :IXFCNAML 003 'integer) (make-field :IXFCNAME 256 'string) (make-field :IXFCNULL 001 'character) (make-field :IXFCDEF 001 'character) (make-field :IXFCSLCT 001 'character) (make-field :IXFCKPOS 002 'integer) (make-field :IXFCCLAS 001 'character) (make-field :IXFCTYPE 003 'integer) (make-field :IXFCSBCP 005 'string) (make-field :IXFCDBCP 005 'string) (make-field :IXFCLENG 005 'integer) (make-field :IXFCDRID 003 'integer) (make-field :IXFCPOSN 006 'integer) (make-field :IXFCDESC 030 'string) (make-field :IXFCLOBL 020 'integer) (make-field :IXFCUDTL 003 'integer) (make-field :IXFCUDTN 256 'string) (make-field :IXFCDEFL 003 'integer) (make-field :IXFCDEFV 254 'string) (make-field :IXFCREF 001 'character) (make-field :IXFCNDIM 002 'integer) (make-field :IXFCDSIZ nil nil))) #| DATA RECORD FIELD NAME LENGTH TYPE COMMENTS ---------- ------- --------- ------------- IXFDRECL 06-BYTE CHARACTER record length IXFDRECT 01-BYTE CHARACTER record type = 'D' IXFDRID 03-BYTE CHARACTER 'D' record identifier IXFDFIL1 04-BYTE CHARACTER reserved IXFDCOLS varying variable columnar data |# (defvar *ixf-data* (list (make-field :IXFDRECL 06 'integer) (make-field :IXFDRECT 01 'character) (make-field :IXFDRID 03 'integer) (make-field :IXFDFIL1 04 'string) (make-field :IXFDCOLS nil nil)) "Definition of the IXF Data record.") #| APPLICATION RECORD FIELD NAME LENGTH TYPE COMMENTS ---------- ------- --------- ------------- IXFARECL 06-BYTE CHARACTER record length IXFARECT 01-BYTE CHARACTER record type = 'A' IXFAPPID 12-BYTE CHARACTER application identifier IXFADATA varying variable application-specific data |# (defvar *ixf-application* (list (make-field :IXFDRECL 06 'integer) (make-field :IXFDRECT 01 'character) (make-field :IXFAPPID 12 'string) (make-field :IXFADATA nil nil)) "Definition of the IXF Application record.") ;; ;; Now read the bytes and give them required meaning ;; (defvar *record-types* `((#\H . ,*ixf-header*) (#\T . ,*ixf-table*) (#\C . ,*ixf-column*) (#\D . ,*ixf-data*) (#\A . ,*ixf-application*)) "All expected record types.") (defun read-integer (stream size) "Read a character encoded integer of SIZE from binary STREAM." (let ((bytes (make-array size :element-type '(unsigned-byte 8)))) (read-sequence bytes stream) (parse-integer (map 'string #'code-char bytes) :junk-allowed t))) (defun read-character (stream) "Read a single character from the binary STREAM." (code-char (read-byte stream))) (defun read-ascii-string (stream size) "Read an ascii string of SIZE characters from STREAM." (let ((bytes (make-array size :element-type '(unsigned-byte 8)))) (read-sequence bytes stream) (string-trim '(#\Nul) (map 'string #'code-char bytes)))) (defun read-binary-data (stream size) "Read a bunch of SIZE bytes in STREAM." (let ((bytes (make-array size :element-type '(unsigned-byte 8)))) (read-sequence bytes stream) bytes)) (defun read-field (stream field start length) "Read the next bytes of STREAM according to field definition." (declare (type ixf-field field)) (if (field-size field) (ecase (field-type field) (integer (read-integer stream (field-size field))) (character (read-character stream)) (string (read-ascii-string stream (field-size field)))) ;; varying field, read the rest of the column (read-binary-data stream (- (+ length 6) (- (file-position stream) start))))) (defun read-record (stream record-definition start length) "Read the next bytes of STREAM according to record definition" (loop :for field :in record-definition :collect (cons (field-name field) (read-field stream field start length)))) (defun read-next-record (stream) "Discover next record length and type, then read it." (let* ((start (file-position stream)) (length (read-integer stream 6)) (record-type (read-character stream)) (record-definition (cdr (assoc record-type *record-types*)))) (unless record-definition (error "Unknown record-type ~s found at position ~s." record-type start)) (prog1 (append (list (cons :type record-type)) ;; (list (cons :start start)) ;; (list (cons :length length)) (read-record stream (cddr record-definition) start length)) ;; ensure we skip any unread data that pertains to that record. (file-position stream (+ start length 6))))) (defun header-record-p (record) (char= #\H (get-record-property :type record))) (defun table-record-p (record) (char= #\T (get-record-property :type record))) (defun column-record-p (record) (char= #\C (get-record-property :type record))) (defun data-record-p (record) (char= #\D (get-record-property :type record))) (defun get-record-property (property record) "Return the property value for PROPERTY (a symbol) as found in RECORD." (cdr (assoc property record))) (defun check-record (record) "Given a record, do some basic validity checking." (let ((record-type (get-record-property :type record))) (case record-type (#\H (assert (string= "0002" (get-record-property :IXFHVERS record)))) (#\T (assert (char= #\C (get-record-property :IXFTDATA record))) (assert (char= #\M (get-record-property :IXFTFORM record))) (assert (string= "PC" (get-record-property :IXFTMFRM record))) (assert (char= #\I (get-record-property :IXFTLOC record)))) (#\C (assert (member (get-record-property :IXFCNULL record) '(#\Y #\N))) (assert (member (get-record-property :IXFCDEF record) '(#\Y #\N))) (assert (member (get-record-property :IXFCREF record) '(#\D #\R))) (assert (= (get-record-property :IXFCNDIM record) 0)))))) (defun validate-file (filename) "Validate that we can read FILENAME as an IXF file." (with-open-file (s filename :element-type '(unsigned-byte 8)) (let ((length (file-length s))) (loop :while (< (file-position s) length) :do (check-record (read-next-record s)))))) (defun collect-records (filename) "Validate that we can read FILENAME as an IXF file." (with-open-file (s filename :element-type '(unsigned-byte 8)) (let ((length (file-length s))) (loop :while (< (file-position s) length) :collect (read-next-record s))))) cl-ixf-20160929-git/structs.lisp000066400000000000000000000134041260074146200163370ustar00rootroot00000000000000;;; ;;; API to read IBM ixf files. ;;; (in-package #:ixf) (defstruct ixf-header date time count code-page encoding) (defstruct ixf-column name nullable has-default default pkey-pos type code-page encoding length d-id pos desc) (defstruct ixf-table name creator source ncol columns pkey-name desc) (defstruct ixf-file stream header table data-position) (declaim (inline get-code-page)) (defun get-code-page (code-page) "Return CODE-PAGE or NIL if it's 00000" (if (string= "00000" code-page) nil code-page)) (defun parse-encoding (record single-cp-property double-cp-property &key strict) "Read the encoding from the RECORD with properties such as :IXFHSBCP and :IXFHDBCP, or :IXFCSBCP and :IXFCDBCP" (let ((single-byte-code-page (get-code-page (get-record-property single-cp-property record))) (double-byte-code-page (get-code-page (get-record-property double-cp-property record)))) ;; we want to read only one value here. (when strict (assert (and (not (and (null single-byte-code-page) (null double-byte-code-page))) (not (and (null single-byte-code-page) (null double-byte-code-page)))))) (let ((cp (or single-byte-code-page double-byte-code-page))) (values cp (babel-encoding-for-code-page cp))))) (defmethod parse-header ((ixf ixf-file) record) "Given a record alist, parse its definition into IXF." (let ((header (setf (ixf-file-header ixf) (make-ixf-header)))) (setf (ixf-header-date header) (get-record-property :IXFHDATE record)) (setf (ixf-header-time header) (get-record-property :IXFHTIME record)) (setf (ixf-header-count header) (get-record-property :IXFHHCNT record)) ;; read the encoding, either Single-Byte Code Page or Double-Byte Code Page (multiple-value-bind (code-page encoding) (parse-encoding record :IXFHSBCP :IXFHDBCP :strict t) (setf (ixf-header-code-page header) code-page (ixf-header-encoding header) encoding)) ;; return the ixf structure itself ixf)) (defmethod parse-table-definition ((ixf ixf-file) record) "Parse a Table definition from its record." (let ((table (setf (ixf-file-table ixf) (make-ixf-table)))) (setf (ixf-table-name table) (subseq (get-record-property :IXFTNAME record) 0 (get-record-property :IXFTNAML record))) (setf (ixf-table-creator table) (subseq (get-record-property :IXFTQUAL record) 0 (get-record-property :IXFTQULL record))) (setf (ixf-table-source table) (get-record-property :IXFTSRC record)) (setf (ixf-table-ncol table) (get-record-property :IXFTCCNT record)) (setf (ixf-table-pkey-name table) (get-record-property :IXFTPKNM record)) (setf (ixf-table-desc table) (string-trim '(#\Space) (get-record-property :IXFTDESC record))) ;; prepare a vector of columns of the right size (setf (ixf-table-columns table) (make-array (ixf-table-ncol table) :element-type 'ixf-column)) (loop :for i :below (ixf-table-ncol table) :do (setf (aref (ixf-table-columns table) i) (make-ixf-column))) ;; return the ixf structure itself ixf)) (defmethod parse-column-definition ((col ixf-column) (header ixf-header) record) "Parse a Column definition from its record." (setf (ixf-column-name col) (subseq (get-record-property :IXFCNAME record) 0 (get-record-property :IXFCNAML record))) (setf (ixf-column-nullable col) (char= #\Y (get-record-property :IXFCNULL record))) (setf (ixf-column-has-default col) (char= #\Y (get-record-property :IXFCDEF record))) (when (ixf-column-has-default col) (setf (ixf-column-default col) (subseq (get-record-property :IXFCDEFV record) 0 (get-record-property :IXFCDEFL record)))) (setf (ixf-column-pkey-pos col) (get-record-property :IXFCKPOS record)) (setf (ixf-column-type col) (get-record-property :IXFCTYPE record)) (setf (ixf-column-length col) (get-record-property :IXFCLENG record)) (setf (ixf-column-d-id col) (get-record-property :IXFCDRID record)) (setf (ixf-column-pos col) (get-record-property :IXFCPOSN record)) (multiple-value-bind (code-page encoding) (parse-encoding record :IXFCSBCP :IXFCDBCP) (setf (ixf-column-code-page col) (or code-page (ixf-header-code-page header)) (ixf-column-encoding col) (or encoding (ixf-header-encoding header)))) (setf (ixf-column-desc col) (string-trim '(#\Space) (get-record-property :IXFCDESC record)))) (defmethod read-headers ((ixf ixf-file)) "Return an IXF-FILE data structure filled with information read from FILENAME." (let* ((stream (ixf-file-stream ixf)) (header-record (read-next-record stream))) (parse-header ixf header-record) (loop :with col-number := 0 :with cols := nil :while (or (null cols) (< col-number cols)) :for record := (read-next-record stream) ;; stop before data :until (char= #\D (get-record-property :type record)) ;; analyze records :when (char= #\T (get-record-property :type record)) :do (setf cols (ixf-table-ncol (ixf-file-table (parse-table-definition ixf record)))) :when (char= #\C (get-record-property :type record)) :do (let ((column (aref (ixf-table-columns (ixf-file-table ixf)) col-number))) (parse-column-definition column (ixf-file-header ixf) record) (incf col-number)) :finally (progn (setf (ixf-file-data-position ixf) (file-position stream)) (return ixf))))) cl-ixf-20160929-git/types.lisp000066400000000000000000000136241260074146200160000ustar00rootroot00000000000000;;; ;;; 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)))))