# HG changeset patch
# User mparkan
# Date 1537271784 -7200
#      Tue Sep 18 13:56:24 2018 +0200
# Node ID 3a5732961f66cb51efa6c1f20ab4b6ac9426c4c8
# Parent  6c372ab806fec6f16d3027e80752fe7ed5c72aab
fixes dbfwrite crash (bug #53899) and vectorizes data record writing

diff -r 6c372ab806fe -r 3a5732961f66 inst/dbfwrite.m
--- a/inst/dbfwrite.m	Fri Aug 03 23:20:35 2018 +0200
+++ b/inst/dbfwrite.m	Tue Sep 18 13:56:24 2018 +0200
@@ -32,10 +32,12 @@
 ## @seealso{dbfread}
 ## @end deftypefn
 
-## Author: Philip Nienhuis <prnienhuis@users.sf.net>
-## Created: 2014-12-24
+## Authors: Philip Nienhuis <prnienhuis@users.sf.net>, Matthew Parkan <matthew.parkan@gmail.com>
+## Created: 2018-09-18
 
-function [status] = dbfwrite (fname, data)
+function [status] = dbfwrite(fname, data)
+
+  fclose('all'); ## close any open files
 
   status = 0;
   ## Input validation
@@ -78,31 +80,39 @@
     error ("dbfwrite: file name should have a '.dbf' suffix\n");
   endif
   ## Try to open file
-  fid = fopen (fname, "w+");
+  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");
-  upd = datevec (date);
-  fwrite (fid, upd(1) - 1900, "uint8");
-  fwrite (fid, upd(2), "uint8");
-  fwrite (fid, upd(3), "uint8");
-  fwrite (fid, nrecs, "uint32");
+  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");
+  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");
-
+  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)));
@@ -130,53 +140,61 @@
     recdesc(17) = uint8 (fldlng);                           ## Field length
     recdesc(18) = uint8 (decpl);                            ## Decimal places
     recdesc(32) = "\0";                                     ## Fill to byte# 32
-    fwrite (fid, recdesc, "char");
+    
+    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");
+  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");
-  fwrite (fid, reclen, "uint16");
+  fwrite (fid, fpos_data, "uint16", 0, 'ieee-le');
+  fwrite (fid, reclen, "uint16", 0, 'ieee-le');
 
   ## Write data2
   fseek (fid, fpos_data, "bof");
-  ## FIXME replace by vectorized code (num2str etc) & concatenating columns
-  ##       for speeding up
-  for ii=tr:nrecs+tr-1
-    ## Write "erased" byte
-    fwrite (fid, "\0", "uint8");
-    for jj=1:nfields
-      switch fldtyp(jj)
-        case "C"
-          txt = sprintf (["%" fldlngs{jj} "s"], data{ii, jj});
-        case "N"
-          txt = sprintf (["%" fldlngs{jj} "d"], data{ii, jj});
-        case "L"
-          if (data{ii, jj})
-            txt = "Y";
-          else
-            txt = "N";
-          endif
-        case "F"
-          txt = sprintf (["%" fldlngs{jj} "f"], data{ii, jj});
-        case "D"
-          % txt = sprintf (["%" fldlngs{jj} "s"], data{ii, jj});
+  
+  ## 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
-      endswitch
-      fwrite (fid, txt, "char");
-    endfor
-    ## Introduce small delay to avoid Octave stumblng over low-level write code
-    ## (see bug 53899)
-    pause (10^-6);
-  endfor
+      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
 
-  ## Close file
+  ## 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
+endfunction
\ No newline at end of file
