!	Brad Merrill
!	14-Feb-85
!
!	This CREDIR command takes it input in the format:
!		@CREDIR <new-directory> <existing-directory>
!
!	The new directory is a carbon copy of the existing directory with
!	all of the information setup just right for "BUILD" command.
!	This thing parses all the "seemingly" relevant fields, and puts
!	them into the new directory.  If any of your favorite fields are
!	missing, or new ones added with time, please contact me.
!
!	1) Fix for change in EXEC output "user of groups" the "of" is new
!
command CREDIR;
  Begin
  string grp_dir,grp_txt,new_dir,new_txt,val,z,grp_dev,new_dev;
  integer p,flag,i,j,k;
  external procedure CSB_XPN;
  external string procedure CSB_STRVAL,CDR_Dev,CDR_Dir;

  p = 1;
  parse noise "a new directory";
  parse directory (parseonly,help "new directory name"):
    begin
    new_dev = CDR_Dev($ATOM);
    new_dir = CDR_Dir($ATOM);
    end;
  parse noise "just like directory";
  parse directory (help "directory in same group"):
    begin
    grp_dev = CDR_Dev($ATOM);
    grp_dir = CDR_Dir($ATOM);
    end;
  parse eol;

  while grp_dir = $NUL do
    begin
    prompt "Input a directory in the same group:";
    parse directory (help "directory in same group"):
      begin
      grp_dev = CDR_Dev($ATOM);
      grp_dir = CDR_Dir($ATOM);
      end;
    end;
!
!	The structures should match since some numbers change
!	across structures.
!
  if new_dev <> grp_dev then
     if new_dev = $NUL then
       new_dev = grp_dev
     else
       display "%Copying dir-info from different structures.";
!
! take a look at the group directory
!
  display "[Reading directory "+grp_dev+":"+grp_dir+"]";
  docommand "INFO DIR " + grp_dev+":"+grp_dir TO grp_txt;
!
! build the create string here
!
  new_txt = $NUL;
  val = CSB_STRVAL(p,grp_txt,"Working disk storage page limit ");
  if val = "+INF" then
    new_txt = new_txt + "WORK 77777777" + $CRLF
  else
    new_txt = new_txt + "WORK " + val + $CRLF;

  val = CSB_STRVAL(p,grp_txt,"Permanent disk storage page limit ");
  if val = "+INF" then
    new_txt = new_txt + "PERM 77777777" + $CRLF
  else
    new_txt = new_txt + "PERM " + val + $CRLF;

  if $search(grp_txt,"FILES-ONLY",p) <> 0 then
    new_txt = new_txt + "FILES-ONLY" + $CRLF;

  val = CSB_STRVAL(p,grp_txt,"Default file protection ");
  if val <> $NUL then new_txt = new_txt + "DEFAULT " + val + $CRLF;

  val = CSB_STRVAL(p,grp_txt,"Account default for LOGIN ");
  if val <> "- none set" then
    new_txt = new_txt + "ACCOUNT " + val + $CRLF;

  val = CSB_STRVAL(p,grp_txt,"Protection of directory ");
  if val <> $NUL then new_txt = new_txt + "PROT " + val + $CRLF;

  val = CSB_STRVAL(p,grp_txt,"Generations to keep ");
  if val <> $NUL then new_txt = new_txt + "GEN " + val + $CRLF;

  val = CSB_STRVAL(p,grp_txt,"Maximum subdirectories allowed ");
  if val <> $NUL then new_txt = new_txt + "MAX " + val + $CRLF;

  call CSB_XPN(p,grp_txt,"User of groups","USER",new_txt);
  call CSB_XPN(p,grp_txt,"Directory groups","DIR",new_txt);
  call CSB_XPN(p,grp_txt,"Subdirectory user groups allowed","SUB",new_txt);

  display "[Building directory "+new_dev+":"+new_dir+"]";
  docommand "BUILD "+new_dev+":"+new_dir+$CRLF+new_txt TO val;
  if $search(val,"?") <> 0 then abort val;
  display "[Verifying directory "+new_dev+":"+new_dir+"]";
  docommand "INFO DIR " + new_dev+":"+new_dir;
  end;
