/***********************************************************************/ 
/*DELDIR ver 1.16c - starts at the current directory and deletes all files */
/*and subdirectories in the target, then it deletes the target directory. */
/* Or, delete files matching a pattern in & under a directory          */
/* Enter DELDIR (no arguments) to see simple instructions              */
/*                                                                     */
/* Early version vritten by 
              Mark Polly - Progressive Insurance.  July 2, 1992        */
/* Extensively modified by Daniel Hellerstein                            
             (danielh@crosslink.net), 20 Dec 2002                    */
/***********************************************************************/

aesc='1B'x
cy_ye=aesc||'[37;46;m'
cyanon=cy_ye
normal=aesc||'[0;m'
bold=aesc||'[1;m'
re_wh=aesc||'[31;47;m'
reverse=aesc||'[7;m'

ARG user_dir
IF STRIP(user_dir,'B') = '' | strip(user_dir,'B')='?' | strip(user_dir)='-?'  THEN	DO 
        say  cyanon'DelDIR ver 1.16'normal||' Delete directory trees, or files within directory trees.'
        say ' '
        say reverse'Usage: 'normal
        say  ' * To delete a directory tree, just enter it''s name. For example: '
        say  '     'bold'D:>deldir e:\junk'normal
        say  ' * To selectively delete files within each directory in the tree, enter '
        say  '   the directory name, followed by a "file_pattern". For example: '
        say  '     'bold'D:>deldir e:\files\archive "index*.0*"'normal' [-q] [-nq] [-keepfile]'
        say  '   Optional switches: '
        say  '     -q : if included, you will verify deletion of each file'
        say  '     -nq : if included, do NOT query  '
        say  '     -keepfile : delete the sub-directories, but 'bold'not the files'normal 
        say ' '
        call charout, '(hit any key to continue) '||'0d'x
       ians=c2d(sysgetkey('noecho'))
        
        say  reverse||'Notes:'||normal'                        '
        say  '  * readonly (and system & hidden) files 'bold'WILL'normal' be erased.'
        say  '  * if a directory name includes spaces, just enter the name without quotes'
        say  '  * to erase the contents of current directory tree (the current directory,'
        say  '    and all of its subdirectories), use a period (as in: 'bold'DELDIR .'normal')'
        say  '  * "file_pattern" 'bold'must'normal' be enclosed in " characters'
        say  '  * "file_pattern" may contain * wildcard characters, but not ? characters'
        say  '  * "file_pattern" 'bold'may'normal' contain \ and : characters'
        say  '  * -keepfile causes the top directory to be retained (with its files intact)'

        say '             '
             EXIT 3
	END

/***********************************************************************/
/* Load the OS/2 2.0 RexxUtil DLL and make some functions available    */
/***********************************************************************/

CALL RxFuncAdd 'SysFileTree', 'RexxUtil', 'SysFileTree'
CALL RxFuncAdd 'SysFileDelete', 'RexxUtil', 'SysFileDelete'
CALL RxFuncAdd 'SysRmDir', 'RexxUtil', 'SysRmDir'
CALL RxFuncAdd 'SysGetkey', 'RexxUtil', 'SysGetKey'


/***********************************************************************/
/* Load text strings for SysFileDel and SysRmDir return codes.         */
/***********************************************************************/

CALL LoadDELRCText   /* provides text strings for SysFileDel return codes */
CALL LoadRDRCText    /* provides text strings for SysRmDir return codes   */

queryflag='' 
filepattern=''
keepfiles=0
queryflags=''

/* parse out dirname, filepattern, and flags */

if pos('"',user_dir)>0 then do  /* " only used to identify file pattern */
   parse var user_dir user_dir '"' filepattern '"' '-' queryflags 
   if queryflags<>'' then queryflags=' -'||queryflags
end 
else do         /* no quotes, but maybe -flags */
   if words(user_dir)>0 then do
      if pos('-',user_dir)>0 then do
        parse var user_dir user_dir '-' queryflags 
        if queryflags<>'' then queryflags=' -'||queryflags
      end
   end
end
if user_dir='' then do
   say "You must specify a directory (or use . for current directory) "
   exit
end 

do until queryflags=''
     parse upper var queryflags . '-' aflag queryflags
     aflag=strip(aflag)
     if wordpos(aflag,'NQ Q')=1 then queryflag=aflag
     if abbrev(aflag,'KEEPF') then keepfiles=1
end



/**************************************************************************/
/*Check to make sure the directory exists - if it does prompt the user to */
/*make sure they really want to do this.   Otherwise issue a message and  */
/*exit                							  */
/**************************************************************************/

iscurrent=0
if strip(user_dir)="." | strip(user_dir)='*' then do
   delme=directory()
   iscurrent=1
