*
* $Id$
*
* $Log$
* Revision 1.1  1996/02/28 16:24:43  mclareni
* Initial revision
*
*
#include "hepdb/pilot.h"
      SUBROUTINE CDLDIR(PATH,LWRITE,NLEVEL,CHOPT,IRC)
*
************************************************************************
*
*        To traverse the HEPDB directory tree starting from
*        the specified pathname.
*        Modified from the RZ routine RZSTAT / RZSCAN
*
* Input:
*   CHPATH  The pathname of the starting directory
*   LWRITE  The logical unit on which the information is written
*   NLEVEL  Number of levels  below CHPATH to descend
*
* Output:
*           IQUEST(11) = number of directories found
*           IQUEST(12) = number of directories that match
*
* Called by CDLDC
*           <user>
*
*
************************************************************************
#include "zebra/rzcl.inc"
#include "zebra/rzdir.inc"
#include "zebra/rzch.inc"
#include "zebra/rzk.inc"
      CHARACTER*(*) PATH
      CHARACTER*255 CHPATH
      CHARACTER*255 OLDDIR
      CHARACTER*132 CHLINE
      PARAMETER     (MAXLEV=20)
      CHARACTER*16  DIRNAM(MAXLEV),CHDIR
      DIMENSION     ISD(MAXLEV),NSD(MAXLEV),IHDIR(4)
      DIMENSION     IHTAG(2)
      CHARACTER*8   CHTAG(KNMAX)
#include "hepdb/slate.inc"
#include "hepdb/cdunit.inc"
#include "hepdb/cdrnge.inc"
#include "hepdb/hdbopts.inc"
*
*-----------------------------------------------------------------------
*
*
      IRC=0
      IQUEST(1)  = 0
      IQUEST(11) = 0
      IWIDTH     = 0
      JWIDTH     = 78
      IF(IOPTV.NE.0) JWIDTH = 132
      CALL CDLDDI (PATH, CHPATH, LPATH)
      LPATHI     = LPATH
*
*     Split input path name into its component pieces
*     (this is the opposite of RZPAFF which glues them together)
*
      CALL CDPAFF(CHPATH(1:LPATH),DIRNAM,MAXLEV,IRET)
*
*     Find first wild card in generic name
*
      IF(LLOGCD.GE.3)
     +WRITE(LPRTCD,*) 'CDLDIR. enter for PATH = ',CHPATH(1:LPATH),
     +        ' nlevel = ',NLEVEL,' chopt = ',CHOPT
      IWILD  = ICFMUL('*%(<>[]',CHPATH,1,LPATH)
      IF(IWILD.LE.LPATH) THEN
         LPATH = INDEXB(CHPATH(1:IWILD),'/') - 1
      ENDIF
*
      ITIME=0
      NLEV=NLEVEL
      IF(NLEV.LE.0)NLEV=99
      NFOUND = 0
      NMATCH = 0
      ITEMP  = 0
      CALL RZCDIR(CHWOLD,'R')
      OLDDIR = ' '
      LOLD   = 1
*
*     Set CWD to the current level
*
   10 CONTINUE
      IF(ITIME.NE.0)THEN
         CALL RZPAFF(CHPAT,NLPAT,CHL)
         CALL RZCDIR(CHL,' ')
      ELSE
         CALL RZCDIR(CHPATH(1:LPATH),' ')
         IF(IQUEST(1).NE.0)GO TO 80
         IF(IQ(KQSP+LCDIR+KNSD).GT.0) WRITE(LWRITE,*)
     +      'List of subdirectories...'
         NLPAT0=NLPAT
         CHL = CHPATH(1:LPATH)
      ENDIF
      IF(IQUEST(1).NE.0)GO TO 70
*
*     Set IQUEST
*
      IQUEST(12) = IQ(KQSP+LCDIR+KNSD)
      IQUEST(13) = NLPAT
      IQUEST(14) = IQ(KQSP+LCDIR+KNKEYS)
      IQUEST(15) = IQ(KQSP+LCDIR+KNWKEY)
*
*     Ensure that entire path name matches before printing
*
      NFOUND = NFOUND + 1
      CALL CDMTCH(CHL,CHPATH(1:LPATHI),IRC)
      IF(IRC.EQ.0) THEN
         NMATCH = NMATCH + 1
         LCHL = LENOCC(CHL)
         ISLASH = INDEXB(CHL(1:LCHL),'/')
 
         IF(IOPTV+IOPTW.EQ.0) THEN
