289 lines
11 KiB
Plaintext
289 lines
11 KiB
Plaintext
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; ;
|
|
; Copyright 2011 Fidelity Information Services, Inc ;
|
|
; ;
|
|
; This source code contains the intellectual property ;
|
|
; of its copyright holder(s), and is made available ;
|
|
; under a license. If you do not know the terms of ;
|
|
; the license, please stop and do not read further. ;
|
|
; ;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; dircompare
|
|
; mumps -r dircompare <filename> <deletefilename | NOP> <addfilename | NOP> <deletedirectory | NOP>, where filename
|
|
; is the output of ls -lR
|
|
; of pro in either the build directory or the install directory.
|
|
; If the deletefilename is NOP then there are no delete entries.
|
|
; If the addfilename is NOP then there are no add entries.
|
|
; If the deletedirectory is NOP then there are no deldirectory entries.
|
|
; The first few lines of the three files are the copyright lines. Other comment lines may be included after
|
|
; the copyright lines and all are eaten before the data is read into the database. No spaces are allowed between the comments
|
|
; lines.
|
|
; The format of the deletefile is shown below. Its purpose is to delete files from the list of permissions and files
|
|
; which are written to standard output.
|
|
; The format of the addfile is shown below. Its purpose is to add files to the list of permissions and files
|
|
; which are written to standard output. To add files before an existing entry, the tryadd function is used.
|
|
; To add files after the last file in a directory, the same format is used in the addfile, but the filename must be
|
|
; after the last entry (i.e. must not exist). The tryinsert function adds files to the end of a directory. It
|
|
; assumes that at least one file exists in the directory. An example of both forms is given prior to the loadadd function.
|
|
|
|
dircompare
|
|
; set etrap so we get debug info and exit mumps
|
|
set $etrap="use $P write $zstatus,!,""Error line: "" zprint @$zposition halt"
|
|
; read the delete file into global memory
|
|
kill ^delentries
|
|
kill ^addentries
|
|
kill ^deldirentries
|
|
if 4'=$LENGTH($ZCMDLINE," ") do
|
|
. write "Usage: dircompare <filename> <deletefilename | NOP> <addfilename | NOP> <deletedirectory | NOP>",! halt
|
|
set infile=$PIECE($ZCMDLINE," ",1)
|
|
if $ZSEARCH("foo.bar") ; ensure a new search
|
|
if '$$uniquefile("infile") halt
|
|
set deletefile=$PIECE($ZCMDLINE," ",2)
|
|
if "NOP"'=deletefile do
|
|
. if '$$uniquefile("deletefile") halt
|
|
. do loaddelete(deletefile)
|
|
set addfile=$PIECE($ZCMDLINE," ",3)
|
|
if "NOP"'=addfile do
|
|
. if '$$uniquefile("addfile") halt
|
|
. do loadadd(addfile)
|
|
set deldirfile=$PIECE($ZCMDLINE," ",4)
|
|
if "NOP"'=deldirfile do
|
|
. if '$$uniquefile("deldirfile") halt
|
|
. do loaddeldir(deldirfile)
|
|
set (directorydelete,nonewline)=1
|
|
open infile:(readonly)
|
|
use infile:exception="GOTO EOF"
|
|
for read dirname,x do; read a directory and eat the next line which is size info; ; terminated by exception="GOTO EOF"
|
|
. if $DATA(^deldirentries(dirname)) set directorydelete=1 ; flag directory to delete
|
|
. else do
|
|
.. use $P
|
|
.. if 'nonewline write !
|
|
.. write dirname,!
|
|
.. set (^addmatch,directorydelete,nonewline)=0
|
|
. for use infile read x do quit:""=x
|
|
.. if ""=x do quit; if it is a blank line then tryinsert
|
|
... ;in case a file(s) need(s) to be added to the end of the directory
|
|
... if $DATA(^addentries(dirname)) do tryinsert(dirname)
|
|
.. if directorydelete quit
|
|
.. set filename=$$getfilename(x) ; get the filename
|
|
.. if $DATA(^addentries(dirname)) do tryadd(dirname,filename,infile)
|
|
.. if $DATA(^delentries(dirname)),$$trydelete(dirname,filename) quit
|
|
.. set ext=$$getext(filename)
|
|
.. if (".hlp"=ext)!(".csh"=ext)!(".c"=ext) quit
|
|
.. if (".gtc"=ext) do zapgtc(.x) set filename=$$getfilename(x) ; get the modified filename
|
|
.. set perm=$PIECE(x," ",1) ; get the first piece which is the permission field
|
|
.. ; if it is a symbolic link then leave it alone. Otherwise, make some permission changes
|
|
.. if ("lrwxrwxrwx"'=perm)&("lrwxr-xr-x"'=perm) do
|
|
... do rmwrite(.perm),zapworld(.perm)
|
|
... if (".a"=ext)!(".o"=ext)!(".m"=ext)!(".dat"=ext)!(".gld"=ext)!(".h"=ext) do rmxall(.perm)
|
|
.. use $P
|
|
.. write perm," ",filename,!
|
|
|
|
EOF
|
|
if ('directorydelete&$DATA(^addentries(dirname))) do tryinsert(dirname)
|
|
close infile
|
|
halt
|
|
|
|
trydelete(dirname,filename)
|
|
quit $data(^delentries(dirname,filename))
|
|
|
|
tryadd(dirname,filename,infile)
|
|
set ret=0
|
|
if $DATA(^addentries(dirname,filename)),$increment(^addmatch) do
|
|
. use $P
|
|
. for j=1:1:^addentries(dirname,filename) write ^addentries(dirname,filename,j),!
|
|
. use infile
|
|
. quit
|
|
quit
|
|
|
|
tryinsert(dirname)
|
|
set nummatch=^addentries(dirname)
|
|
if nummatch>^addmatch&$DATA(^addentries(dirname,"zzz_insert")) do
|
|
. use $P
|
|
. for j=1:1:^addentries(dirname,"zzz_insert") write ^addentries(dirname,"zzz_insert",j),!
|
|
. use infile
|
|
quit
|
|
|
|
rmwrite(perm)
|
|
; do the equivalent of chmod a-w by translating permission w to -
|
|
set perm=$TRANSLATE(perm,"w","-")
|
|
quit
|
|
|
|
zapgtc(str)
|
|
set instr=str
|
|
set a=$FIND(instr,".gtc")
|
|
set str=$EXTRACT(instr,1,a-5)_$EXTRACT(instr,a,$LENGTH(instr))
|
|
; make remove group executable to match install if not a link
|
|
if '$FIND(instr,">") set str=$EXTRACT(str,1,6)_"-"_$EXTRACT(instr,8,$LENGTH(str))
|
|
; may need to do it to the modified string if it is a link
|
|
set a=$FIND(str,".gtc")
|
|
set str=$EXTRACT(str,1,a-5)_$EXTRACT(str,a,$LENGTH(str))
|
|
quit
|
|
|
|
makelink(perm,filename)
|
|
set perm="l"_$EXTRACT(perm,2,10)
|
|
set filename=filename_" -> ../"_filename
|
|
quit
|
|
|
|
zapworld(perm)
|
|
; get everything up to world field and add --- to tail
|
|
set perm=$EXTRACT(perm,1,7)_"---"
|
|
quit
|
|
|
|
addgrpx(perm)
|
|
set perm=$EXTRACT(perm,1,6)_"x"_$EXTRACT(perm,8,$LENGTH(perm))
|
|
quit
|
|
|
|
;do the equivalent of chmod a-x by translating x to - in perm
|
|
rmxall(perm)
|
|
set perm=$TRANSLATE(perm,"x","-")
|
|
quit
|
|
|
|
|
|
; loaddelete(fdelete) - fdelete is the name of the delete file to load
|
|
; assume delete file starts with a directory name followed by a colon and has a blank line before each subdirectory
|
|
; assumes the last line is not blank. It is ok to have a directory with no entries under it
|
|
; example:
|
|
;
|
|
; pro:
|
|
; test.m
|
|
; file.o
|
|
;
|
|
; pro/sub1:
|
|
; test.m -> ../test.m
|
|
;
|
|
; pro/sub1/sub2:
|
|
;
|
|
; pro/sub3:
|
|
; afile.m
|
|
;
|
|
; The format of the ^delentries array for the above example is:
|
|
; ^delentries("pro:","test.m")=""
|
|
; ^delentries("pro:","file.o")=""
|
|
; ^delentries("pro/sub1:","test.m -> ../test.m")=""
|
|
; ^delentries("pro/sub3:","afile.m")=""
|
|
|
|
loaddelete(fdelete)
|
|
new delentries,dirname,file
|
|
open fdelete:(readonly)
|
|
use fdelete
|
|
; eat the copyright lines which start with a # and any other comment lines with a # in them
|
|
for quit:$ZEOF read dirname do ; read the directory
|
|
. if ('$find(dirname,"#")) for read file quit:$ZEOF!'$length(file) do:$length(file)
|
|
.. set ^delentries(dirname,file)=""
|
|
close fdelete
|
|
quit
|
|
|
|
; loadadd(fadd) - fadd is the name of the add file to load
|
|
; assume addfile starts with a directory name follwed by a colon and has a blank line before each subdirectory
|
|
; assumes the last line is not blank. It is ok to have a directory with no entries under it
|
|
; the field separators must be a %
|
|
; the add entries start with a existing file before which the following permission and file will be inserted
|
|
; The exception to this rule is if the file or files is to be entered after the last entry in a directory
|
|
; In this case, you must use the file name zzz_insert which will not match any file in the directory
|
|
; There can be multiple files to insert before the current file (or after the final line if match not found)
|
|
; example:
|
|
;
|
|
; pro:
|
|
; gtmcshrc.gtc%-r-xr-x--- gtmbase
|
|
; gtmhelp.dat%-r-xr-x--- gtmcshrc
|
|
; gtmsecshr%-r-xr-x--- gtmprofile
|
|
; gtmsecshr%-r-xr-x--- gtmprofile2
|
|
; zzz_insert%lrwxrwxrwx GETPASS.m -> ../GETPASS.m
|
|
|
|
; pro/plugin:
|
|
|
|
; pro/plugin/gtmcrypt:
|
|
; utf8%-r--r----- source.tar
|
|
|
|
; pro/plugin/gtmcrypt/utf8:
|
|
; zzz_insert%lrwxrwxrwx GETPASS.m -> ../GETPASS.m
|
|
|
|
; ^addentries("pro/plugin/gtmcrypt/utf8:")=1
|
|
; ^addentries("pro/plugin/gtmcrypt/utf8:","zzz_insert")=1
|
|
; ^addentries("pro/plugin/gtmcrypt/utf8:","zzz_insert",1)="lrwxrwxrwx GETPASS.m -> ../GETPASS.m"
|
|
; ^addentries("pro/plugin/gtmcrypt:")=1
|
|
; ^addentries("pro/plugin/gtmcrypt:","utf8")=1
|
|
; ^addentries("pro/plugin/gtmcrypt:","utf8",1)="-r--r----- source.tar"
|
|
; ^addentries("pro/plugin:")=0
|
|
; ^addentries("pro:")=5
|
|
; ^addentries("pro:","gtmcshrc.gtc")=1
|
|
; ^addentries("pro:","gtmcshrc.gtc",1)="-r-xr-x--- gtmbase"
|
|
; ^addentries("pro:","gtmhelp.dat")=1
|
|
; ^addentries("pro:","gtmhelp.dat",1)="-r-xr-x--- gtmcshrc"
|
|
; ^addentries("pro:","gtmsecshr")=2
|
|
; ^addentries("pro:","gtmsecshr",1)="-r-xr-x--- gtmprofile"
|
|
; ^addentries("pro:","gtmsecshr",2)="-r-xr-x--- gtmprofile2"
|
|
; ^addentries("pro:","zzz_insert")=1
|
|
; ^addentries("pro:","zzz_insert",1)="lrwxrwxrwx GETPASS.m -> ../GETPASS.m"
|
|
; The ^addentries("pro/plugin/gtmcrypt/utf8:")=1 is 1 because there is only one unique input file to match
|
|
; The ^addentries("pro/plugin/gtmcrypt:")=1 is 1 because there is only one unique input file to match
|
|
; The ^addentries("pro/plugin:")=0 because there are no files to match
|
|
; The ^addentries("pro:")=5 is 5 because there are five unique input files to match and add files before
|
|
|
|
loadadd(fadd)
|
|
open fadd:(readonly)
|
|
use fadd
|
|
; read the first directory
|
|
for read dirname quit:'$find(dirname,"#")
|
|
set ^addentries(dirname)=0
|
|
use fadd
|
|
for read x quit:$ZEOF do
|
|
. if x="" read dirname set ^addentries(dirname)=0
|
|
. else do
|
|
.. ; parse the line
|
|
.. set match=$PIECE(x,"%",1)
|
|
.. set add=$PIECE(x,"%",2)
|
|
.. if '$DATA(^addentries(dirname,match)) set ^addentries(dirname,match)=0
|
|
.. set ^addentries(dirname)=^addentries(dirname)+1
|
|
.. set ^addentries(dirname,match)=^addentries(dirname,match)+1
|
|
.. set ^addentries(dirname,match,^addentries(dirname,match))=add
|
|
use $P
|
|
quit
|
|
|
|
; loaddeldir(fdeldir) - fdeldir is the name of the delete file to load
|
|
; example:
|
|
;
|
|
; pro:
|
|
; pro/sub1:
|
|
;
|
|
; The format of the ^delentries array for the above example is:
|
|
; ^deldirentries("pro:")=0
|
|
; ^deldirentries("pro/sub1:")=0
|
|
|
|
loaddeldir(fdeldir)
|
|
open fdeldir:(readonly)
|
|
use fdeldir
|
|
for read dirname quit:$ZEOF if '$find(dirname,"#") set ^deldirentries(dirname)=0
|
|
use $P
|
|
quit
|
|
|
|
uniquefile(f)
|
|
new fn,ok
|
|
set ok=1
|
|
set same=0
|
|
for fn="infile","deletefile","addfile","deletedirfile" do
|
|
. if f'=fn,$DATA(@fn),@f=@fn set ok=0 write !,f," and ",fn," files (",@f,") can't be the same",! set same=1 quit
|
|
if same quit ok
|
|
if ""=$ZSEARCH(@f) set ok=0 write !,f," file: ",@f," does not exist",!
|
|
quit ok
|
|
|
|
getext(file)
|
|
; return the extension of the filename or null if none
|
|
; get the last piece which will be the actual filename
|
|
quit $ZPARSE($piece(file," ",$length(file," ")),"TYPE")
|
|
|
|
; getfilename
|
|
; function to return the ninth field which is the file name
|
|
; there will be multiple spaces between the fields preceeding it so count them as one space
|
|
;
|
|
|
|
getfilename(line)
|
|
set col=1
|
|
set strlength=$LENGTH(line)
|
|
for quit:(col=9) do
|
|
. set position=$find(line," ")
|
|
. set line=$EXTRACT(line,position,strlength)
|
|
. if " "'=$EXTRACT(line,1) set col=col+1 ;next character is not a space so it is a valid field
|
|
quit line
|