/*
 * Make TESTING non-zero to enable test code.
 */
#define	TESTING	0

/*
 * RMS record level i/o routines for Vax-11 C only.
 * Rather crude.
 *
 * The following are provided:
 *
 *	#define	RMSSTUFF	char
 *
 *	RMSSTUFF *
 *	rms_fwild(filename, mode)
 *	char *filename;
 *	char *mode;
 *		Initializes internal buffers to open filename (which may
 *		contain wildcards) in the indicated mode (must equal "r"
 *		or "rn").  rms_fwild() returns NULL on error, else a pointer
 *		to the internal RMS data area.  See fwild() for more
 *		information.
 *
 *	rms_fnext(r)
 *	RMSSTUFF *r;
 *		Close the currently open file (if any) and open the next
 *		file that matches the wild-card specification.  Clean up
 *		and return NULL when no more files match the wild-card
 *		specification.
 *
 *	rms_get(buffer, buffer_length, r)
 *	char *buffer;
 *	int buffer_length;
 *	RMSSTUFF *r;
 *		Read the next record into the buffer.
 *
 *		If the rms_fwild() mode string is "rn", the record
 *		is not expanded or processed in any way.  rms_lrecl()
 *		must be called to obtain the record length.
 *
 *		If the rms_fwild() mode string is "r" (which is normal),
 *		the record will be null-trailed and unpacked according
 *		to the file's record format.  Note that the record will
 *		be in "RMS-style" rather than "C-style". This means that
 *		vanilla records will be formatted: "<LF>text<CR><EOS>".
 *		Note also that "binary" records are not processed correctly
 *		as inter-record null-bytes will be treated as terminators.
 *
 *	int
 *	rms_lrecl(r)
 *		Return the length of the last record successfully read
 *		by rms_get.  Undefined after errors (such as end of file).
 *
 *	rms_tell(r, rfa)
 *	RMSSTUFF *r;
 *	short int rfa[3];
 *		Return the record's file address as three short (16-bit)
 *		integers.  This is the address of the LAST record read
 *		by rms_get().  (C routines generally return the address
 *		of the next record to be read.)  Note that there is no
 *		correspondance between rfa's and logical text lines.
 *		The returned value is undefined before the first record
 *		has been read, and after any error or end of file condition.
 *
 *	rms_seek(r, rfa)
 *	RMSSTUFF *r;
 *	short int rfa[3];
 *		Setup so that the next record to be read will be that
 *		indicated by rfa[] -- which was returned by calling
 *		rms_tell().  If rfa[0..2] equal zero, the file will
 *		be rewound.
 *
 *	rms_rewind(r)
 *	RMSSTUFF *r;
 *		Rewinds the file.
 *
 *	rms_getname(r, buffer)
 *	RMSSTUFF *r;
 *	char *buffer;
 *		Copies the currently open file's name to the caller's
 *		data buffer buffer.
 *
 *	rms_message(r, why)
 *	RMSSTUFF *r;
 *	char *why;
 *		All system-level routines set a global value, rms_status.
 *		rms_message() prints the error message text corresponding
 *		to the current value of rms_status.  The message printed
 *		has the format:
 *			why current_filename: error_message.
 *		If why is NULL, only the error_message is printed.
 *	
 */
#include <stdio.h>
#include rms
#include ssdef
#include descrip
#include ctype

#define	TRUE	1
#define	FALSE	0
#define	EOS	0

typedef struct rmsstuff {
	struct	RAB	rab;		/* Record access buffer		*/
	struct	FAB	fab;		/* File access buffer		*/
	struct	NAM	nam;		/* File name buffer		*/
	struct	XABFHC	xab;		/* Extended attributes block	*/
	short int	lrecl;		/* Logical record length	*/
	char 		flag;		/* wild file open status	*/
	char		binary;		/* TRUE if "rn" mode		*/
	char		vfc[2];		/* Printfile header field	*/
	char		starname[NAM$C_MAXRSS + 1]; /* Wild file name	*/
	char		filename[NAM$C_MAXRSS + 1]; /* Open file name	*/
	char		*rbuffer;	/* Record input buffer		*/
} RMSSTUFF;