end 
else do
  rc=SysFileTree(user_dir,dir_list, 'D')
  IF dir_list.0 = 0  THEN
        DO
             SAY user_dir 'not found, try again.'
             EXIT 1
        END

  delme=word(dir_list.1,words(dir_list.1))
  DROP dir_list.
end

/***********************************************************/
/* Make sure the user really wants to do this              */
/***********************************************************/
if iscurrent=0 then do
   if filepattern='' then do
       say " deleting ... "||bold||delme||normal
   end
   else do
       say " deleting files matching: "||bold||filepattern||normal
       say "              in & under: "||bold||delme||normal
   end
end
else do
   if filepattern='' then do
       say " deleting current directory: "bold||delme||normal
   end
   else do
       say " deleting files matching: "bold||filepattern||normal
       say " in & under the current directory: "bold||delme||normal
   end
end
if keepfiles=1  then say '(retaining files in 'delme')'

if queryflag<>'NQ' then do
  answer=yesno('Are you sure (readonly, system, & hidden files WILL also be deleted)?',,'N')
  IF answer=0 then exit 1
end
say 

/***********************************************************/
/* Mark all the read-only files to be non read-only        */
/***********************************************************/

if filepattern='' & keepfiles=0 then do
  user_dir=delme
  uu=strip(user_dir,,'\')||'\*'
  rc=SysFileTree(uu, 'dir_list.', 'BOS', '****','----')
end

DROP dir_list.

/***********************************************************/
/* Go through the list of files and delete each one        */
/***********************************************************/

doall=1
ndel=0
matches=0
noquery=1
filesonly=0

if queryflag='Q' then doall=0

filepattern_dir=pos('\',filepattern)+pos(':',filepattern)
rc=SysFileTree(strip(delme,,'\') || '\*.*', 'dir_list.', 'FSO')
tuser_dir=strip(strip(translate(user_dir),'t','\'))||'\'

dadrive=translate(filespec('D',dir_list.1))
if pos(':',tuser_dir)=0 then tuser_dir=dadrive||tuser_dir

DO x = 1 TO dir_list.0
  if filepattern<>'' then do  
     if filepattern_dir=0 then
         chkfile=filespec('n',dir_list.x)
      else
         chkfile=dir_list.x
      foo=wild_match(chkfile,filepattern)
      if foo=0 then iterate
  end
  if  doall=0 then do
    shw=dir_list.x
    aa=yesno(normal||shw' ?','No Yes All Quit','N')
    if aa=3 then exit
    if aa=0 then iterate
    if aa=2 then do 
          say ' '
          doall=1                /* don't ask any more */
    end 
  end
  matches=matches+1

  if keepfiles=1 then do
    gg=strip(translate(dadrive||filespec('p',dir_list.x)),,'\')||'\'
    if gg=tuser_dir then do
        tt= ' ........retaining '||'0d'x
        tt2=dir_list.x||tt
        if length(tt2)>79  then do
            tt2='...'right(dir_list.x,76-length(tt))||tt
       end
       call charout,right(tt2,79,' ') 
       iterate
    end
  end

  ndel=ndel+stream(dir_list.x,'c','query size')

  if filepattern<>'' | keepfiles=1 then do   /* otherwise, mass -rash was done above */
     rc=SysFileTree(dir_list.x,'goo.', 'BOS', '****','----')
  end
  rc = SysFileDelete(dir_list.x)

  if doall<>0 then do
    tt= ' ........'||DELRCText.RC||'0d'x
    tt2=dir_list.x||tt
    if length(tt2)>79  then do
       tt2='...'right(dir_list.x,76-length(tt))||tt
    end
    call charout,right(tt2,79,' ') 
  end


END

totfiles=dir_list.0
DROP dir_list.

/*************************************************************/
/* Go through all the subdirectories and remove them.        */
/* We go backwards through the list in order to delete the   */
/* lowest level sudirectories first and work our way back up */
/* the tree.                                                 */
/*************************************************************/

say 


/* but exit if a filepattern was mentioned (that is, retain directories */
doexit=0
if filepattern<>'' then do 
  if filepattern_dir=0 then doexit=1
  aa=max(lastpos('\',filepattern),lastpos(':',filepattern))
  aa2=strip(substr(filepattern,aa+1))
  if aa2<>'*' then doexit=1        /* else, also remove these dirs */
end 
if doexit=1 then do
     say bold"Of "totfiles" files:"normal ,
        matches "("||addcomma(ndel)|| " bytes) were deleted."
  exit
end

deldirs=0
rc=SysFileTree(user_dir || '\*.*', dir_list, 'DSO')
DO x = dir_list.0 TO 1 BY -1
   if filepattern_dir>0 then do         /* check this dir for removal */
      foo=wild_match(strip(dir_list.x,,'\')||'\',filepattern)
      if foo=0 then iterate     
/* do not delete if dir is not empty */
      agoo=sysfiletree(strip(dir_list.x,,'\')||'\*.*','goo')
      if goo.0>0 then iterate    /* can't delete */
   end 
   rc=SysRmDir(dir_list.x)
   tt= '..........'||rdrcText.RC||'0d'x
   deldirs=deldirs+1
   tt=left(dir_list.x,min(length(dir_list.x),79-length(Tt)))||tt
   call charout,right(tt,79,' ') 
END
totdirs=dir_list.0
DROP dir_list.

/**************************************************************/
/* Delete the directory the user passed  		      */
/**************************************************************/
say
say
if user_dir='.' then do
   say
   say "Current directory will not be deleted. "
end
else do
   ok=1
   if filepattern_dir>0 then do         /* check this dir for removal */
      foo=wild_match(strip(user_dir,,'\')||'\',filepattern)
      if foo=0 then ok=0
   end
   if ok=1 & filesonly=0 then do
      rc=SysRmDir(user_dir)
      deldirs=deldirs+1
   end
   say
   SAY user_dir '...........' RDRCText.RC
end
totdirs=totdirs+1
say bold||deldirs||normal||' directories removed.'
say bold"Of "totfiles" files in "totdirs" directories:"normal,
      matches "("||addcomma(ndel)|| " bytes) were deleted."

EXIT 0


/**************************************/
/* Local subroutines		      */
/**************************************/

LoadDELRCText:
	/* provides text strings for SysFileDel return codes */
	/* The return codes and strings are in the online Rexx manual */

	DELRCText.0 = 'File deleted successfully. '
	DELRCText.2 = 'Error.  File not found. '
	DELRCText.3 = 'Error.  Path not found. '
	DELRCText.5 = 'Error.  Access denied. '
	DELRCText.26 = 'Error.  Not DOS disk. '
	DELRCText.32 = 'Error.  Sharing violation. '
	DELRCText.36 = 'Error.  Sharing buffer exceeded. '
	DELRCText.87 = 'Error.  Invalid parameter. '
	DELRCText.206 = 'Error.  Filename exceeds range error. '
RETURN

LoadRDRCText:
	/* provides text strings for SysRmDir return codes */
	/* The return codes and strings are in the online Rexx manual */

	RDRCText.0 = 'Directory removal was successful. '
	RDRCText.2 = 'Error.  File not found. '
	RDRCText.3 = 'Error.  Path not found. '
	RDRCText.5 = 'Error.  Access denied. '
	RDRCText.16 = 'Error.  Current Directory. '
	RDRCText.26 = 'Error.  Not DOS disk. '
	RDRCText.87 = 'Error.  Invalid parameter. '
	RDRCText.108 = 'Error.  Drive locked. '
	RDRCText.206 = 'Error.  Filename exceeds range error. '
RETURN
 

/************************/
/* Basically, -1 means "exact match", 0 means "no match" or "not better match"
(if oldresu not specified, 0 always means "no match"), and everything else
means "wild card match".
*/

wild_match:procedure
parse upper arg needle, haystack,oldresu,suppress_noslash


 aresu=awild_match(needle,haystack)
 if aresu=0 then return aresu     /* no match */
 if aresu=-1 | oldresu=' ' then return aresu  /* exact match, or first wildcard match */

/* Is this a better WILDCARD MATCH */
   wrdsnew=words(ARESU);wrdsold=words(oldRESU)
   useold=1
   do Nmm=1 to max(wrdsold,wrdsnew)
       if Nmm>wrdsnew then leave
       if Nmm>wrdsold then do
             useold=0; leave
       end  
       a1=strip(word(oldresu,Nmm))
       a2=strip(word(aresu,Nmm))
       if a1=a2  then iterate
       if a2>a1 then leave  /* new matching element > old matching element, thus new is worse match */
       useold=0           /* found a matching element in new < then corresponding element in old*/
       leave            /* thus, new is better match */
    end

    IF USEold=0 THEN return aresu
     return 0           /* non superior match (might be same, in which case old is used*/




awild_match:procedure expose suppress_noslash
parse upper arg needle, haystack ; haystack=strip(haystack)
needle=strip(needle)

noslash=0               /* | at end of haystack means "no / or \ in last wildcarded portion of needle */
if right(haystack,1)='|' & suppress_noslash<>1 then do
   noslash=1
   haystack=left(haystack,length(haystack)-1)
end

hayendast=0
if right(haystack,1)='*' then hayendast=1


if needle=haystack then return -1        /* -1 signals exact match */
ast1=pos('*',haystack)
if ast1=0 then return 0                 /* 0 means no match */
if haystack='*' then  do                /* global is sort of stupid -- choose "shortest" string */
   if noslash=1 then do                 /* check for noslash condition */
     noo=translate(needle,'/','\')
     if pos('/',noo)>0 then return 0
   end
   if length(needle)=0 then 
       return 100000
    else 
        return length(needle)
end
ff=haystack
ii=0
do until ff=""
  ii=ii+1
  parse var ff hw.ii '*'  ff
  hw.ii=strip(hw.ii)
end
if hw.ii='' then ii=ii-1
hw.0=ii


/* check each component of haystackw against needle -- all components
must be there */

resu=' '
istart=1 ; ido=2
if ast1>1 then do       /* first check abbrev */
  if abbrev(needle,hw.1)=0 then return 0   /* first portion of haystack also first portion of needle */
  aresu=length(hw.1)
  if hw.0=1 then do
     if noslash=1 then do                 /* check for noslash condition */
        noo=translate(substr(needle,aresu+1),'/','\')
        if pos('/',noo)>0 then return 0      /* slash in wildcard means "no match" */
     end
     do nm=1 to aresu
        resu=resu||' '||nm
     end /* do */
     return resu         /* if haystacy of form abc*, we have a match */
  end
  ido=2 ; istart=aresu+1
  do mm=1 to aresu
        resu=resu||' '||mm
  end /* do */
end
/* if here, then first part (a non wildcard) of haystack matches first
part of needle
Now check sequentially that each remaining part also exists
*/
do mm=ido to hw.0
  igoo=pos(hw.mm,needle,istart)
  if igoo=0 then return 0
  if noslash=1 & mm=hw.0 & hayendast=0 then do     /* this is a non *'ed haystack end */
     noo=translate(substr(needle,istart,igoo-istart),'/','\')
     if pos('/',noo)>0 then return 0      /* slash in wildcard means "no match" */
  end
  tres=length(hw.mm)
  istart=igoo+tres
  do nn=igoo to (istart-1)
     nn0=nn
     resu=resu||' '||nn       /* resu indices characters that really match */
  end /* do */
end

if noslash=1 & hayendast=1 then do
   noo=translate(substr(needle,nn0+1),'/','\')
   if pos('/',noo)>0 then return 0      /* slash in wildcard means "no match" */
end
   
if (istart >= length(needle)) | (hayendast=1) then  return resu

return 0
 

/* -------------------- */
/* choose between 3 alternatives (by default,a yes or no ),
return 1 if yes (or 0,1,2 for chosen altenative ) */

yesno:procedure
parse arg amessage , altans,def,arrowok
ahdr=''
if pos('|',amessage)>0 then parse var amessage ahdr '|' amessage
aesc='1B'x
cy_ye=aesc||'[37;46;m'
cyanon=cy_ye
normal=aesc||'[0;m'
bold=aesc||'[1;m'
re_wh=aesc||'[31;47;m'
reverse=aesc||'[7;m'

aynn=' '
if def='' then
 defans=''
else
 defans=translate(left(strip(def),1))
if altans='' then altans='No Yes'

w.0=words(altans)
do iw0=1 to w.0
     w.iw0=strip(word(altans,iw0))
     a.iw0=translate(left(w.iw0,1))
     aa.iw0=substr(w.iw0,2)
     aynn=aynn||bold
     if  a.iw0=defans then aynn=aynn||cy_ye
     aynn=aynn||a.iw0||normal||aa.iw0
     if iw0<w.0 then aynn=aynn'|'
end
if arrowok=1 then aynn=aynn||' [UP]'
do forever
 foo1=normal||ahdr||reverse||amessage||normal||aynn||' 'normal
 if length(amessage)+length(altans)<79 then
    foo1=normal||ahdr||reverse||amessage||normal||aynn||' 'normal
 else
    foo1=normal||ahdr||reverse||amessage||normal||'0d0a'x||'    '||aynn||' 'normal
 call charout, foo1
 anans=translate(sysgetkey('echo'))
 ianans=c2d(anans)
 if ianans=27 then return defans
 if anans='' | ianans=13 | ianans=10 then  anans=defans

 if arrowok=1 & ianans=0 then do
     ians=c2d(sysgetkey('noecho'))
     if ians=72 then  do
           say ;say
           return -1  /* -1 : up key */
     end
 end /* do */

 do ijj=1 to w.0
    if abbrev(anans,a.ijj)=1 then do
        say
        return Ijj-1
    end
 end /* do */
 call charout,'0d'x
end


/************/
/* ADD COMMAS TO A NUMBER */
addcomma:procedure
parse arg aval,ndec
parse var aval p1 '.' p2

if ndec='' then do
   p2=''
end
else do
   p2='.'||left(p2,ndec,'0')
end /* do */

plen=length(p1)
p1new=''
do i=1 to 10000 while plen>3
   p1new=','right(p1,3)||p1new
   p1=delstr(p1,plen-2)
   plen=plen-3
end /* do */

return p1||p1new||p2