Amiga ISO Collection/AmigaUtilCD1.iso/Archiver/repck33.lha/Repack.rexx.BBS

File List | 1995-12-01 | 15.5 KB | 643 lines

/*             Welcome, dumper!
LHA-LZX V1.0-2.0 by Mat Bettinson of the Plot Hatching Factory '95
LHA-LZX V3.0 and above by Andrea Vallinotto.

$VER: LZX Repacker V 3.3_C-net, by Andrea Vallinotto (5.10.95)
© 1995 Nathan Johnes Software lavatories :->

************ SPECIAL BBS VERSION FOR C-Net and other BBS systems **************

Since Jonathan Forbes' brilliant LZX came along and promptly blew LHA away,
there's a need for a bulk converter. This is such a device.

You can execute this script with the following parameters: destination
directory (any valid path name), temp directory (as above), efficiency
(either 1, 2 or 3), BBS mode ('on' or any other string for 'off').
If you wish, you can change the value of the LZX merging-group in the
beginning of the program (see below!).

C-Net suggested string:
'rx repack.rexx <source-file-name> <temp-dir> 3 ON'
On C-Net repack is useful if used in the 'transform' operation that occours just
after the upload of a file (after the test). Keep in mind that no matter which
format the file is, after the repacking you'll have a LZX archive.

BEWARE: the temp dir must be large enough to accommodate the largest extracted
archive you're converting (including sub-archives, if present!).

You'll need:
in your search path: for lha and lzh archives either Lha, Lhx or LZX registered;
             for tar archives either Tar, Gnutar or Detar,
             and unzip, unarj, unrar, hpack, shrink, xarc, zoo, arc,
             gzip, LZX, Delete, Assign, Setdate, Filenote and Which.

Since this version, LZX version 1.21 or above is REQUIRED!

You can change the following value to suit you needs! It's the maximum group
size that LZX can create. */

groupsize=2900

/* Don't modify nothing below this line: spaghetti code lies behind...
        DON'T SAY YOU'VE NOT BEEN WARNED!!
(But what kind of code would you expect from an Italian, anyway ? :-)) ) */

options results
options failat 9
signal on break_c
signal on halt

verstring='LZX Repacker version 3.3_C-Net'
parse var verstring jf utilname blah ver .
titlestring=left(utilname,6) ver
copyleft='by Andrea Vallinotto of Nowhere software'
lstring="#?.(LZH|LHA|ZIP|ARJ|RAR|SHR|XAR|HPK|ARC|ZOO|PAK|TAR|GZ|Z|TGZ)"
logname='t:Repack.log'
anofile='s:repack.ano'
cr='0a'x
bold='1b'x'[1m'
normal='1b'x'[0m'
under='1b'x'[4m'

setuplib("rexxsupport.library",0,-30,0)
parse source . . . scriptname . .
if ~exists(scriptname) then signal badinstall
call checklzx

parse arg instring

hmq=length(instring)-length(compress(instring,'"'))
select
    when hmq // 2 then signal baddata
    when hmq=0 then do
            parse var instring Dir root mode bbsmode quiet .
            signal init
            end
    otherwise nop
end

a=0
loop:
instring=strip(instring,L)
a=a+1
select
    when left(instring,1)='"' then do
                parse var instring '"' foo.a '"' instring
                signal loop
                end
    when left(instring,1)="" then do
                foo.0=a-1
                signal complete
                end
    otherwise         do
                parse var instring foo.a instring
                signal loop
                end
end
complete:
if foo.0>0 then dir= foo.1
        else dir=''
if foo.0>1 then root= foo.2
        else root=''
if foo.0>2 then mode= foo.3
        else mode=''
if foo.0>3 then bbsmode= foo.4
        else bbsmode=''
if foo.0>4 then quiet= foo.5
        else quiet=''
init:
bbsmode=upper(bbsmode)
if lzxreg then maxeff=9
        else maxeff=3
if (mode > maxeff | mode < 0) then signal baddata

