/* $RESTOREGROUP procedure written by Rivkah Stabiner */
/* copyright Eye Research Institute Jan, 1986 */
procedure(dirname);
	call erase;
	errcount = 0;
	/* Make sure you really want this procedure */
	type ' ';
	type '                     RS/1 DIRECTORY ARCHIVAL SYSTEM          ';
	type '                       (c) Eye Research Institute            ';
	type '-------------------------------------------------------------';
	type ' ';
	type 'This procedure restores a GROUP subdirectory';
	type 'It also deletes the VMS .ARK files';
	/* If the RS/1 sub-directory's name was omitted, get it now */
	set #dir to '#@';
	if nargs < 1 then
	   	do;

	type ' ';
	type '---------------------------------------------------------------';
	type ' ';
	type 'Next is a summary of your whole RS/1 group directory tree';
	type 'You may specify any group directory you want, but:';
	type 'The name of the RS/1 directory to restore must begin with #@';
	type 'Also, it must be a valid, existing directory';
	type ' ';
	type '---------------------------------------------------------------';
	If not yesanswer ('Do you want to continue?',true)
		then goto exit;
		   type $groupdirtree('#@','DIRS');
tryagain: 	   dirname = gettext(
'Please give name of RS/1 directory to restore, starting with #@: ');
		end;
	/* if the subdirectory name is valid, set the subdirectory */
		call dirtables(dirname,testname);
	if tableexists(testname) then
	   set #directory to dirname;
	else do;
	   	type "Not a valid, EXISTING subdirectory.  ";
		errcount = errcount + 1;
		strikevar = cat("...and it's ",errcount,"...");
		type strikevar;
		if errcount = 3 then do;
				type "strikes you're out!";
				goto exit;
		end;
		goto tryagain;
	end;
	rawvmsdir = ext(3,chars(dirname),dirname);
	repvmsdir = $replacetext('@','.',rawvmsdir,3);
	repvmsdir1 = $replacetext('@','__',repvmsdir);
	repvmsdir2 = $replacetext(' ','$$', repvmsdir1);
	rawprefix = userfile();
	prefix = ext(1,chars(rawprefix)-8,rawprefix);
	vmsdir = cat (prefix, 'RSGRPBACK.',repvmsdir2, ']');
	if chars(rawvmsdir) = 0 
		then vmsdir = cat(prefix, 'RSGRPBACK]');
	directfile = cat(vmsdir,'direct.out');	
	if (fileexists(directfile)) then
		call $ez_readfile(directfile,'#direct',100,' ',1,TRUE);
	else do;
		type "Nothing to dearchive";
		errcount = errcount + 1;
		strikevar = cat("...and it's ",errcount,"...");
		type strikevar;
		if errcount = 3 then do;
				type "strikes you're out!";
				goto exit;
		end;
		goto tryagain;
	     end;
do i = 1 to lastrow('#direct');
		dis row i of table #direct;
		if row i col 1 of table #direct <> empty then do;
			rawvmsvar = row  i col 1 of table #direct;
			lastpos = loc('.ARK',rawvmsvar);
			if lastpos <> 0
		   	   then vmsvar = ext(1,lastpos - 2, rawvmsvar);
			rawrsvar = cat ('#',vmsvar);
			reprsvar = $replacetext('$$',' ',rawrsvar);
			vmsvarfin = cat(vmsdir,vmsvar);
	/* Note to programmers:  an attempt is made to dearchive every
	entry in the VMS directory which has the extension .ARK. 
	The first .ARK file for a graph results in the graph being
	successfully dearchived; the second .ARK entry results in an
	warning message because the .ARK have already been dearchived and 
	deleted--which flashes by so rapidly on the screen that
	most users will ignore it.  Nothing is wrong. */
			if lastpos <> 0 then
	 		   call $dearchive(reprsvar,vmsvarfin,'false','true');
	        end;
	end;
	/* clean up any remaining files in the VMS directory */
	call erase;
	type "---------------------------------------------------------------";
	type " ";
	deletecom = cat('$ delete ',vmsdir,'direct.out;*');
	call putfile (deletecom,'deletecom.com');
	type "Please wait...";
	chain '@deletecom.com';
	type "Almost done...";
	delete table #direct;
	call sleep(1);
	chain 'delete deletecom.com;*';
exit:	type "That's all folks!";
end;