/*--------------------------------------------------------------------*/ /* NAME: CENGXMPL */ /* PRODUCT: SAS/TOOLKIT */ /* PURPOSE: Sample engine */ /* TYPE: Engine */ /* NOTES: This sample engine demonstrates how to write simple */ /* engines that interface with the engine "middle manager" */ /* (which in turn interfaces with the engine supervisor). */ /* Our sample engine reads and writes sequential files */ /* in a simple format. The sequential file can have many */ /* logical members. Each member begins with the record */ /* TOF-TOF-TOF-TOF */ /* and ends with the record */ /* EOF-EOF-EOF-EOF */ /* The first "real" record of each member contains the */ /* name of the member, followed by the number of variables.*/ /* The next n records (where n=number of variables) contain*/ /* the variable name, followed by N or C (for numeric or */ /* character), followed by an optional variable length. */ /* The remaining records for the member are the observation*/ /* records. There is one physical record for each obser- */ /* vation. */ /* Suppose we have 2 members, named TEMP1 and TEMP2. TEMP1 */ /* has 1 variable, X, which is numeric. TEMP2 has 2 */ /* variables, A (character length 8) and B (numeric std */ /* length). TEMP1 has one observation with X being 1. */ /* TEMP2 has 2 observations, with A being ABC and B being */ /* 1 for the first observation, and DEF and 2 for the */ /* second observation. The entire physical file would look */ /* like this (all records starting in column 1): */ /* TOF-TOF-TOF-TOF */ /* TEMP1 1 */ /* X N */ /* 1 */ /* EOF-EOF-EOF-EOF */ /* TOF-TOF-TOF-TOF */ /* TEMP2 2 */ /* A C 8 */ /* B N */ /* ABC 1 */ /* DEF 2 */ /* EOF-EOF-EOF-EOF */ /* To allow for nested blanks in character data, all */ /* underscores are converted to blanks. */ /* */ /* For simplicity's sake, this engine only allows */ /* character variables to have lengths up to 12. Any data */ /* after 12 bytes will be ignored and not be written out. */ /* */ /* This example assumes the input file will not be damaged */ /* in any way, but does check for nonexistent member. */ /*--------------------------------------------------------------------*/ /*-----include files needed-------------------------------------------*/ #include #include "uwproc.h" #include "engdef.h" #define BLANKS " " #define LAST_IO_READ 1 #define LAST_IO_WRITE 2 /*-----appropriate RID (record id) structure for this engine----------*/ struct RID { char ridchar; /* standard rid identifier */ long loc; /* value returned from ftell */ }; /*--------------------------------------------------------------------*/ /* Any engine can have an adjunctive structure to contain anything */ /* specific to the engine. In this example, we need to keep rids for */ /* the first record of the logical member (the 'TOF' record), the */ /* rid for the first observation for the logical member, and the rid */ /* for the most recently read observation. Also, we'll keep the file */ /* handle used by fopen et.al. outbuf is the buffer to hold output */ /* values. */ /* The pointer to this structure is specfid, located in the fid. */ /*--------------------------------------------------------------------*/ struct SPECFID { struct RID headrid; /* TOF rid */ struct RID engrid1; /* firstobs rid */ struct RID curr_rid; /* current obs rid */ FILE *fp; /* file handle */ char *outbuf; /* output buffer */ int lastio; /* last I/O operation (read/write) */ int newobs; /* observations added to end */ }; #ifdef PCX #pragma linkage(ENGXMPL,system) #endif /*-----main declaration-----------------------------------------------*/ int U_ENG( ENGXMPL ) ( argc , argv ) int argc; char * argv[]; { /*--------------------------------------------------------------------*/ /* The main routine is responsible for establishing the SAS/Toolkit */ /* SAS_ environment, and to indicate the proper status for this */ /* engine. The environment is established by calling UWPRCC. This */ /* allows any SAS_ routine to be called from a SAS/Toolkit engine. */ /* The engine status is described by setting various fields in the */ /* ENGSTAT structure. After this structure is properly set, the */ /* UWENGC routine is called to initialize the SAS/Toolkit engine */ /* environment. This environment establishment will load the engine */ /* "middle manager" and will control all subsequent calls from the */ /* engine supervisor to the user-written engine. */ /*--------------------------------------------------------------------*/ struct ENGSTAT engstat; /*-----initialize SAS/Toolkit SAS_ routine environment----------------*/ UWPRCC(0); /*-----zero out the engentry structure--------------------------------*/ SAS_ZZEROI((char *)&engstat,sizeof(struct ENGSTAT)); /*-----indicate the status of different features of the engine--------*/ engstat.support = 1; /* this engine is supported */ engstat.read = 1; /* this engine allows read access */ engstat.write = 1; /* this engine allows write access */ engstat.update = 1; /* this engine allows update access */ engstat.random = 1; /* this engine allows random access */ engstat.assign = 0; /* no additional ASSIGN code */ engstat.note = 1; /* this engine supports NOTEs */ engstat.ridandn = 0; /* no n-to-rid or rid-to-n support */ engstat.nopname = 1; /* LIBNAME without phsname allowed */ engstat.ridlen = sizeof(struct RID); /* rid structure size */ memcpy(engstat.engname,"ENGXMPL ",8); /* engine name */ /*-----load and call the engine middle manager initialization code----*/ UWENGC(argv,&engstat); /*-----return SUCCESS to indicate successful initialization-----------*/ return(SUCCESS); } /*--------------------------------------------------------------------*/ /* The ENGOPN routine is responsible for opening the sequential */ /* file. For input/update, we will search through the file looking */ /* for the requested member. For output, we will first try to find */ /* the member (via an open for input). If we find the member, we */ /* will overwrite starting at the logical member location. If we */ /* don't find the member, we append the new member onto the end of */ /* the file. */ /* */ /* Libmode explanation: */ /* NORMOPEN normal open */ /* LIBOPEN1 first input open for what will be a PROC */ /* CONTENTS series of opens */ /* LIBOPENN subsequent opens of a PROC CONTENTS series */ /* LIBOPENY second open request for a member, which can */ /* usually just be ignored */ /* */ /* What happens with a PROC CONTENTS open is that a request will */ /* first be made to obtain the member name, either with a LIBOPEN1 */ /* or LIBOPENN call. We will go ahead and open the member with that */ /* open request. Then, PROC CONTENTS will request that the member */ /* with that name be opened. This is a LIBOPENY call, which can be */ /* effectively ignored in our example, since the member has already */ /* been opened. */ /* */ /* Summary of required actions for ENGOPN: */ /* * open the member with the requested mode, returning the correct */ /* return code if unsuccessful. Return codes are XHENOLIB if the */ /* library can't be opened; XHENOMBR if the member can't be opened, */ /* X_ENOMEM if there's insufficient memory. X_WEOF is acceptable */ /* for PROC CONTENTS-style opens (LIBOPENN mode). Any other */ /* condition warrants the W_ESYSER setting with a message and len */ /* in the fid. */ /* * set the infostr.memname in the fileid (input only) */ /* this is necessary in the case of a directory read (for PROC */ /* COPY or PROC CONTENTS) to determine the next member name. */ /* * set the infostr.num_prec (number of observations) (input only) */ /* (this can be set to -1 if the number of observations is unknown) */ /* * set the infostr.num_vars in the fileid (input only) */ /* * set the infostr.max_rc (usually to 0) */ /* * set the infostr.num_lrec (usually to MACLONG) */ /* * set the infostr.crdate and infostr.modate (creation and mod */ /* dates) */ /* * set the infostr.label (data set label) */ /*--------------------------------------------------------------------*/ rctype ENGOPN(fid,libmode) fidptr fid; /* ptr to fileid ptr */ int libmode; /* open status */ { int j,k,l; char *p,*mode; long rc; FILE *fp; char temp[49]; /*-----simply return for LIBOPENY status since we're already open-----*/ if (libmode == LIBOPENY) return(SUCCESS); /*-----allocate our extended fileid for our engine's needs---------*/ if (fid->specfid == NULL) fid->specfid = (struct SPECFID *) SAS_XMALLOC(fid->poolid,sizeof(struct SPECFID),XM_ZERO); /*--------------------------------------------------------------------*/ /* When we open for output, this engine behaves differently if the */ /* member already exists. Therefore, we first attempt to open the */ /* member for input. If it's found, we will open the physical file */ /* with mode "r+", which indicates that we''l open in update mode, */ /* at the beginning of the file. Later on, we'll reposition to the */ /* place in the file where the member starts, so we can begin */ /* overwriting there. If the member isn't found, we use mode "a" */ /* which indicates append mode. */ /*--------------------------------------------------------------------*/ j = k = fid->opnmode; mode = " "; if (fid->opnmode & XO_OUTPUT) { int opnmode; /*-----reset open mode to input after saving original mode---------*/ opnmode = fid->opnmode; fid->opnmode &= ~XO_OUTPUT; fid->opnmode |= XO_INPUT; /*-----open for input; set mode to update if we found it-----------*/ if (ENGOPN(fid,libmode) == SUCCESS) { mode = "r+"; ENGCLS(fid,0,libmode); } else mode = "a"; /*-----reset to original open mode---------------------------------*/ fid->opnmode = opnmode; } /*-----standard mode "r" for standard input---------------------------*/ else if (fid->opnmode & XO_INPUT) mode = "r"; /*-----standard mode "r+" for standard update-------------------------*/ else if (fid->opnmode & XO_UPDATE) mode = "r+"; /*--------------------------------------------------------------------*/ /* Open the physical file with the appropriate mode. For input */ /* mode, we do expect that the file will exist, so we will first */ /* determine its existence with the access routine. This avoids */ /* unnecessary messages about the file not existing if we're trying */ /* to find a member to reset mode to update. If the file doesn't */ /* exist, and our open mode is input, the XHENOLIB (library not found)*/ /* return code is returned. If the file is found (access is success- */ /* fule), we try to fopen the file. If that open isn't successful, */ /* we will produce the message "File ... could not be opened */ /* successfully." We allocate the memory for the message and build */ /* it with SAS_XPSSTR. We set fid->errmsg and fid->errmsgl according- */ /* ly, and use the W_ESYSER return code to signal this condition. */ /* Note that the XHENOMEM return code would not be sufficient here, */ /* an unsuccessful open of the entire file is another matter. */ /* If the original open was for output, but we've already determined */ /* from a prior open that the logical member exists, we should fseek */ /* to the location of that member. */ /*--------------------------------------------------------------------*/ if (libmode == NORMOPEN || libmode == LIBOPEN1) { /*-----use libname if physical name not specified in LIBNAME stmt--*/ if (strlen(fid->physname) == 0) fid->physname = fid->libname; p = fid->physname; #ifdef SASC #ifdef MVS #define DSN_PREFIX "dsn:" #endif #ifdef CMS #define DSN_PREFIX "cms:" #endif { /*-----verify file existence---------------------------------------*/ if (fid->physname == fid->libname) strcpy(temp,"ddn:"); else if (memcmp(fid->physname,DSN_PREFIX,4) != 0) strcpy(temp,DSN_PREFIX); else temp[0] = 0; strcat(temp,fid->physname); p = temp; } #endif /*-----attempt to open the file------------------------------------*/ fid->specfid->fp = fopen(p,mode); /*-----produce message if that open failed-------------------------*/ if (fid->specfid->fp == NULL) { fid->errmsg = SAS_XMALLOC(fid->poolid,256,XM_EXIT); fid->errmsgl = SAS_XPSSTR(fid->errmsg,256,"File %s could not be \ opened successfully",fid->physname); fid->errmsg[fid->errmsgl++] = 0; return(W_ESYSER); } /*-----reposition if we're updating an existing member-------------*/ if ((fid->opnmode & XO_OUTPUT) && !memcmp(mode,"r+",2)) { fseek(fid->specfid->fp,(fid->specfid)->headrid.loc,0); } } /*--------------------------------------------------------------------*/ /* If we're opening for input, we search through the physical file */ /* to search for our member. If libmode is NORMOPEN, we must find */ /* an exact match on the member name. Otherwise, we are reading to */ /* the next member, and we fill in the next member name we find. Note */ /* that we may not be positioned at the beginning of a member, and so */ /* we must search for a TOF tag. We'll either find that or hit EOF */ /* trying. */ /*--------------------------------------------------------------------*/ fp = fid->specfid->fp; if (fid->opnmode & (XO_INPUT | XO_UPDATE)) { char record[82]; p = record; while(((fid->specfid->headrid.loc = ftell(fp)) || 1) && (rc = (fgets(p,80,fp)) != NULL)) { l = strlen(p) - 1; /*-----look for the TOF record----------------------------------*/ while(rc && !(l >= 15 && !memcmp("TOF-TOF-TOF-TOF",p,15))) { fid->specfid->headrid.loc = ftell(fp); rc = (fgets(p,80,fp) != NULL); l = strlen(p) - 1; } /*-----leave if there are difficulties (EOF or anything else)---*/ if (!rc) break; /*-----now read the first record after the TOF record-----------*/ fgets(p,80,fp); l = strlen(p) - 1; /*-----copy memname to a char8 and get the num_vars count-------*/ j = SAS_ZSTRPOS(p,l,' '); SAS_ZSTRMOV(p,j,temp,8); p += j+1; l -= (j+1); SAS_ZSTOL(p,l,0,&j,&fid->num_vars); /*-----we've found the member if a match or not NORMOPEN--------*/ if (libmode != NORMOPEN || !memcmp(fid->memname,temp,8)) break; } /*-----if at EOF, we indicate EOF or member not found accordingly--*/ if (!rc) { if (libmode != NORMOPEN) return(X_WEOF); /* indicates no more members */ rc = XHENOMBR; /* not found */ goto badopen; } /*-----set the memname, memtype, and num_prec as appropriate-------*/ memcpy(fid->memname,temp,8); fid->num_prec = -1; } /*-----if openmode is output------------------------------------------*/ else { /*-----write a leading TOF record----------------------------------*/ fputs("TOF-TOF-TOF-TOF\n",fp); fid->num_prec = 0; } /*-----initialize the remaining fields as appropriate-----------------*/ fid->max_rc = 0; fid->num_lrec = MACLONG; fid->crdate = fid->modate = SAS_ZDATTIM(); fid->lablen = 0; fid->label = NULL; memcpy(fid->type," ",8); /*-----return SUCCESS to indicate successful initialization-----------*/ return(SUCCESS); /*-----for a problem after an open, ensure we've closed the file------*/ badopen:; ENGCLS(fid,0,0); return(rc); } /*--------------------------------------------------------------------*/ /* The ENGCLS routine is responsible for closing the sequential file. */ /* for input or output. */ /* Libmode explanation: */ /* */ /* NORMCLOS normal close */ /* LIBCLOSN a close corresponding to an ENGOPN for */ /* LIBOPEN1 or LIBOPENN */ /* LIBCLOSL the last requested close */ /* */ /* What happens with a PROC CONTENTS open is that a LIBOPEN1 is */ /* requested, followed by LIBOPENY, followed by LIBCLOSN, followed */ /* by LIBOPENN, LIBCLOSN, LIBOPENN, LIBCLOSN, ... until the last */ /* close, which will be with libmode LIBCLOSL. What we do in this */ /* example is to perform a close on the physical file only with a */ /* LIBCLOSL (or a NORMCLOS). For output members, we will always */ /* write out an EOF record, since all output open/close operations */ /* are with NORMOPEN/NORMCLOS. We also perform some freeing of */ /* memory allocated during open time. */ /* */ /* Summary of required actions for ENGCLS: */ /* * close the member, and also the physical file if necessary */ /* * perform any additional closing processing */ /*--------------------------------------------------------------------*/ rctype ENGCLS(fid,disp,libmode) fidptr fid; /* fileid from engine middle mgr */ int disp; /* disposition (ignored) */ int libmode; /* libmode (explained above) */ { /*-----perform physical close if necessary----------------------------*/ if (libmode == NORMCLOS || libmode == LIBCLOSL) { if ((fid->opnmode & XO_OUTPUT) || ((fid->opnmode & XO_UPDATE) && fid->specfid->newobs)) fputs("EOF-EOF-EOF-EOF\n",fid->specfid->fp); fclose(fid->specfid->fp); } /*-----indicate success-----------------------------------------------*/ return(SUCCESS); } /*--------------------------------------------------------------------*/ /* The ENGNAM routine is responsible for creating the namestr struc- */ /* tures for all input variables, and for filling in the xonlist */ /* array with the variable names and types. The namestr array has */ /* already been allocated by the middle mgr. ENGNAM also fills in */ /* an array of namestr pointers, and an array of POSLNG structures */ /* to be used later by the middle mgr. */ /* */ /* The pos indicator we use is an offset into the buffer that we will */ /* be building in ENGRED. Pos is incremented based on the desired */ /* length of each variable. */ /* */ /* For each variable, ENGNAM */ /* * Fills in a namestr structure, setting nname, ntype, nlng, nid, */ /* nsubtype, nfj, nlabel, npos, nvar0, nform, nfl, nfd, nifl, and */ /* nifd. All fields are initialized to zero before ENGNAM is */ /* called, so all fields that can appropriately be zero need not be */ /* set. */ /* * Adds the namestr pointer into the ppn array of pointers. */ /* * Puts the npos and nlng into the POSLNG array. The lng value */ /* should be negative if we're defining a character variable. */ /* * Puts the nname and ntype into the xonlist array. */ /* */ /* In addition, ENGNAM */ /* * sets infostr.rec_len with the length of the input buffer that */ /* we will fill in within ENGRED. Note that this is the resulting */ /* buffer length. This buffer is better known as the program data */ /* vector, or PDV. */ /* * creates a special rid that corresponds to the RIDBOD logical */ /* value. After all, the next call to the engine code will be */ /* the first read. Therefore, we need to know the first observation */ /* location beforehand. In this example, we get the position by */ /* calling the ftell routine. */ /*--------------------------------------------------------------------*/ rctype ENGNAM(fid,pxonl) fidptr fid; /* fileid from engine middle mgr */ xonlptr pxonl; /* ptr to xonlist */ { nameptr np; nameptr *ppn; long j; long i,pos,s; int l; char *rp; struct POSLNG *psl; FILE *fp; char *namelist; /*-----get local copies of pointers that will be incremented----------*/ psl = fid->psl; ppn = fid->ppn; /*-----read through all variable records------------------------------*/ fp = fid->specfid->fp; namelist = SAS_XMALLOC(fid->poolid,8*fid->num_vars,0); for (i=pos=0;inum_vars;i++,psl++) { char record[82]; rp = record; /*-----read a variable record-------------------------------------*/ fgets(record,80,fp); l = strlen(record); /*-----copy in the name field into nname--------------------------*/ j = SAS_ZSTRPOS(rp,l,' '); np = ppn[i]; np->nname = namelist; namelist += 8; np->namelen = MIN(j,8); SAS_ZSTRMOV(rp,j,np->nname,8); /*-----set ntype from N or C indication---------------------------*/ rp += j+1; np->ntype = (*rp == 'N') ? 1 : 2; /*-----set nlng from the length indicator-------------------------*/ if (np->ntype == 2) { int jj; rp += 2; l -= j+3; SAS_ZSTOL(rp,l,0,&jj,&s); np->nlng = s; } else np->nlng = sizeof(double); /*-----set other values as constants------------------------------*/ np->nfj = 1; np->nlabel = BLANKS; np->nlablen = 0; SAS_ZFILLCI(' ',np->nform,8); SAS_ZFILLCI(' ',np->niform,8); /*-----set the two POSLNG fields----------------------------------*/ pxonl->offset = psl->pos = np->npos = pos; pxonl->len = psl->lng = np->nlng; if (np->ntype == 2) psl->lng = -(psl->lng); /*-----nvar0 is the 1-based variable number-----------------------*/ np->nvar0 = i+1; /*-----nfl, nfd, nifl, nifd all 0 in this example-----------------*/ /*-----fill in the xonlist element--------------------------------*/ memcpy(pxonl->name,np->nname,8); pxonl++->type = np->ntype; /*-----increment our running position indicator-------------------*/ pos += np->nlng; } /*-----set the rec_len accordingly------------------------------------*/ fid->rec_len = pos; /*-----for UPDATE mode, we'll need a buffer---------------------------*/ fid->specfid->outbuf = SAS_XMALLOC(fid->poolid, (long)(13*fid->num_vars),0); /*-----note the location of the first observation---------------------*/ fid->specfid->engrid1.loc = ftell(fp); return(SUCCESS); } /*--------------------------------------------------------------------*/ /* The ENGDFV routine is responsible for writing out the namestr */ /* structures into the format that is correct for the output file. */ /* The ppn field in the fileid points to an array of namestr pointers.*/ /* These namestrs are written out as appropriate. In our example, the */ /* variable name, N or C, and a length for character variables is */ /* written for each namestr. */ /* */ /* For each variable, ENGDFV */ /* * Writes out a namestr structure to the output file in whatever */ /* manner is appropriate. */ /* * Puts the npos and nlng into the POSLNG array. The lng value */ /* should be negative if we're defining a character variable. */ /* */ /* In addition, ENGDFV */ /* * Optionally writes any header or trailer data */ /* * Sets prec_len to the output buffer record length. Note that */ /* this is the buffer whose pointer will be passed to the ENGWRT */ /* routine. It contains the data that will be converted to the */ /* proper format to be written out. */ /*--------------------------------------------------------------------*/ rctype ENGDFV(fid,prec_len) fidptr fid; long *prec_len; { long i,def_nvar,pos; int j,l; char temp[40]; struct POSLNG *psl; nameptr *ppn; char c; FILE *fp; /*-----set local variables--------------------------------------------*/ def_nvar = fid->num_vars; ppn = fid->ppn; psl = fid->psl; /*--------------------------------------------------------------------*/ /* We allocate our output buffer here. This buffer is where we will */ /* write the image to be written out via xxwrite. We allow 13 bytes */ /* for each variable. We use BEST12 for numerics, and allow a max */ /* of 12 for character, and allow a trailing blank, for a total of */ /* 13 bytes for each variable. */ /*--------------------------------------------------------------------*/ fid->specfid->outbuf = SAS_XMALLOC(fid->poolid,13*def_nvar,0); fp = fid->specfid->fp; /*-----write out the header record with the namestr count-------------*/ j = SAS_ZSTRIP(fid->memname,8); memcpy(temp,fid->memname,j); temp[j++] = ' '; SAS_ZLTOS(def_nvar,temp+j,10); SAS_ZSTRJLS(temp+j,10,'l',&l,NULL); j += l; temp[j++] = '\n'; temp[j] = 0; fputs(temp,fp); /*-----write namestr records for each variable------------------------*/ for (i=pos=0;inlng; psl->lng = MIN(l,12); /* allowing only 12 bytes */ psl->pos = ppn[i]->npos = pos; pos += l; /*-----build the namestr record-----------------------------------*/ j = SAS_ZSTRIP(ppn[i]->nname,8)+1; SAS_ZSTRMOV(ppn[i]->nname,8,temp,j); if (ppn[i]->ntype == 2) { psl->lng = -(psl->lng); c = 'C'; } else c = 'N'; temp[j++] = c; if (c == 'C') { SAS_ZLTOS((long)l,temp+j,4); j += 4; } /*-----write out the record---------------------------------------*/ temp[j++] = '\n'; temp[j] = 0; fputs(temp,fp); } /*-----initialize prec_len with current buffer size-------------------*/ *prec_len = pos; return(SUCCESS); } /*--------------------------------------------------------------------*/ /* The ENGRED routine is responsible for filling in an observation */ /* buffer, using the POSLNG array. */ /* */ /* ENGRED should */ /* * read data from the input file and convert the data into the */ /* input buffer according to the POSLNG array */ /* * return X_WEOF if there are no more observations */ /* * set rptr to the address of the input buffer */ /* */ /* optionally, ENGRED should */ /* * take a note if the ENGNOT routine is supported. */ /*--------------------------------------------------------------------*/ rctype ENGRED(fid,rptr) fidptr fid; /* fileid from engine middle mgr */ char **rptr; /* returned pointer to input buffer */ { long i; long ll; char *rp,*cp; int j,k,l,m; double temp; struct POSLNG *psl; char record[82]; FILE *fp; rp = record; fp = fid->specfid->fp; /*-----take the note for subsequent ENGNOT calls----------------------*/ fid->specfid->curr_rid.loc = ftell(fp); /*-----read the next record from the input file-----------------------*/ i = (fgets(record,80,fp) == NULL); ll = strlen(record) - 1; /*-----set local variables--------------------------------------------*/ l = ll; cp = *rptr = fid->currec; psl = fid->psl; /*-----indicate EOF if EOF record seen--------------------------------*/ if (ll >= 15 && !memcmp("EOF-EOF-EOF-EOF",rp,15)) return(X_WEOF); /*-----go through each variable---------------------------------------*/ for (j=0;jnum_vars;j++,psl++) { /*-----strip off next token---------------------------------------*/ SAS_ZSTRJLS(rp,l,'l',&l,NULL); m = SAS_ZSTRPOS(rp,l,' '); k = (m != -1) ? MIN(l,m) : l; /*-----convert to numeric if appropriate--------------------------*/ if (psl->lng > 0) { SAS_XFXIN(rp,k,0,0L,&temp); memcpy(cp,&temp,sizeof(double)); cp += sizeof(double); } /*-----otherwise copy in the characters---------------------------*/ else { SAS_ZSTRMOV(rp,k,cp,-(psl->lng)); m = MIN(k,-psl->lng); SAS_ZSTRANC(cp,m,' ','_'); /* convert _ to blank ---*/ cp -= psl->lng; } /*-----to next field in record------------------------------------*/ rp += k; l -= k; } fid->specfid->lastio = LAST_IO_READ; return(0); } /*--------------------------------------------------------------------*/ /* The ENGWRT routine is responsible for converting an observation */ /* buffer into the proper output record format and writing the record.*/ /* */ /* ENGWRT should */ /* * convert all values to the output format and write the record */ /* * increment the num_prec value in the fileid by 1 to indicate */ /* another observation has been read */ /*--------------------------------------------------------------------*/ rctype ENGWRT(fid,rptr,status) fidptr fid; /* fileid from engine middle mgr */ char *rptr; /* ptr to data to convert to output fmt */ int status; /* 0 = not update 1 = update */ { long i; char *p,*pp; double d,temp; long totlen; int k; nameptr np; struct POSLNG *psl; /*-----get address of our temporary output buffer---------------------*/ pp = p = fid->specfid->outbuf; /*-----local variables being incremented------------------------------*/ np = fid->np; psl = fid->psl; /*-----loop through all variables to convert to output format---------*/ for (i=fid->num_vars,totlen=0;i > 0;i--,np++,psl++) { /*-----for numerics, convert to BEST12 format and left-justify----*/ if (psl->lng > 0) { memcpy(&temp,rptr+psl->pos,psl->lng); SAS_ZFPAD((ptr)&temp,psl->lng,&d); SAS_XFXPN(d,12,99,0L,p); SAS_ZSTRJLS(p,12,'l',&k,NULL); } /*-----for character, strip trailing blanks and convert blk to _--*/ else { k = -psl->lng; memcpy(p,rptr+psl->pos,k); k = SAS_ZSTRIP(p,k); SAS_ZSTRANC(p,k,'_',' '); } /*-----ensure a trailing blank------------------------------------*/ p[k++] = ' '; p += k; totlen += k; } /*-----increment observation count------------------------------------*/ fid->num_prec++; /*-----write out the converted record---------------------------------*/ pp[totlen] = '\n'; pp[totlen+1] = 0; if (status && fid->specfid->lastio == LAST_IO_READ) { fseek(fid->specfid->fp,(fid->specfid)->curr_rid.loc,0); } if (!status) fid->specfid->newobs = 1; fputs(pp,fid->specfid->fp); fid->specfid->lastio = LAST_IO_WRITE; return(SUCCESS); } /*--------------------------------------------------------------------*/ /* The ENGNOT routine is responsible for filling in an area with the */ /* rid of the most recently read observation. This rid was built when */ /* ENGRED was most recently called. */ /*--------------------------------------------------------------------*/ rctype ENGNOT(fid,ridp) fidptr fid; char *ridp; { memcpy(ridp,&fid->specfid->curr_rid,sizeof(struct RID)); return(SUCCESS); } /*--------------------------------------------------------------------*/ /* The ENGPNT routine is responsible for repositioning in the file */ /* based on a rid value. It must also handle these special rid */ /* values: */ /* */ /* * RIDBOD beginning of data */ /* */ /* These rid values must be handled if random access is supported: */ /* * RIDCURR the current observation */ /* * RIDNEXT the next observation */ /* * RIDPREV the previous observation */ /* */ /* The first byte of the rid will indicate what kind of rid it is. */ /* If the first byte is 0x00, this indicate a rid specific to this */ /* engine. If the rid cannot be handled, return XHEBDCSQ. */ /*--------------------------------------------------------------------*/ rctype ENGPNT(fid,ridp) fidptr fid; char *ridp; { struct RID *rid; FILE *fp; long curloc,ploc,loc; char p[82]; fp = fid->specfid->fp; /*-----handle special rids--------------------------------------------*/ if (*ridp == *RIDBOD) { fseek(fp,fid->specfid->engrid1.loc,0); } else if (*ridp == *RIDNEXT) { /* no action necessary; we're already positioned there */ } else if (*ridp == *RIDPREV) { curloc = fid->specfid->curr_rid.loc; /* if we're already at beginning of data, we don't have to reposition */ if (curloc == fid->specfid->engrid1.loc) return(X_WBOD); /* for this, we must point back to the first observation and read forward, recording each location before reading, until we match with the current record. Then, the previous read's location can be repositioned to. */ fseek(fp,fid->specfid->engrid1.loc,0); while((loc = ftell(fp)) != curloc) { fgets(p,80,fp); ploc = loc; } fseek(fp,ploc,0); fid->specfid->curr_rid.loc = ploc; } else if (*ridp == *RIDCURR) { fseek(fp,fid->specfid->curr_rid.loc,0); } /*-----reject any other non-engine rids-------------------------------*/ else if (*ridp != 0) { return(XHEBDCSQ); } /*-----handle engine rids by calling fseek----------------------------*/ else { rid = (struct RID *)ridp; fseek(fid->specfid->fp,rid->loc,0); } return(SUCCESS); } /*--------------------------------------------------------------------*/ /* The ENGTRM routine is responsible for terminating the engine */ /* environment. Anything the engine must do to shut down the */ /* environment goes here. */ /*--------------------------------------------------------------------*/ void ENGTRM() { }