From: carl@SOL1.GPS.CALTECH.EDU (Carl J Lydick)
Newsgroups: comp.os.vms
Subject: Callable COPY (third try)
Date: 19 Nov 1992 01:38:16 GMT
Organization: HST Wide Field/Planetary Camera
Reply-To: carl@SOL1.GPS.CALTECH.EDU
NNTP-Posting-Host: sol1.gps.caltech.edu

Apologies for posting three nearly identical articles.  In the first one, there
were errors in the description of the arguments.  In the second, I realized not
too long after posting that it had a horrendous memory leak.  This one should
be reasonably stable.  Again, sorry about the multiple posts.

From time to time, somebody posts a request to this group for a "callable COPY."
They're usually referred to the callable CONVERT routines, but frequently they
complain that these routines actually do a CONVERT and access the input and
output files in record mode.  Well, here's a first cut at a callable COPY.  It
takes as arguments two string descriptors, passed by reference, the first
describing the string naming the input file, the second the output file.  I've
tested this with a simple sequential file and with an indexed file with four
keys in three areas.  It worked fine for both these tests under VMS v5.4-2.

However, I make no guarantee that this program will work for ALL files or for
all versions of VMS.  If you use it, let me know.  If you find any bugs, then
PLEASE let me know so I can fix them.  Enjoy.

/******************************************************************************\
 *  NOTLIB_COPY:  A function to copy an arbitrary file in block mode          *
 *  Copyright 1992 by the Caltech Odd Hack Committee.  No rights reserved     *
 *  Author:  Carl J Lydick (carl@sol1.gps.caltech.edu)                        *
 * 	Arguments:                                                            *
 *		inp_file                                                      *
 *                                                                            *
 *		VMS usage: input_filespec                                     *
 *		type: character-coded text string                             *
 *		access: read only                                             *
 *		mechanism: by descriptor--fixed                               *
 *		    length string descriptor                                  *
 *                                                                            *
 *		Name of the file to be copied.                                *
 *		---------------------------------                             *
 *		out_file                                                      *
 *                                                                            *
 *		VMS usage: output_filespec                                    *
 *		type: character-coded text string                             *
 *		access: read only                                             *
 *		mechanism: by descriptor--fixed                               *
 *		    length string descriptor                                  *
 *                                                                            *
 *		Name of the destination file.                                 *
\******************************************************************************/
#include descrip
#include rms
#include ssdef
copy(struct dsc$descriptor *inp_file, struct dsc$descriptor *out_file)
{	struct FAB inp_fab, out_fab;
	struct RAB inp_rab, out_rab;
	struct XABSUM xabsum;
	struct XABKEY *xabkey;
	struct XABALL *xaball;
	char buffer[32256];
	long stat;

	xabsum = cc$rms_xabsum;

	inp_fab = cc$rms_fab;
	inp_fab.fab$b_fac = FAB$M_BRO | FAB$M_GET;
	inp_fab.fab$l_fna = inp_file->dsc$a_pointer;
	inp_fab.fab$b_fns = inp_file->dsc$w_length;
	inp_fab.fab$l_fop = FAB$M_SQO;
	inp_fab.fab$b_shr = FAB$M_SHRPUT | FAB$M_UPI;
	inp_fab.fab$l_xab = &xabsum;

	if(((stat = SYS$OPEN(&inp_fab)) & 7) != 1)
		return stat;

	if(xabsum.xab$b_nok > 0)
	{	int i;

		if ((xabkey = (struct XABKEY *) malloc(xabsum.xab$b_nok *
			sizeof(struct XABKEY))) == 0)
			return SS$_INSFMEM;

		for(i = 0; i < xabsum.xab$b_nok; ++i)
		{	xabkey[i] = cc$rms_xabkey;
			xabkey[i].xab$l_nxt = xabkey + i + 1;
			xabkey[i].xab$b_ref = i;
		}
		xabkey[xabsum.xab$b_nok-1].xab$l_nxt = 0;
		xabsum.xab$l_nxt = xabkey;
	}
	if(xabsum.xab$b_noa > 0)
	{	int i;

		if((xaball = (struct XABALL *) malloc(xabsum.xab$b_noa *
			sizeof(struct XABALL))) == 0)
		{	free(xabkey);
			return SS$_INSFMEM;
		}
		for(i = 0; i < xabsum.xab$b_noa; ++i)
		{	xaball[i] = cc$rms_xaball;
			xaball[i].xab$l_nxt = xaball + i + 1;
			xaball[i].xab$b_aid = i;
		}
		xabkey[xabsum.xab$b_nok-1].xab$l_nxt = xaball;
		xaball[xabsum.xab$b_noa-1].xab$l_nxt = 0;
		
	}
	if(((stat = SYS$DISPLAY(&inp_fab)) & 7) != 1)
	{	free(xabkey);
		free(xaball);
		return stat;
	}
	out_fab = inp_fab;
	out_fab.fab$b_fac = FAB$M_BRO | FAB$M_PUT;
	out_fab.fab$l_fna = out_file->dsc$a_pointer;
	out_fab.fab$b_fns = out_file->dsc$w_length;
	out_fab.fab$w_ifi = 0;
	out_fab.fab$b_shr = FAB$M_SHRPUT | FAB$M_UPI;

	if(((stat = SYS$CREATE(&out_fab)) & 7) != 1)
	{	SYS$CLOSE(&inp_fab);
		free(xabkey);
		free(xaball);
		return stat;
	}

	inp_rab = cc$rms_rab;
	inp_rab.rab$l_fab = &inp_fab;
	inp_rab.rab$l_rop = RAB$M_BIO;

	out_rab = inp_rab;
	out_rab.rab$l_fab = &out_fab;
	out_rab.rab$w_isi = 0;

	if((((stat = SYS$CONNECT(&inp_rab)) & 7) != 1) ||
		(((stat = SYS$CONNECT(&out_rab)) & 7) != 1))
	{	SYS$CLOSE(&inp_fab);
		SYS$CLOSE(&out_fab);
		free(xabkey);
		free(xaball);
		return stat;
	}

	inp_rab.rab$l_ubf = buffer;
	inp_rab.rab$w_usz = 32256;
	out_rab.rab$l_rbf = buffer;

	while(1==1)
	{	if((((stat = SYS$READ(&inp_rab)) & 7) != 1) && stat != RMS$_EOF)
		{	SYS$CLOSE(&inp_fab);
			SYS$CLOSE(&out_fab);
			free(xabkey);
			free(xaball);
			return stat;
		}
		else if(stat == RMS$_EOF)
		{	SYS$CLOSE(&inp_fab);
			SYS$CLOSE(&out_fab);
			free(xabkey);
			free(xaball);
			return RMS$_NORMAL;
		}
		else
		{	out_rab.rab$w_rsz = inp_rab.rab$w_rsz;
			if(((stat = SYS$WRITE(&out_rab)) & 7) != 1)
			{	SYS$CLOSE(&inp_fab);
				SYS$CLOSE(&out_fab);
				free(xabkey);
				free(xaball);
				return stat;
			}
		}
	}
}
/***************************** END of NOTLIB_COPY *****************************/
--------------------------------------------------------------------------------
Carl J Lydick | INTERnet: CARL@SOL1.GPS.CALTECH.EDU | NSI/HEPnet: SOL1::CARL

Disclaimer:  Hey, I understand VAXen and VMS.  That's what I get paid for.  My
understanding of astronomy is purely at the amateur level (or below).  So
unless what I'm saying is directly related to VAX/VMS, don't hold me or my
organization responsible for it.  If it IS related to VAX/VMS, you can try to
hold me responsible for it, but my organization had nothing to do with it.