#define	ISWILD		0
#define	UNWILD		1
#define	OPENED		2

int		rms_status;		/* Set to last rms call status	*/
RMSSTUFF *
rms_fwild(filename, mode)
char		*filename;		/* What to open			*/
char		*mode;			/* Must be "r"			*/
/*
 * Setup fwild.  Returns NULL on failure, else a pointer to RMS stuff.
 * Which is equivalently a pointer to the RAB. (Note that the RAB points
 * in turn to the FAB.)
 */
{
	register RMSSTUFF	*r;

	if ((r = (char *)malloc(sizeof (RMSSTUFF))) == NULL)
	    return (NULL);
	if (strcmp(mode, "r") == 0)
	    r->binary = FALSE;
	else if (strcmp(mode, "rn") == 0)
	    r->binary = TRUE;
	else return (NULL);
	/*
	 * Initialize the data blocks
	 */
	r->fab = cc$rms_fab;			/* Preset fab,		*/
	r->nam = cc$rms_nam;			/*   name block		*/
	r->rab = cc$rms_rab;			/*   and record block	*/
	r->xab = cc$rms_xabfhc;			/*   file header block	*/
	r->rbuffer = NULL;			/* No record buffer yet	*/
	/*
	 * Stuff the fab
	 */
	r->fab.fab$l_nam = &r->nam;		/* fab -> name block	*/
	r->fab.fab$l_xab = &r->xab;		/* fab -> file header	*/
	r->fab.fab$l_fna = filename;		/* Argument filename	*/
	r->fab.fab$b_fns = strlen(filename);	/* ... size		*/
	/*
	 * Point the rab at the fab
	 */
	r->rab.rab$l_fab = &r->fab;		/* rab -> fab		*/
	/*
	 * Stuff the name block
	 */
	r->nam.nam$l_esa = r->starname;		/* Expanded filename	*/
	r->nam.nam$b_ess = NAM$C_MAXRSS + 1;	/* ... size		*/
	r->nam.nam$l_rsa = r->filename;		/* Result filename	*/
	r->nam.nam$b_rss = NAM$C_MAXRSS + 1;	/* ... max size		*/
	/*
	 * Parse the file name
	 */
	if ((rms_status = sys$parse(&r->fab)) != RMS$_NORMAL) {
	    return (fail(r, "parsing", filename));
	}
	/*
	 * Success -- null terminate expanded file name
	 * and set flag to ISWILD for non-wildcard calls.
	 */
	((char *)r->nam.nam$l_esa)[r->nam.nam$b_esl] = EOS;
	r->flag = ((r->nam.nam$l_fnb & NAM$M_WILDCARD) == 0) ? UNWILD : ISWILD;
	return (r);
}
char *
rms_fnext(r)
register RMSSTUFF	*r;
/*
 * Open the next valid file. return fd if successful, NULL if finished.
 */
{
	if ((r->flag & OPENED) != 0) {
	    /*
	     * A file was opened, close it for next go-around.
	     */
	    free(r->rbuffer);
	    r->rbuffer = NULL;
	    if ((rms_status = sys$close(&r->fab)) != RMS$_NORMAL) {
		return(fail(r, "closing", NULL));
	    }
	}
	switch (r->flag) {
	case (UNWILD | OPENED):
	    /*
	     * It wasn't a wildcard and has already been processed
	     */
	    free (r);			/* Take normal exit instead	*/
	    return (NULL);

	case UNWILD:
	    /*
	     * Not a wildcard file, first time through
	     */
	    r->fab.fab$l_fna = r->nam.nam$l_esa;	/* File name	*/
	    r->fab.fab$b_fns = r->nam.nam$b_esl;	/* Length	*/
	    break;			/* Go open it			*/

	case ISWILD:
	case (ISWILD | OPENED):
	    /*
	     * Look for the next match -- who says you can't write
	     * obscure structured code?
	     */
	    for (;;) {
		/*
		 * Look 'em up but skip any with protection violation errors.
		 */
		r->fab.fab$w_ifi = 0;
		if ((rms_status = sys$search(&r->fab)) == RMS$_NORMAL) {
		    /*
		     * Gotcha?
		     */
		    ((char *)r->nam.nam$l_rsa)[r->nam.nam$b_rsl] = EOS;
		    if (access(r->filename, 4) == 0) {
			/*
			 * Found the file, setup the name
			 * and length, and go open it.
			 */
			r->fab.fab$l_fna = r->nam.nam$l_rsa;
			r->fab.fab$b_fns = r->nam.nam$b_rsl;
			break;		/* Found file, go open it	*/
					/* Else, continue searching	*/
		    }
		}
		else if (rms_status != RMS$_PRV) {
		    /*
		     * Normal completion
		     */
		    if (rms_status != RMS$_NMF) {
			/*
			 * Unexpected error searching
			 */
			return (fail(r, "searching", r->nam.nam$l_esa));
		    }
		    else {
			free(r);
			return (NULL);
		    }
		}
		else {
		    /*
		     * Privilege violation when searching, search another.
		     */
		}
	    }				/* Forever loop exit		*/
	    break;			/* switch exit			*/
	}
	/*
	 * We have access to the file, open it.
	 * If this fails, something is dreadfully wrong.
	 */
	r->fab.fab$b_fac = FAB$M_GET;		/* Input only		*/
	r->fab.fab$l_fop |= FAB$M_NAM;		/* Use name block	*/
	((char *)r->fab.fab$l_fna)[r->fab.fab$b_fns] = EOS;
	if ((rms_status = sys$open(&r->fab)) != RMS$_NORMAL) {
	    return (fail(r, "opening file", NULL));
	}
	/*
	 * Normal exit -- set vfc area.
	 */
	r->flag |= OPENED;
	if (r->fab.fab$b_rat == FAB$M_PRN) {
	    if ((r->fab.fab$b_rfm != FAB$C_VFC || r->fab.fab$b_fsz != 2))
		return (fail(r, "printfile bad printfile", NULL));
	    r->rab.rab$l_rhb = &r->vfc;
	    r->rab.rab$w_usz = 512;
	}
	else {
	    r->rab.rab$w_usz = r->xab.xab$w_lrl;
	}
	if ((rms_status = sys$connect(&r->rab)) != RMS$_NORMAL)
	    return (fail(r, "connecting", NULL));
	if ((r->rbuffer = (char *)malloc(r->rab.rab$w_usz)) == NULL)
	    return (fail(r, "allocating record buffer for", NULL));
	r->rab.rab$l_ubf = r->rbuffer;
	return (r);
}
struct Fortran_format {
	char	byte;		/* First byte in the record		*/
	char	hbyte;		/* Output before the record		*/
	char	tbyte;		/* Output after the record		*/
	char	extra;		/* Extra newlines			*/
};

