## Copyright (C) 2015-2018 Philip Nienhuis
##
## This program is free software; you can redistribute it and/or modify it
## under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 3 of the License, or
## (at your option) any later version.
##
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
## GNU General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with this program. If not, see .
## -*- texinfo -*-
## @deftypefn {Function File} [@var{status}] = dbfwrite (@var{fname}, @var{data})
## Write data in a cell array to a dbf (xBase) file, provisionally dBase III+.
##
## @var{fname} must be a valid file name, optionally with '.dbf' suffix.
## @var{data} should be a cell array of which the top row contains column
## names (character strings). Each column must contain only one class of data,
## except of course the top entry (the column header).
## Value type that can be written are character (text sring), numeric
## (integer and float, the latter with 6 decimal places), and logical.
##
## Ouput argument @var{status} is 1 if the file was written successfully, 0
## otherwise.
##
## Provisionally only dBase v. III+ files can be written without memos.
##
## @seealso{dbfread}
## @end deftypefn
## Authors: Philip Nienhuis , Matthew Parkan
## Created: 2018-09-18
function [status] = dbfwrite(fname, data)
fclose('all'); ## close any open files
status = 0;
## Input validation
if (! ischar (fname))
error ("dbfwrite: file name expected for argument #1\n");
elseif (! iscell (data))
error ("dbfwrite: cell array expected for argument #2\n");
elseif (! iscellstr (data (1, :)))
error ("dbfwrite: column header titles (text) expected on first row of data\n");
endif
## Column headers length cannot exceed 10 characters
toolong = [];
for ii=1:size (data, 2)
title = data{1, ii};
if (length (title) > 10)
toolong = [ toolong, ii ];
data(1, ii) = title(1:10);
endif
endfor
if (! isempty (toolong))
## Truncate headers if required and check for uniqueness
warning ("dbfwrite: one or more column header(s) > 10 characters - truncated\n");
fmt = [repmat(sprintf ("%d "), 1, numel (toolong))(:)];
printf ("Applies to columns %s\n", sprintf (fmt, toolong));
if (numel (unique (data(1, :))) < numel (data(1, :)))
error ("dbfwrite: column headers aren't unique - please fix data\n");
endif
endif
## Assess nr of records
## Data contains header row. Data toprow = 2
nrecs = size (data, 1) - 1;
tr = 2;
## Check file name
[pth, fnm, ext] = fileparts (fname);
if (isempty (ext))
fname = [fname ".dbf"];
elseif (! strcmpi (ext, ".dbf"))
error ("dbfwrite: file name should have a '.dbf' suffix\n");
endif
## Try to open file
fid = fopen (fname, "w", 'ieee-le'); % , 'ieee-le'
if (fid < 0)
error ("dbfwrite: could not open file %s\n", fname);
endif
## Start writing header
## Provisionally assume dbase III+ w/o memos
fwrite (fid, 3, "uint8", 0, 'ieee-le');
## Date of last update (YYMMDD), with YY the number of years since 1900
t = now;
upd = datevec(t) - [1900, 0, 0, 0, 0, 0];
fwrite(fid, uint8(upd(1:3)), 'uint8', 0, 'ieee-le');
## Number of records in the table
fwrite (fid, nrecs, "uint32", 0, 'ieee-le');
## The next two uint16 fields are to be written later, just fill temporarily
pos_lhdr = ftell(fid);
fwrite (fid, 0, "uint32", 0, 'ieee-le');
## Another place holder, write enough to allow next fseek to succeed
fwrite (fid, uint32 (zeros (1, 7)), "uint32", 0, 'ieee-le');
## Write record descriptors
nfields = size (data, 2);
fldtyp = "";
fldlngs = {};
reclen = 1; ## "Erased" byte first
fseek (fid, 32, "bof");
RR = zeros(32, nfields, 'uint8');
for ii=1:nfields
decpl = 0;
recdesc = sprintf ("%d", uint32 (zeros (1, 8)));
recdesc(1:10) = strjust (sprintf ("%10s", data{1, ii}), "left"); ## Field name
if (isnumeric ([data{tr:end, ii}]))
if (isinteger ([data{tr:end, ii}]) ||
all ([data{tr:end, ii}] - floor([data{tr:end, ii}]) < eps))
ftype = "N";
decpl = 0;
else
ftype = "F";
## ML compatibility for .dbf/.shp file: 6 decimal places
decpl = 6;
endif
fldlng = 20;
elseif (ischar ([data{tr:end, ii}]))
ftype = "C";
fldlng = max (cellfun (@(x) length(x), data(tr:end, ii)));
elseif (islogical ([data{tr:end, ii}]))
ftype = "L";
fldlng = 1;
endif
recdesc(12) = ftype; ## Field type
fldtyp = [ fldtyp ftype ];
recdesc(17) = uint8 (fldlng); ## Field length
recdesc(18) = uint8 (decpl); ## Decimal places
recdesc(32) = "\0"; ## Fill to byte# 32
RR(:,ii) = recdesc';
reclen += fldlng;
fldlngs = [ fldlngs; sprintf("%d", fldlng) ];
endfor
fwrite(fid, RR, "char", 0, 'ieee-le');
## Write header record terminator
fwrite (fid, 13, "uint8", 0, 'ieee-le');
## Remember position
fpos_data = ftell (fid);
## Write missing data in header
fseek (fid, pos_lhdr, "bof");
fwrite (fid, fpos_data, "uint16", 0, 'ieee-le');
fwrite (fid, reclen, "uint16", 0, 'ieee-le');
## Write data2
fseek (fid, fpos_data, "bof");
## Determine data record format
fmt = '\0';
for j = 1:nfields
switch fldtyp(j)
case "C" ## character
txt = ["%", fldlngs{j}, "s"];
case "N" ## numeric
txt = ["%" fldlngs{j} "d"];
case "L" ## logical
## txt = ["%", fldlngs{j}, "u"]; ## 0/1
txt = ["%", fldlngs{j}, "c"]; ## Y / N
case "F" ## float
txt = ["%" fldlngs{j} "f"];
case "D" ## date
## txt = sprintf (["%" fldlngs{jj} "s"], data{ii, jj});
otherwise
end
fmt = [fmt, txt]; % append format
end
## Convert boolean attributes to Y/N characters
str_logical = {'N','Y'};
for j = find(fldtyp == 'L')
data(2:end,j) = str_logical(double([data{2:end,j}] + 1))';
end
## Reshape data matrix
T = reshape([data(2:end,:)]', [], 1);
blob = sprintf(fmt, T{:});
## Write blob to file
fwrite(fid, blob, "char", 0, 'ieee-le');
fclose (fid);
status = 1;
endfunction