Thread: [R-gregmisc-users] SF.net SVN: r-gregmisc:[1653] trunk/SASxport/src

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

Revision: 1653
          http://sourceforge.net/p/r-gregmisc/code/1653
Author:   warnes
Date:     2013-05-11 20:10:12 +0000 (Sat, 11 May 2013)
Log Message:
-----------
Carry bug fix forward to handle loading xport data when a dataset ends on exactly 80 byte block boundry.

Modified Paths:
--------------
    trunk/SASxport/src/SASxport.c
    trunk/SASxport/src/SASxport.h

Added Paths:
-----------
    trunk/SASxport/src/foreign.h

Modified: trunk/SASxport/src/SASxport.c
===================================================================

--- trunk/SASxport/src/SASxport.c	2013-05-11 20:06:55 UTC (rev 1652)
+++ trunk/SASxport/src/SASxport.c	2013-05-11 20:10:12 UTC (rev 1653)
@@ -25,20 +25,9 @@
 #include <string.h>
 #include <R.h>
 #include <Rinternals.h>
-//#include "foreign.h"
+#include "foreign.h"
 #include "SASxport.h"
 
-
-#ifdef ENABLE_NLS
-#include <libintl.h>
-#define _(String) dgettext ("foreign", String)
-#define gettext_noop(String) (String)
-#else
-#define _(String) (String)
-#define gettext_noop(String) (String)
-#endif
-
-
 #define HEADER_BEG "HEADER RECORD*******"
 #define HEADER_TYPE_LIBRARY "LIBRARY "
 #define HEADER_TYPE_MEMBER "MEMBER  "
@@ -153,9 +142,9 @@
     int n;
 
     n = GET_RECORD(record, fp, 80);
-    if(n == 80 && strncmp(LIB_HEADER, record, 80) != 0)
+    if(n != 80 || strncmp(LIB_HEADER, record, 80) != 0)
 	error(_("file not in SAS transfer format"));
-  
+
     n = GET_RECORD(record, fp, 80);
     if(n != 80)
 	return 0;
@@ -230,8 +219,9 @@
     Free(lib_head);
 
     n = GET_RECORD(record, fp, 80);
-    if(n != 80 || strncmp(MEM_HEADER, record, 75) != 0 ||
-       strncmp("  ", record+78, 2) != 0)
+    if(n != 80 || 
+       strncmp(MEM_HEADER, record, 75) != 0 ||
+       strncmp("  ", record+78, 2) != 0 )
 	error(_("file not in SAS transfer format"));
     record[78] = '\0';
     sscanf(record+75, "%d", &namestr_length);
@@ -297,7 +287,7 @@
 {
     char *tmp;
     char record[81];
-    int i, n, nbytes, totwidth, nlength, restOfCard;
+    int i, n, totwidth, nlength, restOfCard;
     struct SAS_XPORT_namestr *nam_head;
 
     nam_head = Calloc(nvars, struct SAS_XPORT_namestr);
@@ -394,7 +384,6 @@
     for(i = 0; i < nvars; i++)
 	totwidth += nlng[i];
 
-    nbytes = 0;
     nlength = 0;
     tmp = Calloc(totwidth <= 80 ? 81 : (totwidth+1), char);
     restOfCard = 0;
@@ -433,6 +422,18 @@
 		break;
 	    }
 	}
+	else /* beware that the previous member can end on card
+	      * boundary with no padding */
+	  if (restOfCard == 80 && n == 80 &&
+	      strncmp(MEM_HEADER, tmp, 75) == 0 &&
+	      strncmp("  ", tmp+78, 2) == 0) {
+	    strncpy(record, tmp, 80);
+	    *tailpad = 0;
+	    record[78] = '\0';
+	    sscanf(record+75, "%d", &namestr_length);
+	    break;
+	  }
+	
 	if (fsetpos(fp, &currentPos)) {
 	    error(_("problem accessing SAS XPORT file"));
 	}
@@ -555,7 +556,7 @@
 	error(_("first argument must be a file name"));
     fp = fopen(R_ExpandFileName(CHAR(STRING_ELT(xportFile, 0))), "rb");
     if (!fp)
-	error(_("unable to open file"));
+        error(_("unable to open file: '%s'"), strerror(errno));
     namestrLength = init_xport_info(fp);
 
     ansLength = 0;
@@ -659,7 +660,7 @@
 	error(_("first argument must be a file name"));
     fp = fopen(R_ExpandFileName(CHAR(STRING_ELT(xportFile, 0))), "rb");
     if (!fp)