static struct Fortran_format format[] = {
	' ', '\n', '\r', 0,		/* SPACE  Normal newline	*/
	EOS,  EOS,  EOS, 0,		/* NULL   No control		*/
	'0', '\n', '\r', 1,		/* ZERO   One blank line	*/
	'1', '\f', '\r', 0,		/* ONE    New page		*/
	'+',  EOS, '\r', 0,		/* PLUS   Overstrike		*/
	'$', '\n',  EOS, 0,		/* DOLLAR Prompt		*/
	'*', '\n', '\r', 0,		/* Terminator (default == ' ')	*/
};

char *
rms_get(buffer, buffer_length, r)
char		*buffer;		/* User record			*/
int		buffer_length;		/* User record length		*/
RMSSTUFF	*r;			/* File information		*/
/*
 * Read the next record from the file.  Returns buffer or NULL on any
 * error.  rms_status has the status.
 *
 * Note: long record (truncation) is fatal.  The buffer length must
 * be long enough.  If in binary mode, the record is returned as-is,
 * else it will be null-trailed and format information expanded.
 */
{
	register char		*rstart;
	register char		*rend;
	register char		*buffp;

	struct Fortran_format	*ffp;
	char			fbyte;

	if ((rms_status = sys$get(&r->rab)) != RMS$_NORMAL) {
	    return (NULL);
	}
	r->rab.rab$b_rac = RAB$C_SEQ;		/* Sequential next time	*/
	if (r->binary) {
	    /*
	     * rms_fwild was called with "rn" mode
	     */
	    r->lrecl = r->rab.rab$w_rsz;
	    if (r->lrecl > buffer_length)
		return (NULL);
	    buffp = buffer;
	    rstart = (char *)r->rab.rab$l_rbf;
	    rend = (char *)r->rab.rab$l_rbf + r->rab.rab$w_rsz;
	    while (rstart < rend)
		*buffp++ = *rstart++;
	    return (buffer);
	}
	/*
	 * Output the header information.
	 */
	switch (r->fab.fab$b_rat) {

	default:				/* Undefined format	*/
	    return (stuff(r, buffer, buffer_length,
		EOS, 0, EOS, 0, 0));

	case FAB$M_FTN:				/* Fortran format	*/
	    fbyte = *(char *)r->rab.rab$l_rbf;
	    for (ffp = format; ffp->byte != fbyte && ffp->byte != '*'; ffp++);
	    return (stuff(r, buffer, buffer_length,
		ffp->hbyte, 1, ffp->tbyte, ffp->extra, 0));

	case FAB$M_CR:				/* Vanilla format	*/
	    return (stuff(r, buffer, buffer_length,
		'\n', 0, '\r', 0, 0));

	case FAB$M_PRN:				/* Printfile		*/
	    return (stuff(r, buffer, buffer_length,
		vfcb(r, 0), 0, vfcb(r, 1), vfcc(r, 0), vfcc(r, 1)));
	}
}

