From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 15-JUN-1991 16:21:24.20
To:	ARISIA::EVERHART
CC:	
Subj:	Re: File information from VMS - DIRBYDATE, pt 1 of 2

From:	RELAY-INFO-VAX@CRVAX.SRI.COM@SMTP@CRDGW2
To:	Everhart@Arisia@MRGATE

Received:  by crdgw1.ge.com (5.57/GE 1.100)
	 id AA26389; Sat, 15 Jun 91 15:21:58 EDT
Received: From ucbvax.Berkeley.EDU ([128.32.133.1]) by CRVAX.SRI.COM with TCP; Sat, 15 JUN 91 11:58:27 PDT
Received: by ucbvax.Berkeley.EDU (5.63/1.42)
	id AA04206; Sat, 15 Jun 91 11:47:01 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews
	for info-vax@kl.sri.com (info-vax@kl.sri.com)
	(contact usenet@ucbvax.Berkeley.EDU if you have questions)
Date: 15 Jun 91 17:38:22 GMT
From: portal!cup.portal.com!Chris_F_Chiesa@apple.com
Organization: The Portal System (TM)
Subject: Re: File information from VMS - DIRBYDATE, pt 1 of 2
Message-Id: <43351@cup.portal.com>
References: <1991Jun8.232439.5833@ringer.cs.utsa.edu>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com

