OS/2 Shareware BBS: 18 REXX/18-REXX.zip/dirtools.zip/DIRTREE.CMD

OS/2 REXX Batch file | 2000-08-23 | 15KB | 521 lines

/* 05 Mar 1999. Daniel Hellerstein ([e-mail])
                 DirTree ver 1.02
  Sort (and display) all files in a directory tree by filename

   You may freely use this utility,
   You may also find the 3 procedures used here to be useful.
   These are:
        resolve_filename: return a fully qualified filename, given
                          a relative filename and directory information
        StemSort: sort a stem variable (using a bubble sort)
        dir_exists: detects whether a directory exists

Standard disclaimer:
  This program, and it's included procedures, may be
  freely used, but you use them at your own risk.

*/

parse arg dirfile astuff

if dirfile='?' then do
say 'DirTree: A utility to list all files in a directory tree, sorted by '
say '         name, size, and/or date. '
say
say "Usage: x:>DIRTREE directory\file_pattern [-options]  "
say
say " Where: directory = directory tree to list (default is current directory) "
say "       file_pattern = a file pattern (* is the default)"
say " Options include:"
say "      -Onds = Sort by n(ame), d(ate), and/or s(ize) "
say "              The  default is to sort by name only"
say "      -D =    Decending sort (default is ascending) "
say '      -CT =   Count of files with this "filename"'
say '              List first (as determined by sort position) such file'
say '  -SHORT,-LONG,-VERYLONG = Style of display '
say '  -SUMMARY = Display  summary (#files/#bytes); do NOT display matching files '

say
say "Examples: x:>dirtree \archive1\*.zip -Ond -D "
say "          x:>dirtree * -summary "

say
say "Or, enter DIRTREE at a command prompt (with no arguments) to be prompted. "
exit
end

/*---   Load REXX libraries ----- */
/* Load up advanced REXX functions */
foo=rxfuncquery('sysloadfuncs')
if foo=1 then do
  call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  call SysLoadFuncs
end

foo=rxfuncquery('rexxlibregister')
if foo=1 then do
 call rxfuncadd 'rexxlibregister','rexxlib', 'rexxlibregister'
 call rexxlibregister
end
gotrexxlib=rxfuncquery('rexxlibregister')

sortorder=''
isdescend=0
docount=0
dolong=0
filler=' "" '
lmxdate=14
dosummary=0