static int
vfcb(r, offset)
RMSSTUFF	*r;
int		offset;
/*
 * Return a header byte, given a RMS buffer and header offset
 */
{
	char		byte;

	byte = r->vfc[offset];
	if ((byte & 0200) == 0)
	    return (0);
	else if ((byte & 0100) == 0)
	    return (byte & 0x1F);
	else if ((byte & 0040) == 0)
	    return ((byte & 0x1F) | 0200);
	else return (0);			/* Reserved		*/
}

static int
vfcc(r, offset)
RMSSTUFF	*r;
int		offset;
/*
 * Return a vfc counter, given the RMS buffer and header offset.
 */
{
	char		byte;

	byte = r->vfc[offset];
	if ((byte & 0200) != 0)
	    return (0);
	else return (byte);
}

static char *
stuff(r, buffer, buffer_length, hbyte, offset, tbyte, hnewline, tnewline)
RMSSTUFF	*r;			/* The input record pointer	*/
char		*buffer;		/* The output record		*/
int		buffer_length;		/* Output record size		*/
char		hbyte;			/* Header byte			*/
int		offset;			/* Offset into data record	*/
char		tbyte;			/* Trailer byte			*/
int		hnewline;		/* VFC magic			*/
int		tnewline;		/* VFC magic			*/
/*
 * Stuff data into the record for rms
 */
{
	int	size_needed;
	char	*rstart;
	char	*rend;
	char	*buffp;
/*	
fprintf(stderr, "offset = %d, recsize = %d\n", offset, r->rab.rab$w_rsz);
fprintf(stderr, "hbyte = %d., tbyte = %d.\n", hbyte, tbyte);
fprintf(stderr, "hnewline = %d, tnewline = %d\n", hnewline, tnewline);
*/
	r->lrecl = r->rab.rab$w_rsz	/* Record size from sys$get	*/
	 + ((hbyte != EOS) ? 1 : 0)	/* If header byte		*/
	 + ((tbyte != EOS) ? 1 : 0)	/* If trailer byte		*/
	 - offset			/* For Fortran hacking		*/
	 + hnewline			/* For VFC hacking		*/
	 + tnewline;			/* For VFC hacking		*/
	if (r->lrecl >= buffer_length) {
	    return (NULL);		/* Long record failure		*/
	}
	buffp = buffer;			/* Output pointer		*/
	if (hbyte != EOS)
	    *buffp++ = hbyte;		/* Header byte first,		*/
	while (--hnewline >= 0)		/* Initial linefeed loop	*/
	    *buffp++ = '\n'; 
	rstart = (char *)r->rab.rab$l_rbf + offset;
	rend = (char *)r->rab.rab$l_rbf + r->rab.rab$w_rsz;
	while (rstart < rend)		/* The record itself		*/
	    *buffp++ = *rstart++;
	while (--tnewline >= 0)		/* Trailing linefeed loop
	    *buffp++ = '\n';
	if (tbyte != EOS)		/* Trailer byte last		*/
	    *buffp++ = tbyte;
	*buffp = EOS;			/* Always have an EOS termin.	*/
	return (buffer);
}
int
rms_lrecl(r)
RMSSTUFF	*r;
/*
 * Return logical record length
 */
{
	return (r->lrecl);
}