if quiet ='' then     do
            say;say ' *** LHA-LZX repacker 1.0-2.0 by Mat Bettinson of the Plot Hatching Factory ***'
            say '  *** 'verstring copyleft '***';say
            end

oldstack=Pragma('S',50000)
If right(root,1) ~= '/' & right(root,1) ~= ':' then root = root'/'

/* this procedure must be left even in SFM because it could be called while
recursing on a single file (on dir/RTD) */
bestia=whatis(dir)
select
    when bestia='' then signal baddata
    when bestia='FILE' then sfm(dir)
    otherwise sfm=0
end
call initlog('on directory' dir)
If right(Dir,1) ~= '/' & right(Dir,1) ~= ':' then Dir = Dir'/'
if ~(length(root)-length(compress(root,':'))) then root=pragma(d)'/'root
tempdir=root'RTD'
mkdir(tempdir)
if ~(length(dir)-length(compress(dir,':'))) then
                        if right(pragma(d),1)=':' then dir=pragma(d)dir
                                    else dir=pragma(d)'/'dir
                        else
                        if dir=':' then dir=pragma(d)
if bbsmode='ON' then do
            Address COMMAND 'List 'quote(dir)' P 'lstring' DATES TO 'quote(root'lha-lzx_infos.temp')' FILES LFORMAT "%d %t %c"'
            Call Open(infos,root'lha-lzx_infos.temp','R')
            end
if exists(quiet'recursive_LZX_repack.temp') then    Call Open(list,quiet'recursive_LZX_repack.temp','R')
                            else do
                            Address COMMAND "List "quote(Dir)" P "lstring" TO "quote(root'LHA-LZX.temp')" FILES LFORMAT %n"
                            Call Open(list,root'LHA-LZX.temp','R')
                            end
Call Pragma('D',tempdir)
call Writelogoptions

/* Mainloop */
BSave = 0
mainloop:
call initano
DO forever
    File = ReadLN(list)
    IF EOF(list) then break
    if bbsmode='ON' then do
                mix = ReadLN(infos)
                Datetime = subword(mix,1,2)
                Comment = quote(subword(mix,3))
            end
    NewFile = Left(File,lastpos('.',file))'LZX'
    say 'Converting file: 'File
    Midcleanup()
    Lhasize=Size(Dir||File)
    signal on failure
    WriteLog('Trying to extract' file)
    arctype=extract(Dir||File)
    signal off failure
    if arctype="???" then do
                Say "Cannot determine arc type... skipping!"
                WriteLog("Couldn't determine arc type of" File '...skipped!')
                iterate
                end
    WriteLog('File' file 'extracted OK. Repacking...')
    Address COMMAND 'List PAT 'lstring' FILES ALL LFORMAT %p%n >'quote(root'recursive_LZX_repack.temp')
    if size(root'recursive_LZX_repack.temp') ~= 0 then do
                            WriteLog('Started recursion for file' file)
                            Close(log)
                            Address REXX scriptname quote(tempdir) quote(tempdir) mode bbsmode quote(root)
                            Call Open(log,logname,'A')
                            end
    Call fano
    old=pragma(d,tempdir)
    signal on failure
    if lzxreg then lzxmode=mode' -Qf'
            else lzxmode=mode
    Address COMMAND 'LZX -r -e -a -M'groupsize' -'lzxmode' -F a 'quote(Dir||NewFile) '#?'
    signal off failure
    call pragma(d,old)
    Lzxsize=Size(Dir||Newfile)
        Diff = Lhasize - Lzxsize
        Address COMMAND 'Delete >NIL: 'quote(Dir||File) 'FORCE'
        if bbsmode='ON' then do
                    Address COMMAND 'Setdate >NIL: 'quote(Dir||NewFile) Datetime
                    Address COMMAND 'Filenote >NIL: 'quote(Dir||NewFile) Comment
                    end
                else     Address COMMAND 'Filenote >NIL: 'quote(Dir||NewFile) quote('Repacked by' utilname ver 'from' arctype 'archive; gained:' diff 'bytes!')
        say '* 'Diff' bytes saved on this 'arctype' archive!' ; say
        WriteLog('Converted' file 'to' newfile ', gained' Diff 'bytes')
    BSave = BSave + Diff