*
*     Dates and times
*
            WRITE(LWRITE,*) CHL(1:LCHL)
 
            IF(IOPTC.NE.0) THEN
               CALL RZDATE(IQ(KQSP+LCDIR+KDATEC),IDC,ITC,1)
               WRITE(LWRITE,*) ' Created        :',IDC,ITC
            ENDIF
            IF(IOPTM.NE.0) THEN
               CALL RZDATE(IQ(KQSP+LCDIR+KDATEM),IDM,ITM,1)
               WRITE(LWRITE,*) ' Modified       :',IDM,ITM
            ENDIF
 
            IF(IOPTO.NE.0) THEN
               WRITE(LWRITE,*) ' Objects        :',IQ(KQSP+LCDIR+KNKEYS)
            ENDIF
 
            IF(IOPTS.NE.0) THEN
               WRITE(LWRITE,*) ' Subdirectories :',IQ(KQSP+LCDIR+KNSD)
            ENDIF
 
            IF(IOPTT.NE.0) THEN
               NWKEY=IQ(KQSP+LCDIR+KNWKEY)
               KTAGS=KKDES+(NWKEY-1)/10+1
               DO 20 J=1,NWKEY
                  CALL ZITOH(IQ(KQSP+LCDIR+KTAGS+2*J-2),IHTAG,2)
                  CALL UHTOC(IHTAG,4,CHTAG(J),8)
   20          CONTINUE
               WRITE(LWRITE,*) ' Tags           :'
               WRITE(LWRITE,9001) (CHTAG(J),J=1,NWKEY)
 9001          FORMAT(8(2X,A8))
            ENDIF
 
            IF(IOPTC+IOPTM+IOPTS+IOPTO+IOPTT.NE.0) WRITE(LWRITE,*)
 
         ELSE
            IF(CHL(1:ISLASH-1).NE.OLDDIR(1:LOLD)) THEN
*     flush current buffer
               IF(IWIDTH.NE.0) THEN
                  WRITE(LWRITE,'(1X,A)') CHLINE(1:IWIDTH)
                  IWIDTH = 0
               ENDIF
 
               WRITE(LWRITE,*)
               WRITE(LWRITE,'(1X,A,A)') 'Directory: ',CHL(1:ISLASH-1)
               WRITE(LWRITE,*)
               LOLD = ISLASH - 1
               OLDDIR = CHL(1:LOLD)
 
            ENDIF
 
            LF     = LCHL - ISLASH
            IF(IWIDTH+LF.GE.JWIDTH) THEN
*     flush current buffer
               WRITE(LWRITE,'(1X,A)') CHLINE(1:IWIDTH)
               IWIDTH = 0
            ENDIF
            IF(IWIDTH.EQ.0) THEN
               CHLINE = CHL(ISLASH+1:LCHL) // ' '
            ELSE
               CHLINE = CHLINE(1:IWIDTH) // CHL(ISLASH+1:LCHL) // ' '
            ENDIF
            IWIDTH = IWIDTH + LF + 1
         ENDIF
      ENDIF
 
      ISD(NLPAT)=0
      NSD(NLPAT)=IQ(KQSP+LCDIR+KNSD)
*
*     If there is a <> at this level, perform matching
*     and follow only that path
*
      ILT = INDEX(DIRNAM(NLPAT+1),'<')
      IGT = INDEX(DIRNAM(NLPAT+1),'>')
      NCRNGE(NLPAT+1) = 0
 
      IF((ILT.NE.0).AND.(IGT.NE.0)) THEN
         IF(LLOGCD.GE.-3) WRITE(LWRITE,9002) NLPAT,DIRNAM(NLPAT+1)
 9002 FORMAT(' CDLDIR. invalid wild-carding at level ',I6,
     +       ' in pathname - ',A)
         IF(LLOGCD.GE.-3) WRITE(LWRITE,9003)
 9003 FORMAT(' CDLDIR. only one of < or > may be specified')
         IQUEST(1) = -1
         GOTO 70
      ENDIF
 
      IF(ILT+IGT.NE.0) THEN
*
*     Is there a [mm:nn] syle range?
*
         JR  = LENOCC(DIRNAM(NLPAT+1))
         ISQ = INDEX(DIRNAM(NLPAT+1)(1:JR),'[')
         IF(ISQ.NE.0) THEN
            ILOW   = ICDECI(DIRNAM(NLPAT+1),ISQ+1,JR)
            IF(IS(1).EQ.0) THEN
               IRC = -1
               IF(LLOGCD.GE.-3) WRITE(LWRITE,9004)
     +            DIRNAM(NLPAT+1)(ISQ:JR)
 9004 FORMAT(' CDLDIR. error reading decimal value from ',A/
     +       '         Only integer ranges are supported',
     +       ' between [] characters, e.g. [10:20]')
               GOTO 80
            ENDIF
            IHIGH  = ICDECI(DIRNAM(NLPAT+1),
     +               INDEX(DIRNAM(NLPAT+1),':') + 1,JR)
            IF(IS(1).EQ.0) THEN
               IRC = -1
               IF(LLOGCD.GE.-3) WRITE(LWRITE,9004)
     +            DIRNAM(NLPAT+1)(ISQ:JR)
               GOTO 80
            ENDIF
            IF(LLOGCD.GE.3) WRITE(LWRITE,9005) ILOW,IHIGH
 9005 FORMAT(' CDLDIR. ilow/ihigh = ',I6,'/',I6)
            NCRNGE(NLPAT+1) = 0
            IF(IHIGH-ILOW+1.GT.100) THEN
               IF(LLOGCD.GE.-3) WRITE(LWRITE,9006)
 9006 FORMAT(' CDLDIR. maximum range is 100',
     +            ' - excess elements will be ignored')
               IHIGH = ILOW + 99
            ENDIF
            DO 30 JJ=ILOW,IHIGH
               NCRNGE(NLPAT+1) = NCRNGE(NLPAT+1) + 1
               ICRNGE(NCRNGE(NLPAT+1),NLPAT+1) = JJ
               ICELEM(NCRNGE(NLPAT+1),NLPAT+1) = -1
               IF(ILT.NE.0) THEN
                  ICVAL(NCRNGE(NLPAT+1),NLPAT+1) = 999999
               ELSE
                  ICVAL(NCRNGE(NLPAT+1),NLPAT+1) = -1
               ENDIF
   30       CONTINUE
         ENDIF
