[Info-vax] Suggestion: Adding a /SORT option to DIRECTORY and F$SEARCH ?
Phillip Helbig undress to reply
helbig at asclothestro.multivax.de
Mon Jan 31 07:17:30 EST 2022
In article <sspht9$20h$1 at dont-email.me>, Simon Clubley
<clubley at remove_me.eisner.decus.org-Earth.UFP> writes:
> It would be nice to be able to see the output from a DIRECTORY command
> optionally sorted by one of largest size, smallest size, oldest date,
> newest date, etc.
>
> Likewise, it would be nice to be able to optionally specify the sort
> order in which filenames are returned by f$search().
>
> Does anyone agree ?
Yes, would be nice.
----------8<--------------------------------------------------------------------
1 SDIR
The Sorted DIRectory command produces a directory listing sorted by either
creation date or size. The default is date. If no filespec is specified,
the current directory is listed.
Note that none of the system DIRECTORY command qualifiers work.
SDIR [qualifiers] [filespec]
/Descending
Causes the output to be printed in descending order instead of ascending
order. By default, the most recent files (or largest) are produced at
the end of the list. /Descned will reverse the order.
/Size
Causes the listing to be sorted by file size instead of date.
PROGRAM SDIR
C*
C* *******************************
C* *******************************
C* ** **
C* ** SDIR **
C* ** **
C* *******************************
C* *******************************
C*
C* AUTHOR :
C* Arthur E. Ragosta
C* RAGOSTA at MERLIN.ARC.NASA.GOV
C*
C* MS 219-1
C* NASA Ames Research Center
C* Moffett Field, Ca. 94035-1000
C* (415) 604-5558
C*
C* DESCRIPTION :
C* SORTED DIRECTORY
C* PRODUCE A SIMPLE DIRECTORY LISTING SORTED BY DATE or SIZE
C*
C* /DESCENDING = OLDEST DATES FIRST, ELSE NEWEST FIRST
C* /SIZE = sort by size instead of date
C*
C* SUBPROGRAM REFERENCES :
C*
C* ASSUMPTIONS AND RESTRICTIONS :
C* NOT TRANSPORTABLE.
C* DIRECTORY TRUNCATED AT 'max_files' FILE NAMES.
C*
C* LANGUAGE AND COMPILER :
C* ANSI FORTRAN 77
C*
C* CHANGE HISTORY :
C* 22 MAR 1993 - INITIAL VERSION
C* 14 SEP 1995 - Converted to alpha
C* 30 OCT 1995 - Bug fixed in USEROPEN
C*
C***********************************************************************
C*
PARAMETER (MAX_FILES=1000)
common /data/
$ date(max_files), direc(max_files), size(max_files),
$ names(max_files), num_files
logical direc
integer size
integer *8 date
character *80 names
c
integer indx(max_files)
c
CHARACTER *127 P(2), PATH, next_file
CHARACTER *20 Q(2)
character *23 adate
CHARACTER *4 ON, OFF
LOGICAL D_FLAG, S_FLAG
external my_open
C
ON = CHAR(27) // '[1m' ! Bold on
OFF = CHAR(27) // '[0m' ! Bold off
D_FLAG = .FALSE.
S_FLAG = .FALSE.
CALL GETFOR (NQ, Q, NP, P)
DO 1 I = 1, NQ
IF (Q(I)(1:1) .EQ. 'D') THEN ! Just in case he said /DATE
IF ((LENGTH(Q(I)) .LE. 1) .OR. (Q(I)(2:2) .NE. 'A'))
$ D_FLAG = .TRUE.
ENDIF
IF (Q(I)(1:1) .EQ. 'S') S_FLAG = .TRUE.
1 CONTINUE
C
C --- Defaults to current directory
C
IF (NP .EQ. 0) THEN
CALL DEFAULT ( PATH )
ELSE
PATH = P(1)
ENDIF
CALL PARSE ( PATH, '*.*;*', 'FULL', PATH )
num_files = 0
c
c --- loop over wildcards for each file; "MYOPEN" does all the work
c
10 call getfile ( path, next_file )
if (next_file .ne. ' ') then
call parse (next_file, ' ', 'LO', names(num_files+1))
OPEN (UNIT=0, FILE=next_file(1:length(next_file)),
$ STATUS='OLD', ERR=10, useropen=my_open)
30 close(unit=0)
if (num_files .le. max_files) go to 10
endif
C
C --- sort file list by date or size
C
IF (S_FLAG) THEN
call isorti (size, num_files, indx) ! by File SIZE !!!
ELSE
call isorti8 (date, num_files, indx) ! by DATES !!!
ENDIF
C
C --- In descending order ?
C
IF (D_FLAG) THEN
ISTART = NUM_FILES
IEND = 1
INCR = -1
ELSE
ISTART = 1
IEND = NUM_FILES
INCR = 1
ENDIF
C
C -- Note that directory files are bolded on output
c
DO 100 I = ISTART, IEND, INCR
ln = length(names(indx(i)))
c
c ----- Sorted by size
c
if (s_flag) then
if (direc(indx(i))) then
if (ln .le. 30) then
write (6,900) on,
$ names(indx(i))(1:ln), off, size(i)
else
write (6,901) on,
$ names(indx(i))(1:ln), off, size(i)
endif
else
if (ln .le. 30) then
write (6,910) names(indx(i))(1:ln), size(i)
else
write (6,911) names(indx(i))(1:ln), size(i)
endif
endif
c
c ----- Sorted by date
c
else
call sys$asctim ( , adate, date(i) ,)
if (direc(indx(i))) then
if (ln .le. 30) then
write (6,920) on,
$ names(indx(i))(1:ln), off, adate(1:17)
else
write (6,921) on,
$ names(indx(i))(1:ln), off, adate(1:17)
endif
else
if (ln .le. 30) then
write (6,930) names(indx(i))(1:ln), adate(1:17)
else
write (6,931) names(indx(i))(1:ln), adate(1:17)
endif
endif
endif
100 CONTINUE
C
CALL EXIT
900 format(' ',3a,t38,i5)
901 format(' ',3a/,t38,i5)
910 format(' ',a,t30,i5)
911 format(' ',a/,t30,i5)
920 format(' ',3a,t38,a)
921 format(' ',3a/,t30,a)
930 format(' ',a,t30,a)
931 format(' ',a/,t30,a)
END
C
C---END SDIR
C
integer function my_open (fab, rab, lun)
c*
c* This routine is called by the FORTRAN OPEN statement to extract the
c* file size, date, and directory flag for each file.
c*
PARAMETER (MAX_FILES=1000)
common /data/
$ date(2,max_files), direc(max_files), size(max_files),
$ names(max_files), num_files
logical direc
integer size
integer *4 date ! Fudge to make it easier to move quadword
character *80 names
c
include '($fabdef)'
c include '($rabdef)'
include '($xabdef)'
include '($xabdatdef)'
include '($xabfhcdef)'
include '($xabitmdef)'
c
c --- is this complicated, or what?
c
structure /bigxab/
union
map
record/xabdef/ xab
endmap
map
record /xabdatdef/ xabdat
endmap
endunion
endstructure
c
structure /bigxab1/
union
map
record/xabdef/ xaba
endmap
map
record /xabfhcdef/ xabfhc
endmap
endunion
endstructure
c
structure /bigxab2/
union
map
record/xabdef/ xabb
endmap
map
record /xabitmdef/ xabitm
endmap
endunion
endstructure
c
record /fabdef/ fab
c record /rabdef/ rab
record /bigxab/ xab0
record /bigxab1/ xab1
record /bigxab2/ xab2
c
structure /itmlst/
integer *2 buflen
integer *2 itemcode
integer *4 bufadr
integer *4 retlen
end structure
record /itmlst/ items(3)
c
logical is_dir
integer sys$open, sys$connect
c
c --- WARNING !!! The following is not strictly accurate as it should
c scan the XAB list and resolve any differences between my XABs
c and any passed by the USEROPEN routine, but this was a pain
c and (not being a file system expert) I couldn't get it to work
c right. This SEEMS to work.
c
isave = fab.fab$l_xab
fab.fab$b_fac = fab$m_get ! readonly
fab.fab$l_xab = %loc(xab0)
c
xab0.xab.xab$b_cod = xab$c_dat ! This is a DATE XAB
xab0.xab.xab$b_bln = xab$c_datlen
xab0.xab.xab$l_nxt = %loc(xab1)
c
xab1.xaba.xab$b_cod = xab$c_fhc ! size XAB
xab1.xaba.xab$b_bln = xab$c_fhclen
xab1.xaba.xab$l_nxt = %loc(xab2)
c
xab2.xabb.xab$b_cod = xab$c_itm ! Item code XAB
xab2.xabb.xab$b_bln = xab$c_itmlen
xab2.xabitm.xab$b_mode= xab$k_sensemode
xab2.xabitm.xab$l_itemlist = %loc(items)
c
c --- This SHOULD be set to ISAVE, but when I do that, the OPEN fails.
c Also, there is the possibility of a duplicate XAB, which is a pain
c to correct.
c
xab2.xabb.xab$l_nxt = 0
c
items(1).buflen = 4
items(1).itemcode = XAB$_UCHAR_DIRECTORY ! Is this file a directory?
items(1).bufadr = %loc(is_dir)
items(1).retlen = 0
items(2).buflen = 0
items(2).itemcode = 0
my_open = sys$open (fab) ! Just to fill the XABs
c
c --- Undo the damage done above.
c
fab.fab$l_xab = isave
if (.not. my_open) return
c
num_files = num_files + 1 ! Success, add the file
date(1,num_files) = xab0.xabdat.xab$q_cdt(1) ! Date is stored in
date(2,num_files) = xab0.xabdat.xab$q_cdt(2) ! two parts
direc(num_files) = is_dir
c
c --- the calculation for size comes from an example on the DEC
c bulletin board
c
if (xab1.xabfhc.xab$w_ffb .eq. 0) then
if (xab1.xabfhc.xab$l_hbk .eq. 0) then
size(num_files) = 0
else
size(num_files) = xab1.xabfhc.xab$l_ebk - 1
endif
else
size(num_files) = xab1.xabfhc.xab$l_ebk
endif
c
return
end
c
c---end my_open
c
More information about the Info-vax
mailing list