!	Brad Merrill
!	18-Oct-84
!
!	This CRESUB command takes it input in the format:
!		@CRESUB <new-directory>
!
!	The defaulting of storage is dependent on the storage
!	allocation of the current directory.
!		IF current directory = +INF then DEFAULT +INF
!		ELSE IF current directory > 3000 pages then DEFAULT 1000
!		ELSE DEFAULT 1/3 of the current directory limit
!	Also the default of subdirectories is 3 unless otherwise specified.
!
!	I have also made the permanent and working storage the same.
!
command CRESUB;
  Begin
  string group_dir,group_text;	! connected directory and its "INFO DIR"
  string new_dir,newdir_text;	! new directory name, and its build string
  string val;			! values from group_text
  integer maxsub,defpag;	! max number of subdir for new dir and
				! default number of pages for storage
  integer fl;			! flag for switch loop
  integer point,i;		! context "point" within group_text, and
				! an integer tmp
  external procedure CSB_XPN;	! expand multiple occurences seperated by comma
  external string procedure
		CSB_STRVAL,	! return str found between search str and EOL
		RAISE;		! return str that is uppercase of input str

  point = 1;
  maxsub = 0;
  parse noise "a new sub-directory";
lp:
  parse(
    field (help "new sub-directory name"):
	Begin
	if $ATOM = $NUL then abort "No sub-directory name specified";
	new_dir = RAISE($ATOM);
	fl = 0;
	End;
    switch(words(page_limit::1,max_sub_directories::2)):
	begin
	if $VALUE = 1 then
	  parse (
	    number(help"Page limit for directory",default "1000"):
	      if $value > 0
		then defpag = $value
		else abort "Negative page limit is illegal";
	    keyword(help "INFINITE, for +INF",words(INFINITE:1)):
	      defpag = -1;
	    )
	else
	  parse number(help"Maximum number of sub-directories allowed",
			default "0"):
	    if $value >= 0 
		then maxsub = $value
		else abort "Negative number of sub-directories is illegal";
	fl = 1;
	end;
	);
  if fl = 1 then goto lp;	! if no dir yet, loop
!
! take a look at the group directory
!
  group_dir = $connecteddirectory;
!  display "[Reading directory "+group_dir+"]";
  docommand "INFO DIR " TO group_text;
!
! build the create string here
!
  newdir_text = $NUL;
  val = CSB_STRVAL(point,group_text,"Working disk storage page limit ");
  if val = $NUL then abort "?No working quota in group directory";
!  display "[defpag="+$string(defpag)+"; val="+val+"]";
  if defpag > 0 then
    begin
    if val <> "+INF" then
      if defpag >= $integer(val)
	then abort "Working Page limit specified is too big for subdirectory";
    val = $string(defpag);
    end
  else
    if val <> "+INF"
	then abort "Current directory limit will not allow INFINITE"
	else val = "77777777";

  newdir_text = newdir_text + "WORK " + val + $CRLF;

  val = CSB_STRVAL(point,group_text,"Permanent disk storage page limit ");
  if val = $NUL then abort "?No permanent quota in group directory";

  if defpag > 0 then
    begin
    if val <> "+INF" then
      if defpag >= $integer(val) then
        abort "Permanent Page limit specified is too big for subdirectory";
    val = $string(defpag);
    end
  else
    if val <> "+INF"
	then abort "Current directory limit will not allow INFINITE"
	else val = "77777777";

  newdir_text = newdir_text + "PERM " + val + $CRLF;

  val = CSB_STRVAL(point,group_text,"Default file protection ");
  if val <> $NUL then newdir_text = newdir_text + "DEFAULT " + val + $CRLF;