rms_tell(r, rfabuffer)
RMSSTUFF	*r;			/* File pointer			*/
unsigned short	rfabuffer[3];		/* RFA buffer			*/
/*
 * Copy the current record's rfa to rfabuffer.  Usage:
 *	rms_get(...)
 *	rms_tell(...)	-- has rfa of just-gotten record.
 *	...
 *	rms_seek(...)	-- setup get to reget the record
 *	rms_get(...)	-- reget the record.
 *
 * Note that there is NO correspondance between rfa/get and logical text
 * lines.  Also note that the get/tell sequence is reversed from standard
 * C usage.
 */
{
	rfabuffer[0] = r->rab.rab$w_rfa[0];
	rfabuffer[1] = r->rab.rab$w_rfa[1];
	rfabuffer[2] = r->rab.rab$w_rfa[2];
}

int rms_rewind(r)
RMSSTUFF	*r;
/*
 * Rewind the file
 */
{
	static short int rfa[3] = { 0, 0, 0 };

	return (rms_seek(r, rfa));
}

int
rms_seek(r, rfabuffer)
RMSSTUFF	*r;
short int	rfabuffer[3];
/*
 * Seek to the indicated record.  rfabuffer was set by rms_tell() above.
 * Return 0 if ok, 1 if error.
 *
 * Note, if rfabuffer[...] == zero, the file is rewound.
 */
{
	if (rfabuffer[0] == 0
	 && rfabuffer[1] == 0
	 && rfabuffer[2] == 0) {
	    if ((rms_status = sys$rewind(&r->rab)) != RMS$_NORMAL) {
		/* message(r, "rewinding", NULL); */
		return (1);
	    }
	}
	else {
	    r->rab.rab$w_rfa[0] = rfabuffer[0];
	    r->rab.rab$w_rfa[1] = rfabuffer[1];
	    r->rab.rab$w_rfa[2] = rfabuffer[2];
	    r->rab.rab$b_rac = RAB$C_RFA;	/* Do seek next time	*/
	}
	return (0);
}
rms_getname(r, buffer)
RMSSTUFF	*r;			/* File pointer			*/
char		*buffer;		/* Where to put it		*/
/*
 * Return current file name
 */
{
	strcpy(buffer, r->fab.fab$l_fna);
	return (buffer);
}

static RMSSTUFF *
fail(r, why, name)
RMSSTUFF	*r;			/* Buffer			*/
char		*why;			/* A little commentary		*/
char		*name;			/* Argument to perror		*/
/*
 * Problem exit routine
 */
{
/*
	if (name == NULL)
	    name = r->fab.fab$l_fna;
	message(r, why, name);
*/
	if (r->rbuffer != NULL)
	    free (r->rbuffer);
	free(r);
	return (NULL);
}

