/************************************************************************/
/*									*/
/*	Deltree.pli							*/
/*	This program will delete a directory tree.			*/
/*	Dale Miller - UALR						*/
/*	20-Jul-1986							*/
/*									*/
/*	Rev. 1.0  20-Jul-1986						*/
/************************************************************************/
DELTREE: PROC OPTIONS(MAIN);

	%INCLUDE $RMSDEF;
	%INCLUDE $CLIDEF;

	DCL LIB$FIND_FILE		EXTERNAL ENTRY(CHAR(*),
					CHAR(*),
					FIXED BIN(31))
					RETURNS(FIXED BIN(31));

	DCL LIB$DELETE_FILE 		EXTERNAL ENTRY(CHAR(*))
					RETURNS(FIXED BIN(31));

	DCL LIB$GET_FOREIGN		EXTERNAL ENTRY(CHAR(*),
					CHAR(*),
					FIXED BIN(31))
					RETURNS(FIXED BIN(31));

	DCL LIB$PUT_OUTPUT		EXTERNAL ENTRY(CHAR(*))
					RETURNS (FIXED BIN(31));

	DCL CLI$GET_VALUE		EXTERNAL ENTRY(CHAR(*),CHAR(*))
					RETURNS(FIXED BIN(31));

	DCL CLI$PRESENT			EXTERNAL ENTRY(CHAR(*))
					RETURNS(FIXED BIN(31));

	DCL DIRNAM			CHARACTER(255);
	DCL FILE_TO_DELETE		CHARACTER(255);
	DCL DUMMY			CHARACTER(255);
	DCL STATUS			FIXED BIN(31);
	DCL IND				FIXED BIN(31);
	DCL CONTEXT			FIXED BIN(31);
	DCL LEN				FIXED BIN(31);
	DCL I				FIXED BIN(31);
	DCL LOG				BIT(1);

	LOG='0'B;
	IF(CLI$PRESENT('LOG')=261401) THEN LOG='1'B;

	STATUS = CLI$GET_VALUE('DIRECTORY',DIRNAM);

	LEN=INDEX(DIRNAM,']');
	IF(LEN=0)
	    THEN DO;
		PUT SKIP LIST('%DELTREE-E-INVDIR, Invalid directory name');
		GO TO FINISH;
		END;
	IF (SUBSTR(DIRNAM,LEN+1,255-LEN-1)^=' ')
	    THEN DO;
		PUT SKIP LIST('%DELTREE-E-INVDIR, Invalid directory name');
		GO TO FINISH;
		END;

	IF(INDEX(DIRNAM,'.')=0)
	    THEN DO;
		IND=INDEX(DIRNAM,'[');
		IF(IND=0)
		    THEN DO;
			PUT SKIP LIST
			    ('%DELTREE-E-INVDIR, Invalid directory name');
			GO TO FINISH;
	    	    END;
			
		FILE_TO_DELETE=SUBSTR(DIRNAM,1,IND-1)||'[000000]'||
		    SUBSTR(DIRNAM,IND+1,INDEX(DIRNAM,']')-IND-1)||'.DIR;*';
		END;
	    ELSE DO;
		DO I = LEN TO 1 BY -1 UNTIL (SUBSTR(DIRNAM,I,1)='.');
		END;
		FILE_TO_DELETE=SUBSTR(DIRNAM,1,I-1)||']'||
		    SUBSTR(DIRNAM,I+1,LEN-I-1)||'.DIR;*';
		END;

	STATUS = LIB$FIND_FILE (FILE_TO_DELETE, DUMMY,
	    CONTEXT);
	IF(STATUS ^= RMS$_NORMAL)
	    THEN DO;
		PUT SKIP LIST('%DELTREE-E-INVDIR, Invalid directory name');
		GO TO FINISH;
		END;

	CALL DELROUT(SUBSTR(DIRNAM,1,INDEX(DIRNAM,' ')-1));

	IF(LOG) THEN PUT SKIP EDIT('%DELTREE-I-DELFIL, Deleting ',
	    SUBSTR(DUMMY,1,INDEX(DUMMY,' ')-1))(A,A);
	STATUS = LIB$DELETE_FILE(DUMMY);

DELROUT: PROC(DIRNAM) RECURSIVE;

	%INCLUDE $RMSDEF;

	DCL LIB$FIND_FILE		EXTERNAL ENTRY(CHAR(*),
					CHAR(*),
					FIXED BIN(31))
					RETURNS(FIXED BIN(31));

	DCL LIB$DELETE_FILE 		EXTERNAL ENTRY(CHAR(*))
					RETURNS(FIXED BIN(31));

	DCL DIRNAM CHARACTER(*);
	DCL FILE_TO_DELETE		CHARACTER(255);
	DCL FNAME			CHARACTER(255) VARYING;

	DCL STATUS			FIXED BIN(31);
	DCL IND				FIXED BIN(31);
 	DCL CONTEXT			FIXED BIN(31);

	STATUS = RMS$_NMF;
	CONTEXT = 0;

	STATUS = LIB$FIND_FILE (DIRNAM||'*.*;*', FILE_TO_DELETE,
	    CONTEXT);

	DO WHILE((STATUS ^= RMS$_NMF)&(STATUS ^= RMS$_FNF));

	    IF(INDEX(FILE_TO_DELETE,'.DIR') ^=0)
		THEN DO;
		    IND=INDEX(FILE_TO_DELETE,']');
		    FNAME=SUBSTR(FILE_TO_DELETE,IND+1,
			INDEX(FILE_TO_DELETE,';')-IND-5);
		    CALL DELROUT(SUBSTR(FILE_TO_DELETE,1,IND-1)||
			'.'||FNAME||']');
		    END;
	    IF (LOG) THEN PUT SKIP EDIT
		('%DELTREE-I-DELFIL, Deleting ',SUBSTR(FILE_TO_DELETE,1,
		INDEX(FILE_TO_DELETE,' ')-1))(A,A);

	    STATUS = LIB$DELETE_FILE(FILE_TO_DELETE);

	    STATUS = LIB$FIND_FILE (DIRNAM||'*.*;*', FILE_TO_DELETE,
		CONTEXT);
	    END;


END DELROUT;
FINISH:
END DELTREE;