END
if bsave=0 then Bsave="Sorry, no"
select
    when quiet='ON' then WriteLog(verstring': finished repacking; total gain: 'Bsave 'bytes')
    when quiet~=''    then WriteLog('Finished file recursion')
    otherwise nop
end
Cleanup:
Call PRAGMA('D',root)
Call Close(list)
Call Close(log)
if bbsmode='ON' then Call Close(infos)
Address COMMAND 'Delete >NIL: 'quote(tempdir)' ALL FORCE'
call Delete(root'LHA-LZX.temp')
call Delete(root'lha-lzx_infos.temp')
call Delete(root'recursive_LZX_repack.temp')
call pragma('s',oldstack)
EXIT 0

sfm:
/* Single file mode... */
parse arg sngfile
sfm=1
/* deve dare fn e dir */
fn=substr(sngfile,max(lastpos(':', sngfile),lastpos('/', sngfile)) +1)
dir=left(arg(1),max(lastpos(':',sngfile),lastpos('/',sngfile)))
if ~(length(dir)-length(compress(dir,':'))) then /* Nel dir non ci sono i : */
                        if right(pragma(d),1)=':' then dir=pragma(d)dir /* Se siamo in root, dir=root||dir */
                                    else dir=pragma(d)'/'dir /* Se non siamo in root, dir=cwd||/||dir */
                        else
                        if dir=':' then dir=pragma(d) /* Ci sono i : ma solo quelli! (siamo in root)*/
call initlog('on file' dir||fn)
call writelogoptions
open(fake,root'lha-lzx.temp',W)
writeln(fake,fn)
close(fake)
tempdir=root'RTD'
Mkdir(tempdir)
if bbsmode='ON' then do
            Address COMMAND 'List 'quote(Dir||fn)' DATES FILES LFORMAT "%d %t %c" >'quote(root'lha-lzx_infos.temp')
            Call Open(infos,root'lha-lzx_infos.temp','R')
            end
Call Pragma('D',tempdir)
Call Open(list,root'LHA-LZX.temp','R')
Bsave=0
signal mainloop

midcleanup:
Address COMMAND 'Delete >NIL: "'tempdir'/#?" ALL FORCE'
return 1

badinstall:
Say "Repack has been incorrectly installed! See the DOCS!"
signal badexit

baddata:
Say 'One or more of the parameters supplied on the command line is bogus!!!'

badexit:
Say '"Computer, end program!"'
exit 5

extract:
parse arg fullname
select
    when checklha(fullname) then arc=extlha(quote(fullname))
    when checkzip(fullname) then arc=extzip(quote(fullname))
    when checkarj(fullname) then arc=extarj(quote(fullname))
    when checkrar(fullname) then arc=extrar(quote(fullname))
    when checkshr(fullname) then arc=extshr(quote(fullname))
    when checkxar(fullname) then arc=extxar(quote(fullname))
    when checkarc(fullname) then arc=extarc(quote(fullname))
    when checkzoo(fullname) then arc=extzoo(quote(fullname))
    when checkpak(fullname) then arc=extpak(quote(fullname))
    when checktgz(fullname) then arc=exttgz(quote(fullname))
    when checktar(fullname) then arc=exttar(quote(fullname))
    when checkgzip(fullname) then arc=extgzip(quote(fullname))
    when checkhpack(fullname) then arc=exthpack(quote(fullname))
        otherwise arc="???"
end
return arc

extlha:
lxc='lha -a -F -M x'
if (lzxreg & lha_h_l(arg(1))~='02'x) then lxc='lzx -a -F x'
                            else if pathexists('lhx') then lxc='lhx -a -F -M x'
Address COMMAND lxc arg(1) '#?'
return "LHA"

