/* $RESTOREOWN 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 PRIVATE 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 private directory tree';
	type 'You may specify any private 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 $dirtree('@','DIRS');
	type '---------------------------------------------------------------';
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(2,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, 'RSOWNBACK.',repvmsdir2, ']');
	if chars(rawvmsdir) = 0 
		then vmsdir = cat(prefix, 'RSOWNBACK]');
	directfile = cat(vmsdir,'direct.out');	
	if (fileexists(directfile)) then
 		call $ez_readfile(directfile,'direct',100,' ',1,TRUE);
	else do;
		type "Nothing there to dearchive";
		errcount = errcount + 1;
		strikevar = cat("...and it's ",errcount,"...");
		type strikevar;
		if errcount = 3 then do;
			   type "strikes you're out!";
			   go to exit;
		end;
		go to 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 = 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;