if dirfile<>'' then do
  if dirfile='*' then dirfile='*.*'

  if pos('.',dirfile)>0 then do  /* a filename also specified ? */
     ii=max(lastpos('\',dirfile),lastpos(':',dirfile))
     if ii=0 then do                   /* no path info */
         adir=''
         filename=dirfile
     end /* do */
     else do
         adir=left(dirfile,ii-1)
         filename=substr(dirfile,ii+1)
     end /* do */
  end /* do */
  else do                      /* no filename specified */
     filename='*.*'
     adir=dirfile
  end
  astuff=translate(astuff)
  if pos('-D',astuff)>0 then isdescend=1
  if pos('-CT',astuff)>0 then docount=1
  if pos('-LONG',astuff)>0 then dolong=1
  if pos('-VERYLONG',astuff)>0 then dolong=2
  if pos('SHORT',astuff)>0  then dolong=-1
  if pos('SUM',astuff)>0 then dosummary=1

  if dolong=-1  then do
    filler='    '
    lmxdate=8
  end
  parse var astuff . '-O' sortorder .

  adir=resolve_filename('',adir,,1)
  if adir='' then do
     say "No such directory: "adir
     exit
  end
  say "Searching in: "adir
  say "         for: "filename
end /* do */
else do                        /* from keyboard */
  say "DirTree: sort files by names across a directory tree."
  call charout," Starting directory: "
  parse pull adir
  adir=resolve_filename('',adir,,1)
  if adir='' then do
     say "No such directory: "adir
     exit
  end
  call charout, " Files to find (default=*): "
  parse pull filename
  if filename='' then filename='*'

  call charout,' Summary stats only (Y=yes)?'
  pull dosummary
  if dosummary<>'Y' then do
     call charout,' Sort order string; d=date, s=size,n=name (i.e.; nd or ds):'
     pull sortorder
     call charout,' Descending order (1), or Ascending (ENTER) :'
     pull isdescend
  end
  else do
       dosummary=1
  end
end

/* ready to rumble */
if dir_exists(adir)=0 then do
      say "No such directory: "adir
      exit
end /* do */

if dosummary=1  then do               /* just # files, # bytes, and # dirs? */
   foo=dir_summary(adir||filename)
   exit
end


if sortorder='' then sortorder='N'
oo=sysfiletree(adir||filename,'fils','FTS')

/* grab the files */
lmxname=0; lmxsize=0
do mm=1 to fils.0
   parse var fils.mm  date.mm size.mm . aa
   nam.mm=translate(filespec("n",aa)); path.mm=filespec('p',aa)
   lmxsize=max(length(size.mm),lmxsize)
   lmxname=max(length(nam.mm),lmxname)
   if left(date.mm,2)<80 then
      date.mm='20'||date.mm
   else
     date.mm='19'||date.mm
end /* do */
say "# of matching files= " fils.0

srtx.=''
do ll2=1 to fils.0
  do ll=1 to length(sortorder)
     atype=substr(sortorder,ll,1)
     select
        when atype='N' then
            srtx.ll2=srtx.ll2||left(nam.ll2,lmxname+1,' ')
        when atype='S' then
            srtx.ll2=srtx.ll2||right(size.ll2,lmxsize+1,'0')
        when atype='D' then
            srtx.ll2=srtx.ll2||left(date.ll2,15,' ')
        otherwise
            nop
     end  /* select */
  end /* do */
  srtx.ll2=srtx.ll2||right(ll2,7,' ')

end /* do */
srtx.0=fils.0
say "Sorting by " sortorder " ... "


/* use rexxlib sort, if available */
if gotrexxlib=0 then do
   foo=arraysort('srtx',,,,,,'I')
end
else do
  call stemsort 'srtx.',1
end


kk=words(srtx.1)

oldname='..'
oldsize='..'
olddate='..'
oldpath='..'

j1=1 ; j2=srtx.0 ; j3=1
if isdescend=1  then do
   j1=srtx.0; j2=1; j3=-1
end /* do */


/* Now write the output, using filename, date or time (optional), and path */
ict=0
do mm=j1 to j2 by j3
   ith=strip(word(srtx.mm,kk))
   a2=left(nam.ith,lmxname)
   if a2=oldname then do                        /*always list filename */
       a2=left(filler,lmxname,' ')
       ict=ict+1
   end
   else do                      /* new name */
       oldname=a2
       if docount=1 then say '('ict') 'tmpline
      ict=1
    end
   if pos('S',sortorder)>0 then do                      /* size is optional */
      if oldsize<>size.ith then do
        a3=right(strip(size.ith,'l','0'),lmxsize)
        oldsize=size.ith
      end
      else do
        a3=right(filler,lmxsize)
      end
      a2=a2||' '||a3
   end
   if pos('D',sortorder)>0 then do                      /*date is optional */
      if olddate<>date.ith then do
        a3=substr(date.ith,3)
        parse var a3 yr '/' mo '/' day '/' hr '/' min
        a3=yr'-'mo'-'day
        if dolong<>-1 then a3=a3||' 'hr':'min
        olddate=date.ith
      end
      else do
        a3=right(filler,lmxdate)
      end
      a2=a2||' '||a3
   end

   if dolong=-1 & ict>1 & length(path.ith)>length(oldpath) then do         /* shorten path? */
      icc=compare(translate(oldpath),translate(path.ith))
      icc2=lastpos('\',oldpath,icc)
      showpath=copies(' ',icc2-1)||substr(path.ith,icc2)
      oldpath=path.ith
   end
   else do
       oldpath=path.ith
       showpath=path.ith
   end /* do */

   select
     when dolong=2 then  a2=a2||' 'fils.ith
     when dolong=1 then a2=a2||' '||strip(word(fils.ith,4))
     otherwise a2=a2||' 'showpath
   end

/* either write line, or retain (and write with count later) */

   if docount=1 then do
      if ict=1 then tmpline=a2
   end
   else do
      say a2
   end
end /* do */
if docount=1 then say '('ict') 'tmpline

exit


/*     ************************************************               */
/* the following procedures might prove useful in other contexts....  */
/*      *************************************************              */

/* this simple sort procedure is courtesy of Stan Irish, and
was obtained from comp.lang.rexx
Usage:
   call StemSort 'stemname.',column
where
    stemname = The name of a stem variable containing an "array" to
               sort.
                  stemname.0 MUST be set to the number of elements
                  in the array!
    column   = (optional) the column number (the character number of
               values in (stemname.) to sort from.
               If not specified, sort from column 1.

No value is returned, but 'stemname.' is sorted in place.

*/


StemSort:
  !stem = arg(1)
  call StemSortProc !stem,arg(2)
  return 0

StemSortProc:Procedure expose (!stem)
/* returns:  nothing
 Uses:     xxx = value(stemname.i) to get element values
       and  rc  = value(stemname.i,xxx) to set element values
*/

  sortstem = arg(1)
  If datatype(arg(2)) = 'NUM' then SortColumn = arg(2)
  Else SortColumn = 1

  d = value(sortstem||0) % 2              /* d is a distancemeasurement     */
  do while d > 0
    do until finished             /* start of mini-bubblesort loop   */
      finished = 1
      do i=1 to value(sortstem||0)-d
        j = i+d           /* we now compare and swap items i and i+d */
        if substr(value(sortstem||i),SortColumn) >substr(value(sortstem||j),SortColumn) then
          do
            temp = value(sortstem||i)
            rc = value(sortstem||i,value(sortstem||j))
            rc = value(sortstem||j,temp)
            finished = 0
          end
      end
    end                           /* end of mini-bubblesort loop     */
    d = d%2
  end
  RETURN ''


/* --------------------------------------------------------------------*/
/* Resolve a filename into a fully qualified file.
   This will take  a variety of filenames; including such forms as:
   FOO.BAR, E:FOO.BAR,  XYZ\FOO.BAR, and E:ABC\FOO.BAR

   Returns the fully qualified filename; or (if nocheck<>1,
   a '' if this filename does not exist.

Usage:
  filename=resolve_filename(a_filename,a_directory,default_ext,nocheck)
where
  a_filename = a filename  to use
               a_filename can contain "path information". If this
               is relative path information, then the path information
               from a_filename will be appended to the a_directory.
 a_directory = a directory, or a relative directory, to use.
               If a relative directory, a_directory will be converted
               to a fully qualified directory before path information
               from a_filename is appended.
 default_ext = add this extension to a_filename, if a_filename does not
               have a period (a .) in it
    nocheck  = If 1, do NOT verify the existence of this file
and
  filename   = a fully qualified filename, or a '' (signifying "no such
               file)


Hint: if you do not specify a filename, then resolve_filename will
      check for the existence of a directory (rather then an explicit
      file within the directory
*/

resolve_filename:procedure

parse arg afile,adir,defext,nocheck
afile=strip(afile) ; adir=strip(adir)

curdir0=directory()
curdir=curdir0'\'

if adir='' then adir=curdir     /* no adir specified, use current */

if right(adir,1)<>'\' & right(adir,1)<>':' then adir=adir'\'

usedrive=filespec('D',adir)
usedrive0=usedrive

if usedrive='' then usedrive=filespec('D',curdir) /* no drive in adir, use current*/

usepath=filespec('P',adir)
if left(usepath,1)<>'\' then do    /* relative to current usedrive path */
   foo=directory(usedrive)'\'
   foo2=directory(curdir0)
   usepath=filespec('p',foo)||usepath
end /* do */
oldfile=filespec('n',afile)

/* a hack, but what the heck.. */
do forever
  if pos('\\',usepath)=0 then leave
  parse var usepath a1 '\\' a2
  if length(a1)=0 then
     usepath='\'
  else
     usepath=a1'\'
  if a2='' then leave
  usepath=usepath||a2
end
select
  when substr(afile,2,2)=":\" then do /* if 2-3 = :\, then use afile as is */
     usefile=afile
  end /* do */

  when substr(afile,2,1)=':' then do    /* relative file name on drive */

      if usedrive0='' then do            /* perhaps use usepath? */
          usefile=left(afile,2)||usepath||oldfile
      end               /* otherwise, use afile as is */
      else do
         usefile=afile
      end /* do */
  end
  when left(afile,1,1)='\' then do      /* attach adir drive */
      usefile=usedrive||afile
  end
  otherwise do
      usefile=usedrive||usepath||afile
  end
end

if pos('.',afile)=0 & defext<>'' then usefile=usefile||'.'||strip(defext,'l','.')

/* a hack, but what the heck.. */
do forever
  if pos('\\',usefile)=0 then leave
  parse var usefile a1 '\\' a2
  usefile=a1'\'
  if a2='' then leave
  usefile=a1||a2
end

if nocheck=1 then return usefile

if afile='' then do                     /* check for existence of directory*/
   isit=dir_exists(bfile)
   if isit=0 then return ''
   return afile
end

file=stream(usefile,'c','query exists')  /* check for existence of a file */
return bfile


/*************************************************/
/* Check for the existence of a directory. Correctly identifies
   empty directories.
Usage:
   flag=dir_exists(a_directory)
where
   flag=1 if a_directory exists (it might be an empty directory )
   flag=0 if it doesn't exist
*/
dir_exists:procedure
parse arg adir

adir=strip(adir)
adir=strip(adir,'t','\')
nowdir=directory()
nowdrive=filespec('d',nowdir'\')
nowpath=filespec('p',nowdir'\')
adr=filespec('d',adir)
if adr='' then do
   if abbrev(adir,'\')=0 then
       adir=nowdrive||nowpath||adir
   else
       adir=nowdrive||adir
end /* do */

foo=sysfiletree(adir,goo,'D')
if  goo.0>0  then return 1
return 0


/* summary of this directory tree */
dir_summary:procedure
parse arg todo
oo=sysfiletree(todo,'fils','FTS')
CALL CHAROUT,'>> '||translate(todo)
if length(todo)>40 then say ' '
call charout, " : # files=" fils.0
isz=0
do m=1 to fils.0
   isz=isz+word(fils.m,2)
end
call charout," ("||addcomma(isz)||")"

oo=sysfiletree(todo,'fils2','DTS')
call charout,"; # directories= "fils2.0
say
EXIT

/************/
/* 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