rms_message(r, why)
RMSSTUFF	*r;
char		*why;
/*
 * Print error message
 */
{
	extern char	*vms_etext();

	if (why == NULL) {
	    fprintf(stderr, "\n%s\n", vms_etext(rms_status));
	}
	else {
	    fprintf(stderr, "\n%s%s%s: %s\n",
		why, (why[0] == EOS) ? "" : " ",
		r->fab.fab$l_fna, vms_etext(rms_status));
	}
}

static
message(r, why, name)
RMSSTUFF	*r;			/* Buffer			*/
char		*why;			/* A little commentary		*/
char		*name;			/* File name			*/
/*
 * Print error message
 */
{
	extern char	*vms_etext();

	fprintf(stderr, "\nRMS error %x when %s %s\n", rms_status, why, name);
	fprintf(stderr, "\"%s\"\n", vms_etext(rms_status));
}


#if	TESTING > 0
/*
 * Test program for rms io
 */
#include <stdio.h>

char			line[133];
char			filename[133];
char			buffer[1024];
unsigned short int	rfavec[100][3];

main(argc, argv)
int		argc;
char		*argv[];
{
	RMSSTUFF	*r;
	int		i;
	int		rfaindex;
	int		index;
	unsigned short	rfa[3];

	for (;;) {
	    printf("next file, may have wildcards: ");
	    fflush(stdout);
	    gets(line);
	    if (feof(stdin))
		break;
	    r = rms_fwild(line, "r");
	    if (r == NULL)
		printf("fwild failed\n");
	    else {
		for (i = 0; rms_fnext(r) != NULL; i++) {
		    rfaindex = 0;
		    rms_getname(r, filename);
		    printf("\t\"%s\"\n", filename);
		    while (rms_get(buffer, sizeof buffer, r) != NULL) {
			rms_tell(r, rfa);
			if (rfaindex < 100) {
				rfavec[rfaindex][0] = rfa[0];
				rfavec[rfaindex][1] = rfa[1];
				rfavec[rfaindex][2] = rfa[2];
				rfaindex++;
			}
			eatcr(buffer);
			printf("%s", buffer);
/*
			if (buffer[0] != '\n')
			    putchar('\n');
			printf("%4d %04X %04X %04X\t",
				rfaindex - 1, rfa[0], rfa[1], rfa[2]);
			if (buffer[0] == '\n')
				printf("%s\n", &buffer[1]);
			else	printf("%s", buffer);
*/
		    }
		    for (;;) {
			printf("\nindex (-1 exits, <CR> reads on): ");
			fflush(stdout);
			if (gets(line) == NULL) {
			    clearerr(stdin);
			    break;
			}
			index = atoi(line);
			if (index < 0)
			    break;
			if (index >= rfaindex) {
			    printf("Illegal index %d, range is 0..%d\n",
				index, rfaindex-1);
			    continue;
			}
			if (line[0] != EOS) {
/*
			    printf("seek to %04X %04X %04X\n",
				rfavec[index][0], rfavec[index][1],
				rfavec[index][2]);
*/
			    if (rms_seek(r, &rfavec[index][0]) != 0) {
				printf("Can't seek?\n");
				continue;
			    }
			}
		    	if (rms_get(buffer, sizeof buffer, r) != NULL) {
/*
			    rms_tell(r, rfa);
			    printf("%4d %04X %04X %04X",
				index, rfa[0], rfa[1], rfa[2]);
*/
			    eatcr(buffer);
			    printf("%s", buffer);
			}
		    }
				
		}
		printf("%d files\n", i);
	    }
	}
}

static
eatcr(buffer)
char		*buffer;
/*
 * Cleanup buffer, removing <cr> at end of buffer, and <cr> in <cr><lf> context
 */
{
	char		*in;
	char		*out;

	for (in = out = buffer; *in != EOS; in++) {
	    if (*in == '\r') {
		if (in[1] == EOS) 
		    break;
		else if (in[1] == '\n')
		    continue;
	    }
	    *out++ = *in;
	}
	*out = EOS;
	return;
}
#endif