;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;								;
;	Copyright 2011, 2013 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
; The purpose of this routine is to take the ls -lR output of the regular
; GT.M development directory and massage it to look like what we expect from
; the installed directory
;
; mumps -r dircompare <filename> <deletefilename | NOP> <addfilename | NOP> <deletedirectory | NOP>
;
; <filename> is the output of ls -lR of pro in either the build directory or the install directory
; For each of the following NOP indicates that there are none
;  <deletefilename>	- delete entries - aka files missing from PRO
;  <addfilename>	- added entries - aka files added on to of PRO
;  <deletedirectory>	- deleted directories - aka dirs missing from PRO
;
; 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.
;
; <deletefilename>
; 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.
;
; <addfilename>
; 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.
;
; <deletedirectory>
; The format of the deldirfile is shown below.
;
dircompare
	; set etrap so we get debug info and exit mumps
	set $etrap="use $P write $zstatus,!,""Error line: "" zprint @$zposition s x=$zjobexam() halt"
	; read the delete file into global memory
	kill ^delentries
	kill ^addentries
	kill ^deldirentries
	kill ^debug
	; Parse command line
	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"
	. set ^debug($i(readdirloop))=dirname
	. if $DATA(^deldirentries(dirname)) set directorydelete=1 ; flag directory to delete
	. else  do
	..  use $P
	..  if 'nonewline write !
	..  write dirname,!
	..  set (directorydelete,nonewline)=0
	. set ^debug(readdirloop,dirname,"state")=$select(directorydelete=1:"delete me",1:"use me")
	. 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)
	for  set unused=$order(^addentries($get(unused)))  quit:unused=""  do
	. use $p write !,unused,! do tryinsert(unused)
	close infile
	halt

trydelete(dirname,filename)
	quit $data(^delentries(dirname,filename))

tryadd(dirname,filename,infile)
	set ret=0
	if $DATA(^addentries(dirname,filename)) do
	. use $P
	. for j=1:1:^addentries(dirname,filename) do
	. . write ^addentries(dirname,filename,j),!
	. . set ^debug(readdirloop,dirname,$i(action))=$R
	. set ^addentries(dirname)=$increment(^addentries(dirname),-j)
	. kill ^addentries(dirname,filename)
	. if $data(^addentries(dirname))<10 kill ^addentries(dirname)
	. use infile
	. quit
	quit

tryinsert(dirname)
	set nummatch=^addentries(dirname)
	if $DATA(^addentries(dirname,"zzz_insert")) do
	. use $P
	. for j=1:1:^addentries(dirname,"zzz_insert") do
	. . write ^addentries(dirname,"zzz_insert",j),!
	. . set ^debug(readdirloop,dirname,$i(action))=$R
	. set ^addentries(dirname)=$increment(^addentries(dirname),-j)
	. kill ^addentries(dirname,"zzz_insert")
	. if $data(^addentries(dirname))<10 kill ^addentries(dirname)
	. 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

; Ensure that the routine uses a file as input only once and that the target file exists
;  f - is the name of a local which was just set by the CLI parser
uniquefile(f)
	new fn,status,same
	set status=1
	for fn="infile","deletefile","addfile","deldirfile" do
	.	; Skip when f and fn point to the same local
	.	quit:f=fn
	.	; If the local (fn points to) DOES NOT exist in memory, quit
	.	quit:$data(@fn)=0
	.	; The local (fn points to) exists in memory, quit if f and fn DO NOT point to the same file
	.	quit:@f'=@fn
	.	set status=0,same=1
	.	write !,f," and ",fn," files (",@f,") can't be the same",!
	.	quit
	if $data(same) quit status
	if ""=$ZSEARCH(@f) set status=0 write !,f," file: ",@f," does not exist",!
	quit status

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