!
! We always want our subdirectories to be FILES-ONLY.  If the user
! wants a LOGINable subdirectory, he should use CREDIR.
!
  newdir_text = newdir_text + "FILES-ONLY" + $CRLF;

  val = CSB_STRVAL(point,group_text,"Protection of directory ");
  if val <> $NUL then newdir_text = newdir_text + "PROT " + val + $CRLF;

  val = CSB_STRVAL(point,group_text,"Generations to keep ");
  if val <> $NUL then newdir_text = newdir_text + "GEN " + val + $CRLF;

  val = CSB_STRVAL(point,group_text,"Maximum subdirectories allowed ");
  if val <> $NUL then 
    if maxsub <> 0
	then newdir_text = newdir_text+"MAX "+$string(maxsub)+$CRLF;
!	else  newdir_text = newdir_text + "MAX 1"+$CRLF;

  call CSB_XPN(point,group_text,"Directory groups","DIR",newdir_text);

  new_dir = group_dir[1:$length(group_dir)-1] + "." + new_dir + ">";
  display "[Building directory "+new_dir+"]";

  docommand "BUILD " + new_dir + $CRLF + newdir_text;
  if $search(val,"?") <> 0 then abort val;
  display "[Verifying directory "+new_dir+"]";
  docommand "INFO DIR " + new_dir;  ! what does it look like
  end;
!
! CSB_STRVAL:
!	returns the string following the matching string and before EOL
!		if no EOL found then return $NUL
!		note: this will include blanks if there were not matched
!			by the match string.
!	else $NUL null string
!
string procedure CSB_STRVAL(integer point;string text,match);
   Begin
   integer st_point,tmp_point;
   string nxtfld,val;
	tmp_point = $search(text,match,point);
	if tmp_point = 0 then	return $NUL;
	st_point = tmp_point + $length(match);
	tmp_point = $search(text,$CR,st_point);
	if tmp_point = 0 then	return $NUL;
	val = text[st_point:tmp_point-st_point];
	point = st_point + $length(val);
	return val;
   End;
!
! CSB_XPN:
!	this is a special case subroutine which appends to a supplied text
!	string.  The case of multiple occurences of user,directory and
!	sub-directory where the numbers are seperated by commas,
!	is resolved by repeating the prefix text for each number individually.
!
procedure CSB_XPN(integer point;string source,text,prefix,new_text);
  Begin
  integer st_list,tmp_ptr,new_ptr,st_text;
  string list;

  st_text = $search(source,text,point);
  if st_text = 0 then return;
  st_list = st_text + $length(text);
  tmp_ptr = $search(source,$CR,st_list);
  if tmp_ptr = 0 then abort "?No EOL character found in EXPAND.";
  list = source[st_list:(tmp_ptr-st_list)];
! update our text pointer(which is now eol)
  point = tmp_ptr;
! count will contain number of multiple occurences of list items
  tmp_ptr = 1;
  new_ptr = 1;
  while new_ptr <> 0 do
    Begin
    new_ptr = $search(list,",",tmp_ptr);
    if new_ptr <> 0 then
      Begin
      new_text = new_text + prefix + list[tmp_ptr:new_ptr-tmp_ptr] + $CRLF;
      tmp_ptr = new_ptr + 1;
      end;
    end;
  new_text = new_text + prefix +
		list[tmp_ptr:($length(list)-(tmp_ptr-1))] + $CRLF;
  return;
  end;
string procedure CDR_Dev(string atom);
  begin
  external string procedure RAISE;
  integer i;
  i = $search(atom,":");
  if i = 0 then
    return $NUL
  else
    return RAISE(atom[1:i-1]);
  end;
string procedure CDR_Dir(string atom);
  begin
  external string procedure RAISE;
  integer i;
  i = $search(atom,"<");
  if i = 0 then
    begin
    i = $search(atom,"[");
    if i = 0 then return $NUL;
    end;
  return RAISE(atom[i:*]);
  end;
string procedure RAISE(string text);
    begin
    string tmp_str,raised_text;
    integer count;
	count = $length(text);
	while count > 0 do
	    begin
	    tmp_str = text[count:1];	! get the chr
	    if tmp_str >= "a"  then
		if tmp_str <= "z"  then tmp_str = $cvitc($cvcti(tmp_str)-32);
	    raised_text = tmp_str + raised_text;
	    count = count - 1;
	    end;
	return raised_text;
    end;