jaq@tbi.UUCP (Jaq Reins) (06/18/91)
/* CPio in rexx. More than likely, this is not a complete replacement. I
hope it is close enough.
Copyright 1991 jaq reins. Non-commercial use allowed as long as I get the
blame.
*/
arg which .
/* open the Rexx support library */
if ~show('L',"rexxsupport.library") then do
if addlib('rexxsupport.library',0,-30,0) then
say 'added rexxsupport.library'
else do;
say 'support library not available'
exit 10
end
end
lcount = 1
options results
if (open(infile,which,"r") ~= 0) then do
/*call open(logfile,'logfile',"W") */
do while ~eof(infile)
inline = getline()
mode = substr(inline,22,3)
active = substr(inline,7,6)
type = oct2dec(substr(inline,19,2))
namesize=oct2dec(substr(inline,62,4))
name=right(inline,namesize-1)
filesize=oct2dec(substr(inline,66,11))
say lcount ":" name " - " mode " - " filesize
/* active should equal "000003" on all except the last one,
which is a trailer. Then it will equal "000000" */
if active ~="000000" then do
/* is a directory */
if type == 4 then do
if ~exists(name) then do
address command 'makedir 'name
end
end
/* is a file */
else if type == 8 then do
/* the file doesn't exist. all is safe */
if ~exists(name) then do
call open(outfile,name,"W")
/* file is small enough to do at one shot */
if filesize < 200000 then do
chunk=readch(infile,filesize)
call writech(outfile,chunk)
end
else
/* file won't all fit in memory. have to loop
SLOWLY over the file. ARRGGHH!!!*/
do loopcount=1 to filesize
chunk=readch(infile)
call writech(outfile,chunk)
end
call close(outfile)
end
else do
/* the file name exists. The whole reason for this mess
is that under UN*X, a file named FooBar is distinct
from one named foobar (or any other variation on that)
while under AmigaDOS, they are all the same file. So
we have to play with the file name and call it something
like foobar_1. */
name=newname(name)
call open(outfile,name,"W")
/* again, the file will fit. These hardwired numbers SHOULD
be up at the top, so they can be changed. Oy Vey! */
if filesize < 200000 then do
chunk=readch(infile,filesize)
call writech(outfile,chunk)
end
else
/* file to big. I tried to make these a seperate function,
but this bloody thing kept croaking. Dont ask why, I
dont remember! */
do loopcount=1 to filesize
chunk=readch(infile,200000)
call writech(outfile)
end
call close(outfile)
end
end
/* dont know what it is, die */
else do
say "type not 4(dir) or 8(file)" type
exit
end
end
lcount = lcount + 1
end
end
exit
/* Since the line can end either with a <nl>'0A'x or a <nul>'00'x, we
have to be ready for both. readln ONLY ends at the <nl>, not at the
<nul>. Hence the replacement. Only used to get the header line. */
getline: procedure expose infile
inln = ''
inchr = ''
do while (inchr ~= '00'X && inchr ~= '0A'x && ~eof(infile))
inln = inln || inchr
inchr = readch(infile)
end
return inln
/* convert the input variable from base 8 to base 10. */
oct2dec: procedure
arg octalstring
dec=0
len = length(octalstring)
do ptr=1 to len
chr = substr(octalstring,ptr,1)
dec = dec * 8 + (c2d(chr)-48)
end
return dec
/* Here we have to do the filename playing that was mentioned above.*/
newname: procedure
arg oldname
cont = 1
counter = 1
nam = ''
do while (cont)
nam = oldname"_"counter
counter = counter + 1
cont = exists(nam)
end
return nam
--
UUCP: tcnet!hawkmoon!tbi!jaq No warranty expressed, implied,
uunet!atc!cimcor!tbi!jaq or even brought up in mixed
{tcnet, crash}!orbit!pnet51!jaq company.