From:	SMTP%"RELAY-INFO-VAX@CRVAX.SRI.COM" 20-MAR-1994 16:54:15.64
To:	EVERHART
CC:	
Subj:	Re: Deltree on VMS?

From: rlboyd@rock.concert.net (Bob Boyd)
X-Newsgroups: comp.os.vms
Subject: Re: Deltree on VMS?
Date: 17 Mar 1994 21:49:45 GMT
Organization: CONCERT-Connect Public Dial UNIX
Lines: 255
Message-Id: <2maj9p$bir@inxs.concert.net>
Nntp-Posting-Host: rock.concert.net
To: Info-VAX@CRVAX.SRI.COM
X-Gateway-Source-Info: USENET

One little feature of VMS file system/logical name trivia that most DELTREE
offerings fail to deal with are rooted trees that are  deeper than the 
default limit.  When this feature of VMS came out, I messed around with it
and created some directory trees that were a pain to clean up when I was
done playing around.  Most people avoid creating this kind of mess, but
if you want a REALLY thorough DELTREE, this one does the trick.

Bob


$! ------------------ CUT HERE -----------------------
$ v='f$VERIFY(f$TRNLNM("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-007  22-FEB-1990
$!   On 17-MAR-1994 16:48:24.02   By user RLB14162 (Bob Boyd)
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$! 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. DELTREE.COM;7
$!
$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 = "!"
$ ve=f$GETSYI("version")
$ if ve-f$EXTRACT(0,1,ve) .ges. "4.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 '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 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ if .not. f$VERIFY() then $ 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");b:=
CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);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 IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
"output_file"));ENDPROCEDURE;Unpacker;QUIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create 'f'
X$ vfl = f$VER(0.or.f$trnlnm("debug$dcl"))
X$ set noon
X$! DELTREE.COM -- VMS V4+ version of DELTREE`20
X$! p1 -- target directory
X$! p2 -- qualifiers to apply
X$ DEL*ETE := "DELETE"
X$ status = $status
X$ if p1.eqs."" then $ exit
X$ say = "write sys$output "
X$ name = p1
X$! set up a default name string for parsing`20
X$ def_name = f$PARSE("",,,"device")+"`5B00000`5D00000.dir;-1"`09
X$! find the components of the directory specification
X$! and verify that the directory actually exists.
X$!
X$ dev_spec = f$PARSE(name,def_name,,"DEVICE")-":"
X$ dir_spec = f$PARSE(name,def_name,,"DIRECTORY")
X$ if .not.f$GETDVI(dev_spec,"exists") then $ goto ERR_DEV
X$ if dir_spec.eqs."`5B00000`5D" then goto ERR_DIR ! no directory name was su
Vpplied
X$ on error then $ set ver
X$ recurse = 1
X$ level = f$ENVIRONMENT("DEPTH")
X$ procname = f$PARSE(f$ENVIRONMENT("PROCEDURE"),,,"NAME")
X$ if f$TYPE('procname'_recurse).eqs.""`20
X$ then`20
X$  rb = "`5D"
X$  lb = "`5B"
X$  'procname'_recurse = "@"+f$ENVIRONMENT("PROCEDURE")
X$  'procname'_lev = 0
X$  if p1.eqs."" then $ exit
X$  p1 = p1-"..."
X$  save_dir = f$PARSE("")-".;"
X$  dot = "."
X$  recurse = 0
X$ endif
X$!
X$ 'procname'_lev = 'procname'_lev+1
X$ say "Working on ",p1," at DCL nesting level ",level
X$ stars = f$LOC("*",p1).lt.f$LEN(p1)
X$ dlt$ = f$PARSE(p1)-".;"
X$ dlt$y = f$PARSE(p1,,,"DIRECTORY")
X$ dlt$1 = f$PARSE(p1,,,"DEVICE")
X$ dlt$2 = f$TRNLNM(dlt$1-":")
X$ if dlt$2.nes."" then $ p1 = dlt$2+dlt$y
X$ dlt$ = f$PARSE(p1)-".;"
X$ dlt$y = f$PARSE(p1,,,"DIRECTORY")
X$ p1 = ""
X$ dlt$z = dlt$-dlt$y
X$ dlt$1 = f$ELEMENT(0,rb,dlt$y)+rb
X$ dlt$2 = f$ELEMENT(1,rb,dlt$y)
X$ if dlt$2.eqs.rb .or.dlt$2.eqs."" then $ goto NO_ROOT
X$  dlt$2 = dlt$2+rb
X$  root = dlt$z+dlt$1
X$  top_dir_nam = dlt$2
X$  del_dir = root+dlt$2
X$  goto GOT_ROOT
X$NO_ROOT:
X$  root = dlt$z
X$  dlt$2 = ""
X$  top_dir_nam = dlt$1
X$  del_dir = dlt$z+dlt$1
X$GOT_ROOT:
X$!show sym/loc/all
X$ if recurse then $ goto DONE_COUNT
X$!
X$! Find out how deeply the directory tree is nested below the node specified
V.
X$!
X$COUNT_SUBS:
X$ sub_count = 0
X$ test_dir = dlt$1+dlt$2
X$ if f$TYPE(dlt$).nes."" then $ del/sym/loc dlt$
X$ if f$TYPE(dlt$1).nes."" then $ del/sym/loc dlt$1
X$ if f$TYPE(dlt$2).nes."" then $ del/sym/loc dlt$2
X$ if f$TYPE(dlt$y).nes."" then $ del/sym/loc dlt$y
X$ if f$TYPE(dlt$z).nes."" then $ del/sym/loc dlt$z
X$COUNT_LOOP:
X$ sub_count = sub_count+1
X$ if f$ELEMENT(sub_count,dot,test_dir).nes.dot then $ goto COUNT_LOOP
X$ sub_count = sub_count-1
X$ test_dir = top_dir_nam
X$ seven = root+(test_dir-rb)+f$EXTRACT(0,14-2*sub_count,".*.*.*.*.*.*.*.*")+
Vrb
X$ if f$SEARCH(seven+"*.dir;").eqs."" then $ goto DONE_COUNT
X$ seven_ctx = 31415
X$ seven_test = root+(test_dir-rb)+-
X`09f$EXTRACT(0,12-2*sub_count,".*.*.*.*.*.*.*.*")+rb+"*.dir"
X$ del/sym/loc seven
X$ del/sym/loc sub_count
X$ del/sym/loc test_dir
X$SEVEN_LOOP:
X$ sev_dir = f$SEARCH(seven_test,seven_ctx)
X$ if sev_dir.eqs."" then $ goto SEVEN_DONE
X$  sev_dir = f$PARSE(sev_dir)-".;"
X$  sev_dir = -
X`09f$PARSE(sev_dir,,,"DEVICE")+-
X`09(f$PARSE(sev_dir,,,"DIRECTORY")-"`5D`5B"-rb+".`5D")+-
X`09lb+f$PARSE(sev_dir,,,"NAME")+rb
X$  if vfl then $ say "Deleting ",sev_dir," by recursion "
X$  'procname'_recurse 'sev_dir' 'p2' !'f$VER(vfl)'
X$   goto SEVEN_LOOP !'f$VER(0)'
X$SEVEN_DONE:
X$ del/sym/loc seven_test
X$! Clean up symbols from looking into the tree
X$DONE_COUNT:
X$ if f$TYPE(dlt$).nes."" then $ del/sym/loc dlt$
X$ if f$TYPE(dlt$1).nes."" then $ del/sym/loc dlt$1
X$ if f$TYPE(dlt$2).nes."" then $ del/sym/loc dlt$2
X$ if f$TYPE(dlt$y).nes."" then $ del/sym/loc dlt$y
X$ if f$TYPE(dlt$z).nes."" then $ del/sym/loc dlt$z
X$ down = root+lb+(top_dir_nam-lb-rb)+".*`5D"
X$ if f$SEARCH(del_dir+"*.dir").eqs."" then $ goto THIS_LEVEL
X$ if .not.f$PRIV("BYPASS") then $ set file/prot=(s:rwed,o:rwed) 'del_dir'*.d
Vir;
X$   if 'procname'_lev .gt. 8 then $ goto TOO_DEEP
X$   if vfl then $ say "Deleting ",down," by recursion "
X$   'procname'_recurse 'down' 'p2' !'f$VER(vfl)
X$THIS_LEVEL: !'f$VER(0)'
X$ del_files = del_dir+"*.*;*"
X$ if vfl then $ say "Deleting ",del_files," at DCL level ",level
X$ if f$SEARCH(del_files).eqs."" then $ goto EXIT
X$ if .not.f$PRIV("BYPASS") then $ set file/prot=(s:rwed,o:rwed) 'del_files'
X$ delete 'del_files' 'p2' ! 'f$VER(0)'
X$EXIT:
X$ vfl1 = 0
X$ if 'procname'_lev .gt.1 then $ goto EXIT_END
X$ vfl1 = vfl
X$ dx=f$pa(del_dir)-"`5D`5B"-"000000."-"`5D.;"
X$ dir_fil_nam = -
X`09f$pa(dx+".-`5D.DIR",f$pa(dx+"`5D")-(f$pa(dx+".-`5D")-"`5D.;"-"000000")-"`
V5D"-".")
X$ if .not.f$PRIV("BYPASS") then $ set file/prot=(s:rwed,o:rwed) 'dir_fil_nam
V'
X$ delete 'dir_fil_nam'/log
X$ if 'procname'_lev.nes.1 then $ goto EXIT_END
X$  set default 'save_dir'
X$  say "Delete of ",del_dir," complete.
X$EXIT_END:
X$ if vfl then $ say "Returning from level",level ! 'f$VER(vfl1)'
X$ exit 'status'`20
X$! error section
X$TOO_DEEP:
X$ say "The procedure has failed and nested too deeply"
X$ status = "%X14003000"
X$ goto EXIT_END`20
X$ERR_DEV:
X$ rms$_invdev = "%X00000144"
X$  if f$GETDVI(dev,"EXISTS") then goto FIX_DIR
X$  say "DELTREE-F-INVDEV invalid device specification ",p1
X$  status = rms$_invdev
X$  goto EXIT_END
X$ERR_DIR:
X$ rms$_dir = "%X000184CC"
X$ rms$_dnf = "%X0001C04A"
X$  say "DELTREE-F-NODIR  missing directory specification ",p1
X$  say -
X"%DELTREE-F-INVDIR ",p1," does not exist `0D`0A`09or is an invalid specifica
Vtion"
X$  status = rms$_dnf
X$  goto EXIT_END
X$ERR_EXIT:
X$  err_stat = $status
X$  mess = f$MESSAGE(err_stat)
X$  say -
X"%DELTREE-E-ERROR  an error occurred while processing ''p1'"
X$  say mess
X$  exit err_stat
X$!Last Modified:  14-NOV-1990 22:52:25.51, By: WARD`20
$ CALL UNPACK DELTREE.COM;7 489099560
$ v=f$VERIFY(v)
$ EXIT
-- 
Bob Boyd				|  Network/Systems Management Consultant
Voice:    	919-554-0043		|  Visionary Concepts & Designs, Inc.
Internet:	rlboyd@mercury.interpath.net (was: rlboyd@rock.concert.net)
USnail Mail:	438 Tyler Run Dr., Wake Forest, NC  27587

