/*******************************************************************************
*	GROPE - Companion program to DLA.  GROPE is used to "touch" the
* indicated files, in order to initialize their expiration field.  In order to
* prepare your disk(s) for DLA;
*
*		o SET VOLUME/RETENTION=(9998-,9999-) DUA0:
*		o GROPE :==$SYS$LOGIN:GROPE
*		o GROPE DUA0:[*...]
*
*	Grope then "touches" each file on the disk (open, read 1 rec, close)
* in order to initialize the expiration date.  Note that the use of GROPE is
* an optional step, but is preferred.  If GROPE is not used, when DLA encounters
* a file with no expiration date, it will report <<No info>>.  GROPE effectively
* allows you to set a genesis date for DLA.
*
*	WARNING: If you make GROPE available to the general luser community,
* it will allow them to circumvent any benefits to be gained by implementing
* DLA.  However, it does come in handy so my files never age!!!!!!
*
*******************************************************************************/
#include <descrip.h>
#include <rms.h>
#include <ssdef.h>

main(argc,argv)
int argc;
char *argv[];
{
	struct FAB wild_fab;		/* Used in wildcard search */
	struct NAM wild_nam;		/* Used in conjunction with wild_fab */
	struct FAB open_fab;		/* Used in retreiving file allocation */
	struct RAB open_rab;		/* Used to read from the file */

	char buffer[512];
	char template[] = "*.*;*";	/* Default template */
	char fullname[256];		/* Input file spec given by user */
	char expanded[256];		/* File spec after logical expansion */
	char result[256];		/* Result from search */
	char last_dir[256];
	int this_dirlen, last_dirlen, compare_namlen;
	int this_namlen, compare_dirlen, counter;
	register status;

/* Initialize the wildcard FAB & NAM */
	wild_fab = cc$rms_fab;
	wild_nam = cc$rms_nam;

	wild_fab.fab$l_fna = fullname;
	wild_fab.fab$b_fac = FAB$M_GET;
	wild_fab.fab$l_fop = FAB$V_NAM;
	wild_fab.fab$l_nam = &wild_nam;
	wild_fab.fab$l_dna = template;
	wild_fab.fab$b_dns = strlen(template);

	wild_nam.nam$l_esa = expanded;
	wild_nam.nam$b_ess = 255;
	wild_nam.nam$l_rsa = result;
	wild_nam.nam$b_rss = 255;

/* Initialize the FAB and XAB's for open */
	open_fab = cc$rms_fab;
	open_rab = cc$rms_rab;

	open_fab.fab$l_fna = result;
	open_fab.fab$b_fac = (FAB$M_GET | FAB$M_BIO);
	open_fab.fab$b_shr = FAB$M_SHRGET;

	open_rab.rab$l_ubf = &buffer;
	open_rab.rab$w_usz = 2;
	open_rab.rab$l_rop = RAB$M_BIO;

/* First parse the file spec given to us */
	argv++;
	strcpy(fullname,template);
	if (argc == 2)
		sscanf(*argv,"%s",&fullname);

	wild_fab.fab$b_fns = strlen(fullname);
	if (((status = SYS$PARSE(&wild_fab)) &1) != 1)
		{
		printf("Error %d on parse\n",status);
		exit(status);
		}

/* Main loop */
	for(last_dirlen = 0;;)
		{
		if (((status = SYS$SEARCH(&wild_fab)) &1) != 1)
			{
			if (status == RMS$_NMF)
				break;
			    else
				{
				printf("Error %d on search\n",status);
				exit(status);
				}
			}

		expanded[wild_nam.nam$b_esl] = 0;
		result[wild_nam.nam$b_rsl] = 0;

		/* Establish some pointers and counters for comparison */
		for (counter=0;result[counter] != 0;counter++)
			{
			if (result[counter] == ']')
				this_dirlen = counter + 1;
			if (result[counter] == '\;')
				{
				this_namlen = counter - this_dirlen;
				break;
				}
			}

		/* Compare directories, print if new directory */
		if (this_dirlen > last_dirlen)
			compare_dirlen = this_dirlen;
		    else
			compare_dirlen = last_dirlen;
		if (strncmp(last_dir,result,compare_dirlen) != 0)
			{
			last_dirlen = this_dirlen;
			strncpy(last_dir,result,this_dirlen);
			last_dir[this_dirlen] = '\0';
			printf("	%s\n",last_dir);
			}
			
		open_fab.fab$b_fns = strlen(result);
		if (((status = SYS$OPEN(&open_fab)) &1) != 1)
			{
			if (status == RMS$_FLK)
				{
				printf("%-30s   <<File locked>>\n",
					(strchr(result,']') + 1));
				continue;
				}
			printf("%-30s   Error %d on open\n",
				(strchr(result,']') + 1),status);
			continue;
			}

		open_rab.rab$l_fab = &open_fab;
		if (((status = SYS$CONNECT(&open_rab)) &1) != 1)
			printf("%-30s   Error %d on connect\n",
				(strchr(result,']') + 1),status);
		    else
			if (((status = SYS$READ(&open_rab)) &1) != 1)
				printf("%-30s   Error %d on read\n",
					(strchr(result,']') + 1),status);

		if (((status = SYS$CLOSE(&open_fab)) &1) != 1)
			{
			printf("%-30s   Error %d on close... Aborting...\n",
				(strchr(result,']') + 1),status);
			exit(status);
			}
		}

	exit(SS$_NORMAL);
}