extzip:
Address COMMAND 'unzip -a -q 'arg(1)
return "ZIP"

extarj:
Address COMMAND 'unarj x 'arg(1)
return "ARJ"

extrar:
Address COMMAND 'unrar x 'arg(1)
return "RAR"

extshr:
Address COMMAND 'shrink x 'arg(1)
return "Shrink"

extxar:
address command 'xarc -x 'arg(1)
return "XARC"

exthpack:
Address COMMAND 'hpack x -DA -R 'arg(1)
return "Hpack"

extarc:
Address COMMAND 'arc e 'arg(1)
return "ARC"

extzoo:
Address COMMAND 'zoo eq/ 'arg(1)
return "ZOO"

exttgz:
extgzip(arg(1))
exttar(exitname)
return "Tar-Gzipped"

extgzip:
sss = Left(file,(lastpos('.',file)-1))
exitname=quote(tempdir'/'||(right(sss,(length(sss)-lastpos('/',sss)))))
Address COMMAND 'gzip >'exitname '-cdN 'arg(1)
return "GZip"

exttar:
if pathexists('tar') then txc='tar -a -x -f'
            else if pathexists('gnutar') then txc='gnutar -p -x -f'
                            else txc='detar'
Address command txc arg(1)
return 'TAR'

extpak:
Address COMMAND arg(1)
return "PAK"

checklha:
call open(check,arg(1),r)
seek(check,2,B)
if readch(check,3)=="-lh" then     do
                close(check)
                return 1
                end
close(check)
return 0

lha_h_l:
call open(headercheck,(strip(arg(1),B,'"')),r)
seek(headercheck,20,B)
val=readch(headercheck,1)
close(headercheck)
return val

checkzip:
call open(check,arg(1),r)
if readch(check,2)=="PK" then do
                close(check)
                return 1
                end
close(check)
return 0

checkarj:
call open(check,arg(1),r)
if readch(check,2)=="`ê" then do
                close(check)
                return 1
                end
close(check)
return 0

checkrar:
call open(check,arg(1),r)
if readch(check,3)=="Rar" then do
                close(check)
                return 1
                end
close(check)
return 0

checkshr:
return (checkxar(arg(1)) & (right(arg(1),(length(arg(1))-lastpos('.',arg(1))))='shr'))

checkxar:
call open(check,arg(1),r)
if readch(check,4)=="FORM" & right(readch(check,8),4)=="CDAF" then do
                close(check)
                return 1
                end
close(check)
return 0

checktgz:
call open(check,arg(1),r)
if (right(namein,3)='tgz' & readch(check,3)=='1f8b08'x) then do
                                close(check)
                                return 1
                                end
close(check)
return 0


checktar:
open(ch,arg(1),r)
call seek(ch,100) /* Moves up to the needed position*/
/* Nooow... let's try with lots of triple checks including datatype() calls....*/
select
    when ~tlc(7) then signal notar
    when ~tlc(7) then signal notar
    when ~tlc(7) then signal notar
    when ~tlc(30) then signal notar
otherwise close(ch);return 1
end

notar:
close(ch);return 0

tlc:
do arg(1)
ts=readch(ch,1)
if ~(ts==' ' | datatype(ts,N) ) then return 0
end
if readch(ch,1)=='0'x then return 1 /* The string is 0 terminated....*/
return 0


checkgzip:
call open(check,arg(1),r)
if readch(check,3)=='1f8b08'x then do
                close(check)
                return 1
                end
close(check)
return 0

checkhpack:
call open(check,arg(1),r)
if readch(check,4)=="HPAK" then do
                close(check)
                return 1
                end
close(check)
return 0

checkzoo:
call open(check,arg(1),r)
if readch(check,4)=="ZOO " then do
                close(check)
                return 1
                end
close(check)
return 0

checkarc:
call open(check,arg(1),r)
if readch(check,2)=='1a08'x then do
                close(check)
                return 1
                end
close(check)
return 0