-	error(_("unable to open file"));
+        error(_("unable to open file: '%s'"), strerror(errno));
     if (fseek(fp, 240, SEEK_SET) != 0)
 	error(_("problem reading SAS XPORT file '%s'"),
 	      CHAR(STRING_ELT(xportFile, 0)));

Modified: trunk/SASxport/src/SASxport.h
===================================================================
--- trunk/SASxport/src/SASxport.h	2013-05-11 20:06:55 UTC (rev 1652)
+++ trunk/SASxport/src/SASxport.h	2013-05-11 20:10:12 UTC (rev 1653)
@@ -13,11 +13,11 @@
  *  along with this program; if not, a copy is available at
  *  http://www.r-project.org/Licenses/
  */
- 
+
 /*
  *  This file is derived from code in the SAS Technical Support
  *  document TS-140 "The Record Layout of a Data Set in SAS Transport
- *  (XPORT) Format" available as 
+ *  (XPORT) Format" available as
  *       http://ftp.sas.com/techsup/download/technote/ts140.html
  */
 
@@ -25,13 +25,15 @@
 #define SASEXPORT_H
 
 #include <string.h>		/* for memcpy and memset */
+#include "foreign.h"
 #include "swap_bytes.h"
+#include <errno.h>
 
 /* double cnxptiee(double from, int fromtype, int totype); */
 
 
 
-struct SAS_XPORT_header { 
+struct SAS_XPORT_header {
   char sas_symbol[2][8];	/* should be "SAS     " */
   char saslib[8];		/* should be "SASLIB  " */
   char sasver[8];
@@ -40,11 +42,11 @@
   char sas_mod[16];
 };
 
-struct SAS_XPORT_member { 
+struct SAS_XPORT_member {
   char sas_symbol[8];
   char sas_dsname[8];
   char sasdata[8];
-  char sasver[8]; 
+  char sasver[8];
   char sas_osname[8];
   char sas_create[16];
   char sas_mod[16];

Added: trunk/SASxport/src/foreign.h
===================================================================
--- trunk/SASxport/src/foreign.h	                        (rev 0)
+++ trunk/SASxport/src/foreign.h	2013-05-11 20:10:12 UTC (rev 1653)
@@ -0,0 +1,77 @@
+/*
+ *
+ *  Common header file for the foreign package for R
+ *
+ *  Copyright 2000-2000 Saikat DebRoy <sa...@st...>
+ *                      Douglas M. Bates <ba...@st...>,
+ *
+ *  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 2 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, write to the Free
+ *  Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+ *  Boston, MA 02110-1301  USA
+ *
+ */
+
+#ifndef FOREIGN_H
+#define FOREIGN_H
+
+#include <R.h>
+#include <Rinternals.h>
+
+#ifdef ENABLE_NLS
+#include <libintl.h>
+#define _(String) dgettext ("foreign", String)
+#define gettext_noop(String) (String)
+#else
+#define _(String) (String)
+#define gettext_noop(String) (String)
+#endif
+
+#define CN_TYPE_BIG     1
+#define CN_TYPE_LITTLE  2
+#define CN_TYPE_XPORT   3
+#define CN_TYPE_IEEEB   CN_TYPE_BIG
+#define CN_TYPE_IEEEL   CN_TYPE_LITTLE
+
+#define BIG 4321
+#define LITTLE 1234
+#define UNKNOWN 0000
+
+#ifdef WORDS_BIGENDIAN
+# define CN_TYPE_NATIVE CN_TYPE_IEEEB
+# define endian BIG
+#else
+# define CN_TYPE_NATIVE CN_TYPE_IEEEL
+# define endian LITTLE
+#endif /* not WORDS_BIGENDIAN */
+
+typedef int R_int32;
+/* typedef short int16; unused */
+
+typedef double R_flt64;
+/* typedef float flt32; unused */
+
+#define FPREP_IEEE754 754
+#define FPREP FPREP_IEEE754
+
+#ifdef max
+# undef max
+#endif
+#ifdef min
+# undef min
+#endif
+#define max(a,b) ((a) >= (b) ? (a) : (b))
+#define min(a,b) ((a) <= (b) ? (a) : (b))
+
+#endif /* FOREIGN_H */

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.





Thread: [R-gregmisc-users] SF.net SVN: r-gregmisc:[1653] trunk/SASxport/src

r-gregmisc-users