Here's part 1 of my DIRBYDATE package...  It's a little embarrassing how
big this got (two VMS_SHARE parts) after I wrote the docs, considering how
small and hacky the actual CODE is.  Oh well, c'est la Net.
---- CUT HERE ---- 8< ---- CUT HERE ---- 8< ---- CUT HERE ---- 8< ----
$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.1-004  3-AUG-1989
$!   On 15-JUN-1991 13:04:33.62   By user CHIESA 
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$!+ THIS PACKAGE DISTRIBUTED IN 2 PARTS, TO KEEP EACH PART
$!  BELOW 30 BLOCKS
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. DIRBYDATE.CLD;2
$!       2. DIRBYDATE.MAR;3
$!       3. DIRBYDATE.README;4
$!       4. DIRBYDATE.TECH;1
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ if f$getsyi("version") .ges. "V4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete/nolog 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete/nolog 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");
buff:=CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(buff))
;LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(buff));g:=0;LOOP EXITIF MARK(NONE)=END_OF(buff);x:=
ERASE_CHARACTER(1);IF g = 0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x=
"V" THEN APPEND_LINE;MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;
IF x="+" THEN g:=1;ERASE_LINE;ENDIF;ELSE IF x="-" THEN g:=0;ENDIF;ERASE_LINE;
ENDIF;ENDLOOP;p:="`";POSITION(BEGINNING_OF(buff));LOOP r:=SEARCH(p,FORWARD);
EXITIF r=0;POSITION(r);ERASE(r);COPY_TEXT(ASCII(INT(ERASE_CHARACTER(3))));
ENDLOOP;o:=GET_INFO(COMMAND_LINE,"output_file");WRITE_FILE(buff,o);
ENDPROCEDURE;Unpacker;EXIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create/nolog 'f'
X
XMODULE directory_by_date
X
X DEFINE VERB DIRBYDATE
X
X IMAGE UTILDIR:DIRBYDATE
X
X PARAMETER P1,LABEL=SEARCHSPEC
X   VALUE(IMPCAT,DEFAULT="",TYPE=$FILE)
$ CALL UNPACK DIRBYDATE.CLD;2 809775709
$ create/nolog 'f'
X;+
X;   DIRBYDATE.MAR - Chris Chiesa  (Chris_F_Chiesa@cup.portal.com)
X;
X;-
X
X`009`009`009.psect`009data`009wrt,noexe,long
X
X`009`009`009workbufsize = 255`009`009; "Working" filespec
X;+
X;  RMS File Access Block (FAB) for use by $PARSE in setting up search-
X;  context information.  FAB is used as input; most of the search-context
X;  information is actually placed in the NAM block.
X;-
Xdirec_access:`009`009$fab`009fna=inputbuf,-`009`009; FAB for $PARSE
X`009`009`009`009fns=workbufsize,-`009; and $SEARCH
X`009`009`009`009dna=defaultbuf,-
X`009`009`009`009dns=defsize,-
X`009`009`009`009nam=name_block,-`009; for $PARSE/$SEARCH
X`009`009`009`009xab=date_block`009`009; for date retrieval
X;+
X;  RMS File Access Block (FAB) for use by $OPEN in obtaining each file's
X;  Creation date.  FAB is used as input; date informatoin is placed in
X;  the associated XABDAT block.
X;-
X
Xfile_access:`009`009$fab`009nam=name_block,-`009; FAB for date-
X`009`009`009`009xab=date_block,-`009; retrieving $OPEN
X`009`009`009`009fop=<nam>
X
Xname_block:`009`009$nam`009nop=<srchxabs>,-`009; NAM block: used
X`009`009`009`009esa=expanded_string,-`009; by $PARSE and`032
X`009`009`009`009ess=workbufsize,-`009; $SEARCH for re-
X`009`009`009`009rsa=resultant_string,-`009; solving wildcards
X`009`009`009`009rss=workbufsize`009`009; and retrieving`032
X`009`009`009`009`009`009`009; directory entries
X
Xdate_block:`009`009$xabdat`009`009`009`009; Date XAB - re-
X`009`009`009`009`009`009`009; ceives all "date"
X`009`009`009`009`009`009`009; info about a file
X
Xparameter:`009`009.ascid`009/SEARCHSPEC/`009`009; Name of DCL com-
X`009`009`009`009`009`009`009; mand's PARAMETER
X
X;+
X; Default search specification - this string is used to fill in any`032
X; file-specification fields OMITTED from the command-line argument.
X; Change this if you want a default other than "all versions of all
X; files in the current DEFAULT directory."
X;-
Xdefaultbuf:`009`009.ascii`009/`091`093*.*;*/`009`009; This form of`032
X`009`009`009defsize = .-defaultbuf`009`009; declaration pro-
X`009`009`009`009`009`009`009; vides explicit
X`009`009`009`009`009`009`009; address and size
X`009`009`009`009`009`009`009; for insertion in
X`009`009`009`009`009`009`009; FAB.
X
Xdefault_desc:`009`009.long `009defsize`009`009`009; The same string,
X`009`009`009.address defaultbuf`009`009; for use "by des-
X`009`009`009`009`009`009`009; criptor."
X;
Xinput_spec:`009`009.long`009workbufsize`009`009; Same type of
X`009`009`009.address inputbuf`009`009; thing, for working
Xinputbuf:`009`009.blkb`009workbufsize`009`009; filespec.
X
X
Xfound_spec:`009`009.blkl`009`009`009`009; Results of $PARSE
X`009`009`009.address resultant_string`009; and $SEARCH go here
X
X;+
X; Output format string.  This string contains "FAO directives" for use with
X; the $FAO (Formatted ASCII Output) System Service.  This string is used in
X; the "action routine" provided to LIB$TRAVERSE_TREE, and generates a 23-
X; character Date/Time followed by 2 spaces and a variable-length "counted
X; ASCII" character string.
X;-
Xreport_format:`009`009.ascid`009/!23<!%D!>  !AC/`009; $FAO format string
X
X;+
X; The following "blank string" receives the formatted output of $FAO, and
X; is the string actually output to the terminal.
X;-
Xreport:`009`009`009.blkl`009`009`009`009
X`009`009`009.address -
X`009`009`009`009reportbuf
Xreportbuf:`009`009.blkb`009132
X
Xcdt_desc:`009`009.long`0098
X`009`009`009.address name_block+xab$q_cdt
X;+
X; Temporary data structures used by "allocation_routine" provided to`032
X; LIB$INSERT_TREE - i.e., someplace from which to "hand off" a dynamically
X; allocated chunk of Virtual Memory.
X;-
Xnode_size:`009`009.blkl
Xtemp_node:`009`009.blkl
Xnew_node:`009`009.blkl
X;
Xtree_head:`009`009.blkl
Xtree_insert_flag:`009.long`0091`009`009`009; allow duplicates
X;+
X; End of tree-insertion-related declarations.
X;
X; The following two buffers are used by $PARSE when expanding wildcard`032
X; specifications (and perhaps by $SEARCH when pulling up a new filespec
X; from the directory.  I don't quite recall.  See the RMS manual!).
X;-
Xexpanded_string:`009.blkb`009workbufsize
Xresultant_string:`009.blkb`009workbufsize
X
X;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X; Executable code begins here!
X;-------------------------------------------------------------------------
X`009`009`009.psect`009code`009nowrt,exe
X
X`009`009`009.entry`009dir_by_date,`094m<>
X;+
X; Obtain the user's search specification (wildcards allowed) from the`032
X; DCL command line.
X;-
X`009`009`009pushal`009input_spec
X`009`009`009pushaq`009input_spec
X`009`009`009pushaq`009parameter
X`009`009`009calls`009#2,g`094cli$get_value
X`009`009`009blbs`009r0,ok1
X`009`009`009jmp`009dir_err
Xok1:
X;+
X; The following two RMS calls -- $PARSE and $SEARCH -- are the answer to
X; the original Usenet question which prompted this posting.  Note that
X; $PARSE is called ONCE to initialize the directory scan, and that $SEARCH
X; is called REPEATEDLY until it returns the status RMS$_NMF (no more files).
X; Each call to $SEARCH returns the specification of the next file which`032
X; matched the specification(s) supplied to the initiating $PARSE.
X;-
X`009`009`009$parse`009fab=direc_access`009; Build search`032
X`009`009`009`009`009`009`009; context
X`009`009`009blbs`009r0,ok2`009`009`009
X`009`009`009jmp`009dir_err
Xok2:
X;+
X; This $SEARCH call places a file specification string in the buffer pointed
X; to by the NAM$B_RSL field of the NAM block.  This is the result requested
X; by the original poster!  (Usenet, June 1991)
X;-
X`009`009`009$search`009fab=direc_access`009; Find next file-
X`009`009`009`009`009`009`009; name matching spec
X`009`009`009blbs`009r0,ok3
X`009`009`009jmp`009dir_err
Xok3:
X`009`009`009movzbl`009name_block+nam$b_rsl,found_spec
X;+
X; The rest of this program deals with obtaining each file's creation date,
X; and with sorting filename/date pairs BY date.
X;-
X;+
X; Call RMS $OPEN to fill XABDAT block with file date information.  This
X; FAILS if the file is ALREADY open!  RMS $OPEN is _not_ the right way
X; to do this, in the long run.  See the TECH document.
X;-
X`009`009`009$open`009fab=file_access`009`009; Obtain file info
X`009`009`009blbs`009r0,ok4
X`009`009`009jmp`009dir_err
Xok4:
X;+
X; At the time I wrote this, I thought that $OPENing the file was not`032
X; sufficient to fill the creation-date fields of the XAB, so I coded an
X; explicit RMS $DISPLAY, below.  Recent investigation proves that this`032
X; step is unnecessary, since $OPEN does an "implicit $DISPLAY."
X;-
X`009`009`009$display -
X`009`009`009`009fab=file_access
X`009`009`009blbs`009r0,ok5
X`009`009`009jmp`009dir_err
Xok5:
X;+
X; The "found_spec" string contains a full device and directory specification
X; for each file found.  I didn't like seeing all of that forty or fifty time
Vs
X; every time I did a DIRBYDATE, so I added the next few instructions to chan
Vge
X; the original "found_spec" length- and address-fields so that they describe
X; a string containing only the file's NAME, TYPE, and VERSION.  This is NOT
X; a hack -- RMS provides pointers and lengths for exactly this purpose.
X;-
X`009`009`009moval`009name_block,r3`009`009; R3 => NAM block base
X;
X`009`009`009moval`009@nam$l_name(r3),-`009; Address of "name"
X`009`009`009`009<found_spec+4>`009`009; component
X`009`009`009movzbl`009nam$b_name(r3),-`009; Length of "name"...
X`009`009`009`009found_spec
X`009`009`009addb2`009nam$b_type(r3),-`009; plus "type"...
X`009`009`009`009found_spec
X`009`009`009addb2`009nam$b_ver(r3),-`009`009; plus "version"
X`009`009`009`009found_spec`009`009; component(s)!
X;+
X; Now that the file's name is in found_spec "by descriptor," and its crea-
X; tion date is in the XABDAT block, we call LIB$INSERT_TREE which uses an
X; "allocation routine" and a "comparison routine" we provide, to insert the
X; current information into a binary tree.
X;-
X`009`009`009pushal`009new_node
X`009`009`009pushal`009allocate_routine
X`009`009`009pushal`009compare_routine
X`009`009`009pushal`009tree_insert_flag
X`009`009`009pushaq`009date_block+xab$q_cdt
X`009`009`009pushal`009tree_head
X`009`009`009calls`009#6,g`094lib$insert_tree
X`009`009`009blbs`009r0,ok5a
X`009`009`009jmp`009dir_err
X
Xok5a:
X;+
X; Belatedly $CLOSE the file we $OPENed above.
X;-
X`009`009`009$close`009fab=file_access
X`009`009`009blbs`009r0,ok6
X`009`009`009jmp`009dir_err
Xok6:
X;+
X; Loop back to repeat $SEARCH!
X;-
X`009`009`009jmp`009ok2
X
Xdir_err:
X;+
X; Execution comes here when an error occurs in the $SEARCH call.  If the
X; "error" is RMS$_NMF (no more files), this is "normal" completion and
X; we're ready to display the contents of the binary tree LIB$INSERT_TREE has
X; built for us.  If the error is NOT RMS$_NMF, it's some OTHER, truly er-
X; roneous condition, and we DON'T display the tree.
X;-
X`009`009`009cmpl`009r0,#rms$_nmf`009; "No more files" error?
X`009`009`009bneq`009real_err`009;   NO: real error: fail!
X`009`009`009`009`009`009;  YES: display the tree
X;+
X; Call LIB$TRAVERSE_TREE to "do something for each node of the tree in order
V:"
X; in this case, that's to FORMAT and DISPLAY the date and filename contained
X; in the node!
X;-
X`009`009`009pushal`009action_routine
X`009`009`009pushal`009tree_head
X`009`009`009calls`009#2,g`094lib$traverse_tree
X`009`009`009blbc`009r0,real_err`009
X`009`009`009ret
X;+
X; Believe it or not, that's the END of the program!
X;-
Xreal_err:`009`009$exit_s`009r0
X;===========================================================================
V===
X;  "Compare" routine for use with LIB$INSERT_TREE:`032
X;
X;     Indicate which of two nodes -- the new one being inserted, or`032
X;     that at LIB$INSERT_TREE's internal position -- is "greater."
X;
X;      4(AP) = sym-str          -- pointer to new date_time quadword`032
X;      8(AP) = treehead         -- pointer to a node already in the tree
X;
X`009`009`009.entry`009compare_routine,`094m<r2,r3>
X
X`009`009`009moval`009@4(ap),r2`009; R2 => new node
X`009`009`009moval`009@8(ap),r3`009; R3 => old node
X;
X`009`009`009addl2`009#10,r3`009`009; offset to date/time
X;+
X; Compare VMS date-time quadword.  Note that I wrote this BEFORE VMS pro-
X; vided library routines to do this.  Note also how simple it is, and how
X; much less overhead is involved here than in stacking arguments and calling
X; a RTL procedure! :-)
X;
X; Quadwords are compared by FIRST comparing their MOST-significant LONGwords
V;
X; if those are not EQUAL, the comparison is finished.  If the MOST-significa
Vnt
X; longwords ARE equal, compare the LEAST-significant longwords.  The result
X; of the last comparison performed (maximum of two) is the result of the`032
X; quad comparison.
X;
X;  NOTE: TO REVERSE THE ORDER OF SORTING, EXCHANGE THE EXPRESSIONS`032
X;    "(R2)" and "(R3)" IN BOTH OF THE "SUBL3" INSTRUCTIONS HERE!
X;-
X`009`009`009subl3`0094(r2),4(r3),r0`009; Are MSLs equal?
X`009`009`009bneq`009compare_done`009;   NO: comparison is done!
X`009`009`009subl3`009(r2),(r3),r0`009;  YES: compare LSLs
X;
Xcompare_done:`009`009ret`009`009`009; return with status bits`032
X`009`009`009`009`009`009; bearing comparison result
X
X;===========================================================================
V===
X;  "Allocation" routine for use with LIB$INSERT_TREE:
X;
X;`009Allocate Virtual Memory for storage of file-creation date-time`032
X;`009quadword, file specification as a counted-ASCII string, and`032
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-

