/* This is CommandPak's xren command. */
/* (w) 1997-98 Ulrich M”ller */
'@echo off'
/* to do: SIMPLE_BACKUP_SUFFIX env var
"-S" for suffix setting */
call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
call SysLoadFuncs
/* The following messages have not yet been moved into XHELPxxx.MSG and will thus
always be displayed in English. Language support might be added in a later release. */
nl = '0d0a'x
err = 'Error in xren: '
errhlp = 'Type xren -h for help.'
nofilesMsg = err||'File(s) not found. '||errhlp
unknownoptionMsg = err||'Unknown option (-%a). '||errhlp
errorMsg1 = err||'Using these options is not allowed with two file specifications. '||errhlp
errorMsg2 = err||'You must give two file specifications here. '||errhlp
errorMsgFiles = err||'You have not specified any files. '||errhlp
errorMsgTest = err||'The "test" option must be used with other options. '||errhlp
errorMsgForce = err||'The "force" option can only be used when moving files. '||errhlp
errorMsgInteractive = err||'The "interactive" option can presently not be used with the options you have specified. '||errhlp
invwcMsg = err||'Invalid wildcard usage. '||errhlp
checkingMsg = "Checking" /* argument will be added automatically */
procMsg = "Processing" /* argument will be added automatically */
replacedMsg = ' Replaced invalid characters in .LONGNAME:'
longDelMsg = " .LONGNAME for %a deleted (contained %b)"
skipMsg = ' Skipped deleting .LONGNAME; contains important characters'
inuseMsg = " Could not remove .LONGNAME for %a; file seems to be in use"
backedupMsg = " Backed up %a to %b"
renameMsg = " Renaming %a to %b"
moveMsg = " Moving %a to %b"
replaceMsg = " %a exists."nl" (R)eplace (B)ackup original (S)kip replace_(A)ll? "
interactMsg = " Is this OK? (Y)es (N)o (A)ll "
dontWorryMsg = "Don't worry, this was test mode only. Nothing was modified."
interruptMsg = "xren was interrupted externally."
invalidChars = '\/:*?"<>|,+=[];'
signal on halt; trace off
parse arg args
alwaysReplace = 0
old. = ""
new. = ""
deletelong = 0
realtolong = 0
tolower = 0
toupper = 0
verbose = 0
quiet = 0
test = 0
debug = 0
movealso = 0
force = 0
interactive = 0
backup = 0
FAT = 0
/* first process arguments/options */
do while (args \= "")
parse value args with opt1 args
if debug then Say " Parsing" opt1
if (substr(opt1, 1, 1)="-") | (substr(opt1, 1, 1)="/") then do
do optcount = 2 to length(opt1) by 1
optchar = substr(opt1, optcount, 1)
if debug then Say " Subparsing" optchar
select
when (optchar="D") then do
Say "Debug messages turned on."
debug = 1
verbose = 1
test = 1
end
when (optchar="d") then
deletelong = 1
when (optchar="r") then
realtolong = 1
when (optchar="t") then do
test = 1
verbose = 1
end
when (optchar="8") then
FAT = 1
when (optchar="b") then do
backup = 1
interactive = 0
force = 0
end
when (optchar="f") then do
force = 1
interactive = 0
backup = 0
end
when (optchar="i") then do
interactive = 1
force=0
end
when (optchar="L") then do
tolower = 1
toupper = 0
realtolong = 0
end
when (optchar="U") then do
toupper = 1
tolower = 0
realtolong = 0
end
when (optchar="v") then do
verbose = 1
quiet = 0
end
when (optchar="q") then do
quiet = 1
verbose = 0
end
when (optchar="h") | (optchar = "?") then do
'call xhelp xren'
exit
end
when (optchar="x") then do
'call xhelp _xrenexpl'
exit
end
otherwise do
'call xhelp "'strReplace(unknownoptionMsg, "%a", optchar)'"'
exit
end
end /* select */
end /* do */
end /* if */
else
if old.complete = "" then
old.complete = opt1
else new.complete = opt1
end /* do while */
if (old.complete = "") then do
'call xhelp "'errorMsgFiles'"'
exit
end
/* now collect files */
if debug then
say "Collecting files"
files.0 = 0
curdir = directory()
if (directory(old.complete) \= "") then do
files.1 = old.complete
files.0 = 1
end
else if (old.complete = "..") then do
files.1 = ".."
files.0 = 1 /* these are funny bugs in SysFileTree */
end
else do
rc = SysFileTree(old.complete, files, "FO", '*--*-')
/* Attribs: 'ADHRS' */
if debug then Say " "files.0 "file(s) found"
if files.0 = 0 then do
'call xhelp "'nofilesMsg'"'
exit
end
end
call directory(curdir)
renMode = 0
moveMode = 0
extMode = 0
wildcards = 0
if (realtolong) | (tolower) | (toupper) then do
extMode = 1
if (interactive) then
call xhelp '"'errorMsgInteractive'"'
end
do
if debug then say "Entering mode analysis for old.spec"
old.path = filespec('drive', old.complete)||filespec('path', old.complete)
old.spec = filespec('name', old.complete)
if debug then do
say ' old.path: "'old.path'"'
say ' old.spec: "'old.spec'"'
end
end
if (new.complete \= "") then do
/* second spec given: seems to be rename/move mode. */
if debug then say "Entering mode analysis for newspec"
if (new.complete \= "\") & (substr(new.complete, 2) \= ":\") & (right(new.complete, 1) = "\") then new.complete = strip(new.complete, 't', '\')
curdir = directory()
if (directory(new.complete) \= "") then do
/* second spec is dir only --> just move, no rename */
moveMode = 1
new.path = new.complete
renMode = 0
new.spec = ""
end
else do
new.path = filespec('drive', new.complete)||filespec('path', new.complete)
new.spec = filespec('name', new.complete)
if (new.path \= "") then do
moveMode = 1
if (new.path \= "\") & (substr(new.path, 2) \= ":\") & (right(new.path, 1) = "\") then new.path = strip(new.path, 't', '\')
end
if (new.spec \= "") then do
renMode = 1
end
/* second spec is */
end
call directory curdir
if debug then do
if renMode then say " -> Rename mode enabled; renaming to" new.spec
if moveMode then say " -> Move mode enabled; moving to" new.path
if extMode then say " -> Extended mode enabled"
end
if extMode then do
'call xhelp "'errorMsg1'"'
exit
end
end
else
if (\FAT & \extMode & \deleteLong)then do
'call xhelp "'errorMsg2'"'
exit
end
if renMode then do
/* now evaluate wildcards */
if (pos('*', new.spec) \= 0) | (pos('?', new.spec) \= 0) then do
wildcards = 1
if debug then say "Evaluating wildcards"
old.wild.pos = pos('*', old.spec)
new.wild.pos = pos('*', new.spec)
if (old.wild.pos = 1) then
if (pos('*', substr(old.spec, old.wild.pos+1)) > 0) then call invwc
else if (new.wild.pos = 1) then
if (pos('*', substr(new.spec, new.wild.pos+1)) > 0) then call invwc
else do
old.wild.sub = translate(substr(old.spec, old.wild.pos+1))
new.wild.sub = substr(new.spec, new.wild.pos+1)
end
else call invwc
else if (old.wild.pos = length(old.spec)) then
if (new.wild.pos = length(new.spec)) then do
old.wild.sub = translate(substr(old.spec, 1, old.wild.pos-1))
new.wild.sub = substr(new.spec, 1, new.wild.pos-1)
end
else call invwc
else call invwc
if debug then do
say ' old.wild.sub: "'old.wild.sub'"'
say ' new.wild.sub: "'new.wild.sub'"'
end
end /* wildcards */
end
/* now work on file list */
if debug then say "Entering file processing"nl
do i = 1 to files.0
oldName = files.i
oldnameonly = filespec('name', oldname)
if (realtolong) then do
rc = SysGetEA(oldname, ".LONGNAME", "longname_")
longname = substr(longname_, 5)
end /* this needs to be preserved since deletelong might delete it */
if (deleteLong) then
call deleteLongname oldname
/* check which mode we're in */
select
when (moveMode) then do /* move */
/* first compose new name */
if renMode then
newNameOnly = getNewName(oldname)
else
newNameOnly = filespec('name', oldname)
if (FAT) then
newNameOnly = makeFAT(newNameOnly)
if (right(new.path, 1) \= "\") then
moveTo = new.path||'\'
else moveTo = new.path
newName = moveTo||newNameOnly
/* now check if moving is allowed; confirm if neccessary */
moveOK = 1
if (verbose | interactive) then
say strReplace(strReplace(moveMsg, '%a', oldname), '%b', newname)
else if (\quiet) then say oldname
if (stream(newName,'c','query exist') \= "") then do
if (force) then
'del' newName
else if (backup) then
call backupFile newName
else do
resp = queryExists(strReplace(replaceMsg, '%a', newName))
if (resp = "R") then
'del' newName
else if (resp = "B") then
call backupFile newName
else
moveOK = 0
end
end
else
if (interactive) then
moveOK = (queryYN(interactMsg))
/* finally, move file */
if (moveOK) then
if (\test) then do
'copy' oldname newname ">NUL"
'if exist' newname 'del' oldname '/N'
end
else if debug then do
Say ' -- copy' oldname newname
Say ' -- del' oldname
end
end
when renMode then do
/* rename only */
newNameOnly = getNewName(files.i)
if (FAT) then
newNameOnly = makeFAT(newNameOnly)
call renameFile oldname newNameOnly
end
when (tolower) | (toupper) then do
/* rename to lower or upper case */
if (tolower) then
newNameOnly = lowercase(oldNameOnly)
else
newNameOnly = translate(oldNameOnly)
if (FAT) then
newNameOnly = makeFAT(oldNameOnly)
call renameFile oldname newNameOnly
end
when (FAT) then do
/* rename to FAT format (8+3) */
newNameOnly = makeFAT(oldNameOnly)
call renameFile oldname newNameOnly
end
when (realtolong) then do
/* change name to .LONGNAME */
if (longname_ \= "") & (longname \= oldNameOnly) & (pos('"',longname) = 0) then do
newnameOnly = longname
if (FAT) then newNameOnly = makeFAT(oldNameOnly)
/* now replace invalid characters that may be in .LONGNAME */
if invalidName(longname) then
do i2 = 1 to length(invalidChars)
newNameOnly = translate(newNameOnly, '!', substr(invalidChars, i2, 1))
end
call renameFile oldname newNameOnly
end
end
otherwise ;
end /* select */
end /* do files.i */
if (test) then say dontWorryMsg
exit
getNewName:
_oldname = arg(1)
if (wildcards) then
_newname = strReplace(filespec('name', _oldname), old.wild.sub, new.wild.sub)
else
_newname = new.spec
return _newName
makeFAT: procedure expose debug
_old = arg(1)
_p = pos(".", _old)
_p2 = _p
if _p2 > 8 then _p2=8
if (_p > 0) then do
_new = left(_old, _p2-1)||"."||substr(_old, _p+1, 3)
end
else _new = left(_old, 8)
if debug then
say " makeFAT:" _old "-->" _new
return _new
deleteLongname:
realname = arg(1)
rc = SysGetEA(realname, ".LONGNAME", "longname_")
longname = substr(longname_, 5)
if (longname \= "") then
if ((\invalidName(longname)) | force) then do
if \test then
call SysPutEA realname, ".LONGNAME", ""
if (\quiet) then do
rc = SysGetEA(realname, ".LONGNAME", "longname2")
if ((longname2 \= "") & \test & \quiet) then
Say strReplace(inuseMsg, '%a', realname)
else
if (\quiet) then
Say strReplace(strReplace(longDelMsg, '%b', longname), '%a', realname)
end
end
else
if \quiet then
Say skipMsg
return
renameFile:
if (deleteLong) then
call deleteLongname oldname
if (filespec("NAME", oldname) \= newNameOnly) then do
if (verbose | interactive) then
say strReplace(strReplace(renameMsg, '%a', oldname), '%b', newNameOnly)
else if (\quiet) then say oldname
renOK = \interactive
if (interactive) then
renOK = queryYN(interactMsg)
if (renOK) then
if (\test) then
'ren' oldname newNameOnly
else if debug then
Say ' -- ren' oldname newNameOnly
end
return
backupFile:
oldfile = arg(1)
oldfile2 = oldfile
ext = ""
p = lastpos(".", oldfile)
if (p > 0) then do
ext = substr(oldfile, p)
oldfile2 = left(oldfile, p-1)
end
p = lastpos("!", oldfile2)
if (p > 0) then do
if datatype(substr(oldfile2, p+1)) = "NUM" then do
bak = substr(oldfile2, p+1)+1
oldfile2 = left(oldfile2, p-1)
end
else bak = 1
end
else bak = 1
newfile = filespec('name', oldfile2)
if (FAT) then newfile = left(newfile, 8-length(bak)-1)
do while (stream(moveTo||newfile"!"bak||ext,'c','query exist') \= "")
bak = bak+1
if (FAT) then newfile = left(newfile, 8-length(bak)-1)
end
if (verbose) then say strReplace(strReplace(backedupMsg, '%b', newfile"!"bak||ext), '%a', oldfile)
'ren' oldfile newfile"!"bak||ext
return
strReplace:
parse arg str, old, new
p = pos(translate(old), translate(str))
if (p > 0) then
return left(str, p-1)||new||substr(str,p+length(old))
else
return str
invwc:
'call xhelp "'invwcMsg'"'
exit
lowercase:
return translate(arg(1), 'abcdefghijklmnopqrstuvwxyz', 'ABCDEFGHIJKLMNOPQRSTUVWXYZ')
invalidName:
invalid = 0
do i9 = 1 to length(longname)
if (pos(substr(longname, i9, 1), invalidChars) \= 0) then
invalid = 1
if invalid then leave
end
return invalid
queryYN:
if \alwaysReplace then do
call charout , arg(1)
key = ''
do until pos(key,"YNA") > 0
key = translate(SysGetKey("NOECHO"))
end /* do */
Say key
if (key = "A") then
alwaysReplace = 1
end
if (alwaysReplace) then key = "Y"
return (translate(key) = "Y")
queryExists:
if \alwaysReplace then do
call charout , arg(1)
key = ''
do until pos(key,"RBSA") > 0
key = translate(SysGetKey("NOECHO"))
end /* do */
Say key
if (key = "A") then
alwaysReplace = 1
end
if (alwaysReplace) then key = "R"
return key
halt:
"call xhelp -f abortMsg xren"
exit