/* --------------------------------------------------------------- */ /* mergedirs -- merge contents of two fully qualified directories */ /* --------------------------------------------------------------- */ /* */ /* Copyright (c) Mike Cowlishaw, 1985-2012. All rights reserved. */ /* Parts Copyright (c) IBM, 1985-2010. */ /* */ /* Permission to use, copy, modify, and distribute this software */ /* for any non-commercial purpose without fee is hereby granted, */ /* provided that the above copyright notice and this permission */ /* notice appear in all copies, and that notice and the date of */ /* any modifications be added to the software. */ /* */ /* This software is provided "as is". No warranties, whether */ /* express, implied, or statutory, including, but not limited to, */ /* implied warranties of merchantability and fitness for a */ /* particular purpose apply to this software. The author shall */ /* not, in any circumstances, be liable for special, incidental, */ /* or consequential damages, for any reason whatsoever. */ /* */ /* --------------------------------------------------------------- */ /* Arguments: */ /* */ /* Arg1 is fully qualified directory specification (no trailing */ /* delimiter) */ /* Arg2 is fully qualified directory specification (ditto) */ /* Arg3 is 1 to merge subdirectories, 0 otherwise */ /* Arg4 is call depth for formatting (assumed 0 if not supplied) */ /* Arg5 is 0 to clone dir1->dir2 */ /* 1 to merge dir1->dir2 only, */ /* 2 for bi-directional dir1<->dir2 (default) */ /* 3 for safer 0 clone dir1->dir2 (deletes after creates) */ /* Arg6 is logfile specification ['' or not given = say messages] */ /* If logfile is prefixed with '+' then messages are both */ /* displayed and logged. */ /* Error messages are always displayed (and may be logged)*/ /* Arg7 is skiplist -- plain (unqualified) names of directories */ /* whose contents are not to be merged [names cannot have */ /* blanks] */ /* */ /* returns 0 if OK, non-zero if error */ /* */ /* Notes: */ /* */ /* 1. The root directory of a disk cannot be merged. */ /* */ /* 2. An attribute, size, or name case change without a time */ /* change is not merged (because there is no indication which */ /* way to copy). [except special case 8. below] */ /* */ /* 3. Filename comparisons are case-independent; target copy */ /* preserves case of source filename. */ /* */ /* 4. The archive bit is never explicitly changed, but is */ /* preserved on copy. */ /* */ /* 5. Newer file (and its attributes) always overrides the older */ /* file (even if the older file was read-only). */ /* */ /* 6. All errors (e.g., disk full, or file and directory of same */ /* name) halt processing. */ /* */ /* 7. Copies are not verified at present (too slow). */ /* */ /* 8. Size 0 (only) files are eliminated (i.e., erase request), */ /* (provided that their Archive bit is off, on Windows), */ /* except that a one-directional merge (mirror) only erases */ /* target (dir2) files. The files may have the same */ /* timestamp (just zeroed). */ /* */ /* 9. The clone operation will erase files in dir2 which are not */ /* in dir1. i.e., dir2 will be made a copy (clone) of dir1 */ /* (but only copying new files, for speed). */ /* */ /* 10. A clone will also replace files on the target if their */ /* size is different. */ /* */ /* 11. A clone will set flags on target files to match source */ /* files, provided that the target disk supports attributes. */ /* */ /* 12. If the first attempt to set attributes fails then it is */ /* assumed the target disk does not support attributes and */ /* all attributes sets are ignored. */ /* */ /* 13. Times allow 2-seconds slop, to allow for NT<-->Win9x */ /* conversions and related problems with FAT16 SD cards. */ /* */ /* --------------------------------------------------------------- */ mergedirs: signal on novalue signal on syntax parse arg dir1, dir2, subdirs, dmdepth, ways ., logfile, skiplist delim='\' parse upper source os . if left(os, 3)\='WIN' then delim='/' skiplist=translate(skiplist) -- uppercase for caseless compare later mindirlen=min(length(dir1), length(dir2)) if delim='/' then need=2; else need=4 if mindirlen dir2); 1=two-way (clone must be 0) select when ways=0 then clone=1 when ways=1 then bidi=0 when ways=2 then bidi=1 when ways=3 then do; clone=1; safer=1; end when ways='' then bidi=1 otherwise call msg '*** mergedirs Arg5 must be 0, 1, or 2 ways, not:' ways return -1 end if \datatype(dmdepth, 'n') then dmdepth=0 -- next two are used so attribute setting error only reported once firstattrib=1 /* first attempt to set attributes */ hasattributes=1 /* assume target disk has attributes */ -- if bidi then op='<-->'; else if clone then op='==>'; else op='-->' -- say '>>' dir1 op dir2 '['subdirs dmdepth ':' bidi clone']' rc=mergedir(dir1, dir2, subdirs, dmdepth, bidi, clone, safer) return rc /* --------------------------------------------------------------- */ /* mergedir -- as mergedirs, called recursively */ /* Arg1 to Arg4 are as mergedirs */ /* Arg5 is 1 for bidirectional merge (arg6=0) */ /* Arg6 is 1 for clone dir2 from dir1 (arg5=0) */ /* Arg7 is 1 for safer clone (arg6=1) */ /* --------------------------------------------------------------- */ -- dmdepth and bidi have been checked by caller mergedir: procedure expose logfile delim skiplist firstattrib hasattributes parse arg dir1, dir2, subdirs, dmdepth, bidi, clone, safer -- skip if either directory name is in skiplist p=lastpos(delim, dir1) if p=0 then dname=dir1 else dname=substr(dir1, p+1) if wordpos(translate(dname), skiplist)>0 then return 0 p=lastpos(delim, dir2) if p=0 then dname=dir2 else dname=substr(dir2, p+1) if wordpos(translate(dname), skiplist)>0 then return 0 -- say '..' dir1 '>' dir2 '>' subdirs dmdepth bidi clone dmdepth=dmdepth+1 pad=copies(' ', dmdepth-1) pad='' /* prepare 'merging' message */ if bidi then pendmerge=pad'Merging' dir1 'with' dir2 else if clone then pendmerge=pad'Cloning' dir1 'to' dir2 else pendmerge=pad'Mirroring' dir1 'to' dir2 /* if right(dir1, 4)='docs' then trace r */ if stream(dir1, 'c', 'query size')=='' then do call createdir dir1, pad if result\=0 then return result end if stream(dir2, 'c', 'query size')=='' then do call createdir dir2, pad if result\=0 then return result end /* Note that sysfiletree flags differ by OS */ opts='BL' call sysfiletree dir1||delim'*', 'LIST1', opts if result\=0 then return result files1=list1.0 call sysfiletree dir2||delim'*', 'LIST2', opts if result\=0 then return result files2=list2.0 dirs=0 dirlist1.='' dirlist2.='' byname1.='' do f=1 to files1 parse var list1.f . . . . fullname lp=lastpos(delim, fullname) if lp=0 then call msg '?1? no' delim 'in name:' fullname '['list1.f']' else name=substr(fullname, lp+1) uname=translate(name) name1.f=name uname1.f=uname byname1.uname=list1.f end byname2.='' do f=1 to files2 parse var list2.f . . . . fullname lp=lastpos(delim, fullname) if lp=0 then do -- to help find weird bug ff=f-1 if ff>0 then say '?>> previous line:' ff ':' list2.ff end if lp=0 then do -- sysFileTree disaster... call msg '** sysFileTree problem: no' delim 'in name:' fullname '['list2.f']' return 1 end else name=substr(fullname, lp+1) uname=translate(name) name2.f=name uname2.f=uname byname2.uname=list2.f end /* First any on 2 but not on 1 erase from 2 if cloning */ -- [do this first, unless safer set, to clear as much space as -- we can on target] if clone & \safer then do call clonedelete -- not a procedure if result\=0 then return result end /* Merge from 1 to 2 [including handling any files in both] */ -- this is always done do f=1 to files1 name1=name1.f uname=uname1.f file2=byname2.uname /* handle directories */ parse var list1.f date1 time1 size1 flags1 . isdir1=pos('D',flags1)=2 | pos('d', flags1)=1 /* is directory */ if isdir1 then do sub=dir2||delim||name1 dirs=dirs+1; dirlist1.dirs=dir1||delim||name1; dirlist2.dirs=sub if file2='' then do if wordpos(uname, skiplist)=0 then do call createdir sub, pad if result\=0 then return result end iterate end /* name matched .. drop through for checks */ end /* Set copy: 1 = 1->2, 0=no copy, -1 = 2->1 */ if file2='' then do copy=1 flags2='-----' name2=name1 end else do /* need to compare timestamps */ parse var file2 date2 time2 size2 flags2 fullname lp=lastpos(delim, fullname) name2=substr(fullname, lp+1) if name2\=name1 then if clone then do fullname=strip(fullname) 'rename "'fullname'" "'name1'"' if rc=0 then call msg pad' Renamed: "'fullname'" to "'name1'"' else call msg pad'** Could not rename '''fullname''' [rc='rc']' end if date1\=date2 then /* date mismatch */ do if date1>date2 then copy=1 else copy=-1 end else do /* date unchanged */ if time1==time2 then copy=0 /* time not changed */ else do /* Allow 2 seconds slop, for NT<-->Win95 conversions */ /* [Occasionally midnighters will over-copy] */ parse var time1 h1':'m1':'s1 parse var time2 h2':'m2':'s2 secs1=h1*3600+m1*60+s1 secs2=h2*3600+m2*60+s2 delta=secs1-secs2 if delta > 2 then copy=1 else if delta < -2 then copy=-1 else copy=0 /* close enough */ end /* could be size changed but not timestamp (zero.rex) */ if copy=0 then do /* 'same' time */ /* check for erasure, anything else with same time is not merged unless clone and size differs */ if delim='/' then do -- for *ix ignore attributes isAs1='-' isAs2='-' end else do parse var flags1 isAs1 +1 parse var flags2 isAs2 +1 end parse var flags1 +1 f1 /* drop A */ parse var flags2 +1 f2 if size1=0 & isAs1='-' then copy=1 /* erase file1->file2 */ else if size2=0 & isAs2='-' then copy=-1 /* erase file2->file1 */ else if clone & size1\=size2 then copy=1 /* clone 1->2 */ else if clone & f1\=f2 & hasattributes then do set='' do i=1 to 4 parse var f1 att1 +1 f1 parse var f2 att2 +1 f2 if att1\=att2 then do if att1='-' then set=set '-'att2 else set=set '+'att1 end end i fullname=strip(fullname) 'attrib +A' set '"'fullname'" | rxqueue' arc=rc denied=0 do i=1 to queued() parse pull ret -- say '==>' ret if left(ret, 14)='Access denied' then denied=1 end i if denied|arc\=0 then if firstattrib then do hasattributes=0 -- assume no disk support firstattrib=0 iterate f -- ignore the error end if arc=0 then do if firstattrib then do /* first try; see if worked */ firstattrib=0 call sysfiletree fullname, 'LIST', 'BL' if list.0=1 then do parse var list.1 . . . flags . if flags\='A'substr(flags1, 2) then hasattributes=0 end else hasattributes=0 /* say 'HasAtts='hasattributes */ end if hasattributes then call msg pad' Flagged: "'fullname'" to' flags1 end else call msg pad'** Could not attrib '''fullname''' [rc='arc']' iterate f /* copy remains 0 */ end else do if size1\=size2 then do /* sanity check sizes */ say 'Size?' list1.f say ' ..' file2 end if f1\=f2 & hasattributes then do /* sanity check flags */ -- say 'Flag?' list1.f /* cannot be fixed */ -- say ' ..' file2 end iterate f /* copy remains 0 */ end end end /* here only if action to do (copy=1 or copy=-1) */ /* Carry out Directory check */ isdir2=pos('D',flags2)=2 | pos('d', flags2)=1 /* is directory */ if isdir1\=isdir2 then do call msg '*** Directory/file mismatch:' list1.f call msg '* [Directory and file have same name: IsDir1='isdir1', IsDir2='isdir2']' return -1 end if isdir2 then iterate /* cannot update directory timestamp */ end if copy=1 then do source=dir1 sname=name1 target=dir2 tname=name2 sflags=flags1 tflags=flags2 end else /* is -1 */ do if \bidi then iterate -- skip dir2 -> dir1 copies source=dir2 sname=name2 target=dir1 tname=name1 sflags=flags2 tflags=flags1 end call action source, sname, sflags, target, tname, tflags, pad, bidi if result\=0 then return result end f /* Now any on 2 but not on 1 copy -> 1 if bidi */ if bidi then -- provided bidi... do f=1 to files2 name=name2.f uname=uname2.f file1=byname1.uname if file1='' then do parse var list2.f . . . flags2 . isdir2=pos('D',flags2)=2 | pos('d', flags2)=1 /* is directory */ if isdir2 then do sub=dir1||delim||name dirs=dirs+1; dirlist1.dirs=sub; dirlist2.dirs=dir2||delim||name if wordpos(uname, skiplist)=0 then do call createdir sub, pad if result\=0 then return result end iterate f end source=dir2 target=dir1 call action source, name, flags2, target, name, '-----', pad, bidi if result\=0 then return result end end f /* Next any on 2 but not on 1 erase from 2 if cloning */ -- [unless safer is set we did this earlier, to clear as much space -- as we could on target] if clone & safer then do call clonedelete -- not a procedure if result\=0 then return result end if \subdirs then return 0 do d=1 to dirs call mergedir dirlist1.d, dirlist2.d, 1, dmdepth, bidi, clone, safer if result\=0 then return result end d return 0 /* --------------------------------------------------------------- */ /* Macro to delete files in dir2 that are not in dir1 */ /* Used when cloning, either before or after creating new files */ /* --------------------------------------------------------------- */ clonedelete: -- not a procedure -- say 'clonedelete...' do f=1 to files2 name=name2.f uname=uname2.f file1=byname1.uname if file1='' then do if pendmerge\='' then do; call msg pendmerge; pendmerge=''; end full=dir2||delim||name parse var list2.f . . . flags2 . isdir2=pos('D',flags2)=2 | pos('d', flags2)=1 /* is directory */ if isdir2 then do rc=deldir(full, pad' ') if rc\=0 then return rc call msg pad'[Removed "'full'" and any content]' iterate f end -- can remove 'read-only' and 'hidden' here; others may need manual if pos('H', flags2)>0 then 'attrib -H "'full'"' if pos('R', flags2)>0 then 'attrib -R "'full'"' rc=sysfiledelete(full) if rc\=0 then do call msg pad'** Could not delete '''full''' [rc='rc']' flags2 return rc end else call msg pad' Erased: "'name'" in "'dir2'"' end end f return 0 /* --------------------------------------------------------------- */ /* action -- do a copy, erase, etc., detecting any errors */ /* Arg1 is source directory */ /* Arg2 is source filename */ /* Arg3 is source flags */ /* Arg4 is target directory */ /* Arg5 is target filename */ /* Arg6 is target flags */ /* Arg7 is padding for messages */ /* Arg8 is 1 for two-directional merge/delete */ /* returns 0 if OK, 1 if error */ /* */ /* The copy is made, and flags are set to match source */ /* If case has changed, name is modified too */ /* Pendmerge is displayed, if needed, before carrying out action */ /* --------------------------------------------------------------- */ action: procedure expose pendmerge logfile delim parse arg sdir, sname, sflags, tdir, tname, tflags, pad, bidi source=sdir||delim||sname target=tdir||delim||tname parse var sflags isAs +1 if delim='/' then isAs='-' -- say '>>' sdir '!' sname sflags '>>' tdir '!' tname tflags /* 1999.09.18 Check for zeroed file first (as NT doesn't report copy 0-length file as an error) */ /* If source file is size 0, eliminate it and target; not an error */ /* 2004.10.03 if just mirror, delete on target but not source */ /* 2004.10.09 archive bit must be off for a 'real' erase request */ /* 2006.12.23 target Read-only bit is ignored */ if stream(source, 'c', 'query size')=0 then if isAs='-' then do havetarget=stream(target, 'c', 'query size')\='' if havetarget then do -- Use Sysfiletree side-effect to clear attributes, which is -- vastly faster than using commands (see zero.rex) -- [on *ix there is no read-only attribute, etc., so not needed] if delim='\' then call sysfiletree target, 'LIST', 'FL',, '-----' end if bidi then do if pendmerge\='' then do; call msg pendmerge; pendmerge=''; end rc=sysfiledelete(source) if rc\=0 then do call msg pad'** Could not delete '''source''' [rc='rc'] a' return 1 end add='' if havetarget then do rc=sysfiledelete(target) if rc\=0 then do call msg pad'** Could not delete '''target''' [rc='rc'] b' return 1 end add=' in both' end call msg pad' Erased: "'sname'"'add end else do -- mirror erase only if target exists if havetarget then do if pendmerge\='' then do; call msg pendmerge; pendmerge=''; end rc=sysfiledelete(target) if rc\=0 then do call msg pad'** Could not delete '''target''' [rc='rc'] c' return 1 end call msg pad' Erased: "'sname'" in "'tdir'"' end end return 0 end /* File copy coming up... */ if pendmerge\='' then do; call msg pendmerge; pendmerge=''; end -- trace r call checksize source, sname, pad -- hint of biggie if delim='/' then do -- *ix 'cp -a -f "'source'" "'target'"' if rc\=0 then do call msg '*** Could not copy "'source'" to "'target'"' return 1 end end else do -- Windows xopts='/k /y /h /r ' -- add /V for verify 'xcopy' xopts '"'source'" "'tdir'\"' '| rxqueue' xrc=rc do i=1 to queued() parse pull copyret -- say '==>' copyret parse var copyret count . end i if count\=1 | xrc\=0 then /* error */ do /* Error: restore target flags and return error */ if xrc=0 then add='' else add=' [xcopy rc='xrc']' call msg '*** Could not copy "'source'" to "'target'"'add return 1 end end /* Copied OK */ call msg pad' Copied: "'sname'" to "'tdir'"' /* Set target spelling, if needed */ if delim='\' then if sname\==tname then 'rename' '"'target'"' '"'sname'"' return 0 /* ------------------------------------------------------------------ */ /* checksize -- check large file start and msg if a biggie */ /* ------------------------------------------------------------------ */ checksize: procedure expose logfile delim parse arg name, shortname, pad size=stream(name, 'c', 'query size') if size<50*1024*1024 then return mb=format(size/1024**2,,0) call msg pad' Copy: "'shortname'" ['mb 'MB] ...' return /* ------------------------------------------------------------------ */ /* deldir -- delete directory and all contents, recursively */ /* Arg1 is fully qualified directory name to delete [no trailing */ /* delimiter] */ /* Arg2 is padding to prefix to displayed messages */ /* returns 0 if OK, non-zero otherwise */ /* 2006.05.28 -- added to work around remote disk timing problems */ /* ------------------------------------------------------------------ */ -- also used in deltree2.rex deldir: procedure expose logfile delim parse arg dir, pad opts='BL' -- not subdirs call sysfiletree dir||delim'*', 'LIST', opts if result\=0 then return result files=list.0 /* Delete all content files and directories */ do f=1 to files parse var list.f date time size flags fullname isdir=pos('D',flags)=2 | pos('d', flags)=1 -- is directory fullname=strip(fullname) if isdir then do rc=deldir(fullname, pad) if rc\=0 then return rc iterate end -- can remove 'read-only' and 'hidden' here; others may need manual if pos('H', flags)>0 then 'attrib -H "'fullname'"' if pos('R', flags)>0 then 'attrib -R "'fullname'"' rc=SysFileDelete(fullname) if rc\=0 then do call msg pad'** Could not delete '''fullname''' [rc='rc'] d' return rc end say pad' Erased:' fullname end f rc=SysRmDir(dir) if rc\=0 then do call msg pad '** Could not remove '''dir''' [rc='rc']' return rc end say pad'Removed:' dir return 0 /* ------------------------------------------------------------------ */ /* createdir -- create a directory (and parents as needed) */ /* Arg1 is fully qualified directory specification */ /* Arg2 is padding for message */ /* returns 0 if OK, 1 if error */ /* */ /* 1999.09.18 -- sometimes query size gives spurious null answer */ /* for a network directory on NT, so inhibit error */ /* messages */ /* 2004.05.21 -- allow multiple-level create */ /* 2004.10.08 -- check disk exists */ /* ------------------------------------------------------------------ */ createdir: procedure expose logfile delim parse source os . if os='WindowsNT' then redir='2>nul'; else redir='' here=directory() if delim='\' then do parse arg disk':\'path, pad place=disk':\' end else do parse arg '/'path, pad disk='?' place='/' end call directory place -- cannot fail if *ix if result='' then do call msg '*** No '''disk':'' disk, so cannot create "'arg(1)'"' return 1 end rc=0 do while path\='' parse var path next (delim) path -- say '::'next place=place||next if stream(place, 'c', 'query size')=='' then do -- need MKDIR -- mkdir "-a-" complains of invalid option, so use ".\___" 'mkdir ".\'next'"' -- redir if rc\=0 then do call msg '*** Cannot create "'arg(1)'", next: '''next'''' leave end call msg pad'[Created "'place'"]' end call directory place place=place||delim end call directory here return rc\=0 /* --------------------------------------------------------------- */ /* Display and/or log message */ /* Messages starting with '*' are always displayed, even if other */ /* messages are only being logged. */ /* --------------------------------------------------------------- */ msg: procedure expose logfile parse arg out nopad=strip(out) error=(pos('*', nopad)=1) parse var logfile flag +1 file if flag\='+' then file=logfile if file='' | flag='+' | error then say out if file\='' then do call lineout file, out call lineout file end return /* --------------------------------------------------------------- */ /* Error handlers */ /* --------------------------------------------------------------- */ syntax: say 'Rexx error' rc 'on line' sigl':' space(sourceline(sigl)) say errortext(rc) exit -1 novalue: say 'Variable' condition('D') 'raised NOVALUE at line' sigl':' say ' *-*' space(sourceline(sigl)) exit -1