checkpak:
call open(check,arg(1),r)
call seek(check,248)
if readch(check,11)=='dos.library' then do
                close(check)
                return 1
                end
close(check)
return 0

Size: procedure
return word(statef(arg(1)),2)

fano:
do id=1 to omit.0
if length(omit.id)-length(compress(omit.id,'#?'))=0 then
                            if ~exists(omit.id) then iterate
address command 'delete >NIL:' quote(omit.id) 'FORCE'
end
do id=1 to add.0
if ~exists(add.id) then iterate
ADDRESS COMMAND 'Copy' add.id tempdir
end
return

initano:
if ~exists(anofile) then do
                add.0=0
                omit.0=0
                return
            end

open(in,anofile,r)
do until eof(in)
    inline=readln(in)
    if goodline(inline) then break
end
middle:
select
    when inline=='ADD:' then call addano
    when inline=='OMIT:' then call omitano
otherwise nop
end
if ~eof(in) then signal middle
if ~datatype(add.0,'N') then add.0=0
if ~datatype(omit.0,'N') then omit.0=0
return

addano:
count=0
do forever
inline=readln(in)
if (eof(in) | inline=='OMIT:') then do
                    add.0=count
                    return
                    end
if goodline(inline) then do
                count=count+1;add.count=inline
            end
end
return

omitano:
count=0
do forever
inline=readln(in)
if (eof(in) | inline=='ADD:') then do
                    omit.0=count
                    return
                    end
if goodline(inline) then do
                    count=count+1;omit.count=inline
            end
end
return


goodline: procedure
if (left(arg(1),1)==';' | arg(1)=='') then return 0
return 1

failure:
signal off failure
if (RC=10 | RC=104) then do
            Say bold"WARNING:"normal"Failed extracting "fullname" archive... skipping!"
            midcleanup()
            Writelog('Extraction error while unpacking' fullname 'archive... skipping!')
            if sfm then exit(10)
                else signal mainloop
            end
    else do
        Say bold"WARNING:"normal"Problem encountered while creating new LZX archive (not enough memory ?)."
        Say "Keeping original "fullname" archive."
        call delete(dir||Newfile)
        midcleanup()
        Writelog('Could not create new LZX archive; keeping' fullname 'archive.')
        if sfm then exit(10)
            else signal mainloop
        end

setuplib: procedure
parse arg library,v1,v2,v3

if(~show('l',library))then    do
                if(~addlib(library,v1,v2,v3))then    do
                                    say "Could not open" library"! Aborting..."
                                    exit 10
                                    end
                end
return 1

writelog:
return WriteLN(log,date(e) time() arg(1))

initlog:
om='W'
if exists(logname) then om='A'
open(log,logname,om)
Writeln(log,cr)
WriteLog('Started 'verstring arg(1))
close(log)
open(log,logname,'A')
drop om;return

writelogoptions:
return Writelog('Options: Efficency' mode', BBSmode:' bbsmode)

pathexists: procedure
address command 'which >nil:' arg(1)
if rc=5 then return 0
return 1

whatis: procedure
return word(statef(arg(1)),1)

checklzx:
address command 'which >t:lzxfn lzx'
if rc=5 then signal misslzx
open(ln,'t:lzxfn',r)
ref=readln(ln)
close(ln)
address command 'version >NIL:' quote(ref)
drop ref;call delete('t:lzxfn')
if rc>=5 then signal vererror
lzxreg=exists('l:lzx.keyfile')
return

misslzx:
say "LZX is not in installed (or not in your search path)!"
exit(205)

vererror:
say "Repack requires LZX version 1.21 o greater to operate!!"
exit(5)

mkdir: procedure
return makedir(arg(1))

quote: procedure
return '"'arg(1)'"'

halt:
break_c:
signal off break_c
signal off halt
signal off failure
Say "Yo, man! You pressed Control-c! Stopping execution...."
Writelog('User pressed Control-C, aborting....')
call midcleanup()
signal cleanup