*
*     Loop over all subdirectories at this level
*
         DO 40 JJ=1,NSD(NLPAT)
            LS=IQ(KQSP+LCDIR+KLS)
            IH=LS+7*(JJ-1)
            CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
            CALL UHTOC(IHDIR,4,CHDIR,16)
            CALL CDSELP(CHDIR,DIRNAM(NLPAT+1),JJ,NSD(NLPAT),JINDEX,IRC)
   40    CONTINUE
         IF(JINDEX.GT.0) THEN
            IF(NCRNGE(NLPAT+1).EQ.0) THEN
               IF(LLOGCD.GE.3) THEN
                  LS=IQ(KQSP+LCDIR+KLS)
                  IH=LS+7*(JINDEX-1)
                  CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
                  CALL UHTOC(IHDIR,4,CHDIR,16)
                  WRITE(LWRITE,9007) CHDIR
 9007 FORMAT(' CDLDIR. selected subdirectory ',A)
               ENDIF
               NSD(NLPAT) = JINDEX
               ISD(NLPAT) = JINDEX - 1
            ELSE
               LS=IQ(KQSP+LCDIR+KLS)
               IF(LLOGCD.GE.3) WRITE(LWRITE,9008)
 9008 FORMAT(' CDLDIR. selected following subdirectories...')
               JMIN = 999999
               JMAX = 0
               DO 50 II=1,NCRNGE(NLPAT+1)
                  JJ=ICELEM(II,NLPAT+1)
                  IF(JJ.LE.0) GOTO 50
                  IF(JJ.LT.JMIN) JMIN = JJ
                  IF(JJ.GT.JMAX) JMAX = JJ
                  IF(LLOGCD.GE.3) THEN
                     IH=LS+7*(JJ-1)
                     CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
                     CALL UHTOC(IHDIR,4,CHDIR,16)
                     WRITE(LWRITE,9009) CHDIR
 9009 FORMAT(1X,A)
                  ENDIF
   50          CONTINUE
               NSD(NLPAT) = JMAX
               ISD(NLPAT) = JMIN - 1
            ENDIF
         ELSE
            IF(LLOGCD.GE.2) WRITE(LWRITE,9010)
 9010 FORMAT(' CDLDIR. no subdirectory matches')
            NSD(NLPAT) = 0
         ENDIF
      ELSE
         JINDEX = -1
      ENDIF
*
*            Process possible down directories
*
   60 ISD(NLPAT)=ISD(NLPAT)+1
 
      IF((ISD(NLPAT).LE.NSD(NLPAT)).AND.
     +   (NLPAT.LT.(NLPAT0+NLEV))) THEN
         IF(NCRNGE(NLPAT+1).NE.0
     +      .AND.IUFIND(ISD(NLPAT),
     +         ICELEM(1,NLPAT+1),1,NCRNGE(NLPAT+1)).GT.
     +         NCRNGE(NLPAT+1)) GOTO 60
         NLPAT=NLPAT+1
         LS=IQ(KQSP+LCDIR+KLS)
         IH=LS+7*(ISD(NLPAT-1)-1)
         CALL ZITOH(IQ(KQSP+LCDIR+IH),IHDIR,4)
         CALL UHTOC(IHDIR,4,CHPAT(NLPAT),16)
         ITIME=ITIME+1
         GO TO 10
      ELSE
*
*            Write information on current directory
*
         CALL RZPAFF(CHPAT,NLPAT,CHL)
*        IF(NLPAT.LE.(NLPAT0+NLEV))THEN
*        ENDIF
         NLPAT=NLPAT-1
         IF(NLPAT.GE.NLPAT0)THEN
            LUP=LQ(KQSP+LCDIR+1)
            CALL MZDROP(JQPDVS,LCDIR,' ')
            LCDIR=LUP
            GO TO 60
         ENDIF
      ENDIF
*
*            Reset CWD
*
   70 CALL RZCDIR(CHWOLD,' ')
 
      IF((IWIDTH.NE.0).AND.(IOPTV+IOPTW.NE.0)) THEN
         WRITE(LWRITE,'(1X,A)') CHLINE(1:IWIDTH)
      ENDIF
*
   80 CONTINUE
      IRC = IQUEST(1)
      IQUEST(11) = MAX(NFOUND -1,0)
      IQUEST(12) = NMATCH
      END
 
