home *** CD-ROM | disk | FTP | other *** search
/ Aminet 10 / aminetcdnumber101996.iso / Aminet / util / arc / Repack3_3.lha / Repack.rexx < prev    next >
OS/2 REXX Batch file  |  1995-12-01  |  19KB  |  764 lines
  1. /*             Welcome, code dumper!
  2. LHA-LZX V1.0-2.0 by Mat Bettinson of the Plot Hatching Factory '95
  3. LHA-LZX V3.0 and above by Andrea Vallinotto.
  4.  
  5. $VER: LZX Repacker V 3.3, by Andrea Vallinotto (5.10.95)
  6. © 1995 Nathan Johnes Software lavatories :->
  7.  
  8. Since Jonathan Forbes' brilliant LZX came along and promptly blew LHA away,
  9. there's a need for a bulk converter. This is such a device.
  10.  
  11. You can execute this script with the following parameters: destination
  12. directory (any valid path name), temp directory (as above), efficiency
  13. (either 1, 2 or 3), keeping of old date and filenote updating ('on' or any
  14. other string for 'off'), and directory recursion (as BBS mode). If you
  15. wish, you can change the value of the LZX merging-group in the beginning of
  16. the program (see below!).
  17.  
  18. If you don't specify any of the above parameters, the script will ask you for
  19. the proper parameters, using nice Reqtools requesters.
  20.  
  21. BEWARE: the temp dir must be large enough to accommodate the largest extracted
  22. archive you're converting (including sub-archives, if present!).
  23.  
  24. You'll need: 
  25. in your search path: for lha and lzh archives either Lha, Lhx or LZX registered;
  26.              for tar archives either Tar, Gnutar or Detar,
  27.              and unzip, unarj, unrar, hpack, xarc, zoo, arc, gzip, LZX,
  28.              Delete, Setdate, Filenote and Which.
  29.     and in libs: rexxreqtools.library and reqtools.library .
  30.  
  31. Since this version, LZX version 1.21 or above is REQUIRED!
  32.  
  33. You can change the following value to suit you needs! It's the maximum group
  34. size that LZX can create. */
  35.  
  36. groupsize=2900
  37.  
  38. /* Don't modify nothing below this line: spaghetti code lies behind...
  39.         DON'T SAY YOU'VE NOT BEEN WARNED!! 
  40. (But what kind of code would you expect from an Italian, anyway ? :-)) ) */
  41.  
  42. options results
  43. options failat 9
  44. signal on break_c
  45. signal on halt
  46.  
  47. verstring='LZX Repacker version 3.3'
  48. parse var verstring jf utilname blah ver .
  49. titlestring=left(utilname,6) ver
  50. copyleft='by Andrea Vallinotto of Nowhere software'
  51. lstring="#?.(LZH|LHA|ZIP|ARJ|RAR|SHR|XAR|HPK|ARC|ZOO|PAK|TAR|GZ|Z|TGZ)"
  52. logname='t:Repack.log'
  53. anofile='s:repack.ano'
  54. cr='0a'x
  55. bold='1b'x'[1m'
  56. normal='1b'x'[0m'
  57. under='1b'x'[4m'
  58.  
  59. setuplib("rexxreqtools.library",0,-30,0)
  60. setuplib("rexxsupport.library",0,-30,0)
  61. parse source . . . scriptname . .
  62. if ~exists(scriptname) then signal badinstall
  63. call checklzx
  64.  
  65. parse arg instring
  66. if instring='?' then signal exofte
  67.  
  68. hmq=length(instring)-length(compress(instring,'"'))
  69. select
  70.     when hmq // 2 then signal baddata
  71.     when hmq=0 then do
  72.             parse var instring Dir root mode bbsmode rdm quiet .
  73.             signal init
  74.             end
  75.     otherwise nop
  76. end
  77.  
  78. a=0
  79. loop:
  80. instring=strip(instring,L)
  81. a=a+1
  82. select
  83.     when left(instring,1)='"' then do
  84.                 parse var instring '"' foo.a '"' instring
  85.                 signal loop
  86.                 end
  87.     when left(instring,1)="" then do
  88.                 foo.0=a-1
  89.                 signal complete
  90.                 end
  91.     otherwise         do
  92.                 parse var instring foo.a instring
  93.                 signal loop
  94.                 end
  95. end
  96. complete:
  97. if foo.0>0 then dir=foo.1
  98.         else dir=''
  99. if foo.0>1 then root=foo.2
  100.         else root=''
  101. if foo.0>2 then mode=foo.3
  102.         else mode=''
  103. if foo.0>3 then bbsmode=foo.4
  104.         else bbsmode=''
  105. if foo.0>4 then rdm=foo.5
  106.         else rdm=''
  107. if foo.0>5 then quiet=foo.6
  108.         else quiet=''
  109. init:
  110. select
  111.     when Dir = '' then DO
  112.             Dir = rtfilerequest('SYS:',,'Select directory to operate on',,'rtfi_flags = freqf_nofiles')
  113.             if dir = '' then signal ABORT
  114.             end
  115.     when ~exists(dir) then signal baddata
  116. otherwise nop
  117. end
  118. select
  119.     when root='' then DO
  120.             root = rtfilerequest('SYS:',,'Select temp dir',,'rtfi_flags = freqf_nofiles')
  121.             if root = '' then signal ABORT
  122.             end
  123.     when whatis(root) ~= 'DIR' then signal baddata
  124. otherwise nop
  125. end
  126.  
  127. effstring='_Fast|_Default|_More'
  128. maxeff=3
  129. if lzxreg then do
  130.         effstring=effstring'|M_aximum'
  131.         maxeff=9
  132.         end
  133.  
  134. if mode='' then Mode = rtezrequest('Choose LZX efficency',effstring,titlestring,'rtez_defaultresponse = 0',)
  135. select
  136.     when mode = 0 then mode = maxeff
  137.     when ~datatype(mode,N) then signal baddata
  138.     when (mode > maxeff | mode < 0) then signal baddata
  139. otherwise nop
  140. end
  141. bbsmode=upper(bbsmode)
  142. if bbsmode = '' then    do
  143.             if ~rtezrequest('Select date and comment updating','Set _New|Keep _old',titlestring,'rtez_defaultresponse = 1',)
  144.             then bbsmode='ON'
  145.             else bbsmode='OFF'
  146.         end
  147. rdm=upper(rdm)
  148. if rdm = '' then     do
  149.             if ~rtezrequest('Do you want to work in the subdirs too ?','_Yes|_No way!',titlestring,'rtez_defaultresponse = 0',)
  150.             then rdm='OFF'
  151.             else rdm='ON'
  152.         end
  153. if rdm='ON' then do     
  154.             address command "setenv tot 0"
  155.             address command "setenv tot2 0"
  156.         end    
  157. if quiet ='' then     do
  158.             say;say ' *** LHA-LZX repacker 1.0-2.0 by Mat Bettinson of the Plot Hatching Factory ***'
  159.             say '  *** 'verstring copyleft '***';say
  160.             end
  161.  
  162. oldstack=Pragma('S',50000)
  163. If right(root,1) ~= '/' & right(root,1) ~= ':' then root = root'/'
  164. bestia=whatis(dir)
  165. select
  166.     when bestia='' then signal baddata
  167.     when bestia='FILE' then sfm(dir)
  168.     otherwise sfm=0
  169. end
  170. call initlog('on directory' dir)
  171. If right(Dir,1) ~= '/' & right(Dir,1) ~= ':' then Dir = Dir'/'
  172. if ~(length(root)-length(compress(root,':'))) then root=pragma(d)'/'root
  173. tempdir=root'RTD'
  174. mkdir(tempdir)
  175. if ~(length(dir)-length(compress(dir,':'))) then 
  176.                         if right(pragma(d),1)=':' then dir=pragma(d)dir
  177.                                     else dir=pragma(d)'/'dir
  178.                         else
  179.                         if dir=':' then dir=pragma(d)
  180. if bbsmode='ON' then do
  181.             Address COMMAND 'List 'quote(dir)' P 'lstring' DATES TO 'quote(root'lha-lzx_infos.temp')' FILES LFORMAT "%d %t %c"'
  182.             Call Open(infos,root'lha-lzx_infos.temp','R')
  183.             end
  184. if exists(quiet'recursive_LZX_repack.temp') then    Call Open(list,quiet'recursive_LZX_repack.temp','R')
  185.                             else do
  186.                             Address COMMAND "List "quote(Dir)" P "lstring" TO "quote(root'LHA-LZX.temp')" FILES LFORMAT %n"
  187.                             Call Open(list,root'LHA-LZX.temp','R')
  188.                             end
  189. Call Pragma('D',tempdir)
  190. call Writelogoptions
  191.  
  192. /* Mainloop */
  193. BSave = 0
  194. mainloop:
  195. call initano()
  196. DO forever
  197.     File = ReadLN(list)
  198.     IF EOF(list) then break
  199.     if bbsmode='ON' then do
  200.                 mix = ReadLN(infos)
  201.                 Datetime = subword(mix,1,2)
  202.                 Comment = quote(subword(mix,3))
  203.             end
  204.     NewFile = Left(File,lastpos('.',file))'LZX'
  205.     say 'Converting file: 'File
  206.     call Midcleanup()
  207.     Lhasize=Size(Dir||File)
  208.     signal on failure
  209.     WriteLog('Trying to extract' file)
  210.     arctype=extract(Dir||File)
  211.     signal off failure
  212.     if arctype="???" then do
  213.                 Say "Cannot determine arc type... skipping!"
  214.                 WriteLog("Couldn't determine arc type of" File '...skipped!')
  215.                 iterate
  216.                 end
  217.     WriteLog('File' file 'extracted OK. Repacking...')
  218.     Address COMMAND 'List PAT 'lstring' FILES ALL LFORMAT %p%n >'quote(root'recursive_LZX_repack.temp')
  219.     if size(root'recursive_LZX_repack.temp') ~= 0 then do
  220.                             WriteLog('Started recursion for file' file)
  221.                             Close(log)
  222.                             Address REXX scriptname quote(tempdir) quote(tempdir) mode bbsmode rdm quote(root)
  223.                             Call Open(log,logname,'A')
  224.                             end
  225.     Call fano()
  226.     old=pragma(d,tempdir)
  227.     signal on failure
  228.     if lzxreg then lzxmode=mode' -Qf'
  229.             else lzxmode=mode
  230.     Address COMMAND 'LZX -r -e -a -M'groupsize' -'lzxmode' -F a 'quote(Dir||NewFile) '#?'
  231.     signal off failure
  232.     call pragma(d,old)
  233.     Lzxsize=Size(Dir||Newfile)
  234.         Diff = Lhasize - Lzxsize
  235.     if Diff < 0 then DO
  236.         call Delete(Dir||NewFile)
  237.         say "The "arctype" archive was smaller than LZX... skipping!" ; say
  238.         WriteLog('Original file' file 'is smaller than LZX archive... skipping!')
  239.         Diff=0
  240.         end
  241.     else do
  242.         Address COMMAND 'Delete >NIL: 'quote(Dir||File) 'FORCE'
  243.         if bbsmode='ON' then do
  244.                     Address COMMAND 'Setdate >NIL: 'quote(Dir||NewFile) Datetime
  245.                     Address COMMAND 'Filenote >NIL: 'quote(Dir||NewFile) Comment
  246.                 end
  247.                 else     Address COMMAND 'Filenote >NIL: 'quote(Dir||NewFile) quote('Repacked by' utilname ver 'from' arctype 'archive; gained:' diff 'bytes!')
  248.         say '* 'Diff' bytes saved on this 'arctype' archive!' ; say
  249.         WriteLog('Converted' file 'to' newfile ', gained' Diff 'bytes')
  250.         end
  251.     BSave = BSave + Diff
  252. END
  253. if bsave=0 then Bsave="Sorry, no"
  254. select
  255.     when (quiet='' & rdm='OFF') then do
  256.                         bodytext='LZX Repacker has finished!'cr||Bsave' bytes saved in this dir.'
  257.                         call rtezrequest(Bodytext,'Thanks!',verstring,'rtez_flags=ezreqf_centertext')
  258.                         WriteLog(verstring': finished repacking; total gain: 'Bsave 'bytes')
  259.                     end
  260.     when (rdm='ON' & quiet='') | (rdm='OFF' & quiet='ON') then do
  261.                                     envsum(bsave)
  262.                                 end
  263.     otherwise    do
  264.             WriteLog('Finished file recursion')
  265.             end
  266. end
  267. Cleanup:
  268. Call PRAGMA('D',root)
  269. Call Close(list)
  270. Call Close(log)
  271. if bbsmode='ON' then Call Close(infos)
  272. Address COMMAND 'Delete >NIL: 'quote(tempdir)' ALL FORCE'
  273. call Delete(root'LHA-LZX.temp')
  274. call Delete(root'lha-lzx_infos.temp')
  275. call Delete(root'recursive_LZX_repack.temp')
  276. if rdm='ON' then signal multdirs
  277. call pragma('s',oldstack)
  278. EXIT 0
  279.  
  280. sfm:
  281. /* Single file mode... */
  282. parse arg sngfile
  283. sfm=1
  284. /* deve dare fn e dir */
  285. fn=substr(sngfile,max(lastpos(':', sngfile),lastpos('/', sngfile)) +1)
  286. dir=left(arg(1),max(lastpos(':',sngfile),lastpos('/',sngfile)))
  287. if ~(length(dir)-length(compress(dir,':'))) then /* Nel dir non ci sono i : */
  288.                         if right(pragma(d),1)=':' then dir=pragma(d)dir /* Se siamo in root, dir=root||dir */
  289.                                     else dir=pragma(d)'/'dir /* Se non siamo in root, dir=cwd||/||dir */ 
  290.                         else
  291.                         if dir=':' then dir=pragma(d) /* Ci sono i : ma solo quelli! (siamo in root)*/
  292. call initlog('on file' dir||fn)
  293. call writelogoptions
  294. open(fake,root'lha-lzx.temp',W)
  295. writeln(fake,fn)
  296. close(fake)
  297. tempdir=root'RTD'
  298. Mkdir(tempdir)
  299. if bbsmode='ON' then do
  300.             Address COMMAND 'List 'quote(Dir||fn)' DATES FILES LFORMAT "%d %t %c" >'quote(root'lha-lzx_infos.temp')
  301.             Call Open(infos,root'lha-lzx_infos.temp','R')
  302.             end
  303. Call Pragma('D',tempdir)
  304. Call Open(list,root'LHA-LZX.temp','R')
  305. Bsave=0
  306. signal mainloop
  307.  
  308. multdirs:
  309. pragma(d,dir)
  310. address command 'list >LZX-Repack.rdm DIRS LFORMAT "%p%s" ALL'
  311. if size('lZx-RePaCk.RdM') = 0 then do
  312.                     Say "There aren't any subdirs here, you JERK!"
  313.                     call delete('lzX-rEPacK.rDM')
  314.                     if bsave=0 then Bsave="Sorry, no"
  315.                     bodytext='LZX Repacker has finished!'cr||Bsave' bytes saved in this dir.'
  316.                     call rtezrequest(Bodytext,'Thanks!',verstring,'rtez_flags=ezreqf_centertext')
  317.                     Open(log,logname,'a')
  318.                     WriteLog(verstring': finished repacking; total gain: 'Bsave 'bytes')
  319.                     Call Close(log)
  320.                     exit
  321.                     end
  322. open(foo,'LzX-rEpAcK.rDm')
  323. do forever
  324.     ndtbp=readln(foo)
  325.     if eof(foo) then break
  326.     Close(log)
  327.     address REXX scriptname quote(ndtbp) quote(root) mode bbsmode 'OFF' 'ON'
  328. end
  329. close(foo)
  330. call delete('lzX-rEPacK.rDM')
  331. call pragma('s',oldstack)
  332. Say "Recursive mode finished!!"
  333. /* Gets total */
  334. open(tt,"env:tot");tot=readln(tt);close(tt)
  335. bodytext='LZX Repacker has finished!'cr||tot' bytes saved in directory recursion!'
  336. call rtezrequest(Bodytext,'Thanks!',verstring,'rtez_flags=ezreqf_centertext')
  337. Open(log,logname,A)
  338. Writelog(verstring 'finished directory recursion; total bytes saved:' tot)
  339. Writelog(cr)
  340. Call close(log)
  341. call delete('env:tot')
  342. call delete('env:tot2')
  343. exit 0
  344.  
  345.  
  346. midcleanup:
  347. Address COMMAND 'Delete >NIL: "'tempdir'/#?" ALL FORCE'
  348. return 1
  349.  
  350. badinstall:
  351. Say "Repack has been incorrectly installed! See the DOCS!"
  352. signal badexit
  353.  
  354. abort:
  355. Say 'Requester aborted!'
  356. signal badexit
  357.  
  358. baddata:
  359. Say 'One or more of the parameters supplied on the command line is bogus!!!'
  360.  
  361. badexit:
  362. Say '"Computer, end program!"'
  363. exit 5
  364.  
  365. extract:
  366. parse arg fullname
  367. select
  368.     when checklha(fullname) then arc=extlha(quote(fullname))
  369.     when checkzip(fullname) then arc=extzip(quote(fullname))
  370.     when checkarj(fullname) then arc=extarj(quote(fullname))
  371.     when checkrar(fullname) then arc=extrar(quote(fullname))
  372.     when checkshr(fullname) then arc=extshr(quote(fullname))
  373.     when checkxar(fullname) then arc=extxar(quote(fullname))
  374.     when checkarc(fullname) then arc=extarc(quote(fullname))
  375.     when checkzoo(fullname) then arc=extzoo(quote(fullname))
  376.     when checkpak(fullname) then arc=extpak(quote(fullname))
  377.     when checktgz(fullname) then arc=exttgz(quote(fullname))
  378.     when checktar(fullname) then arc=exttar(quote(fullname))
  379.     when checkgzip(fullname) then arc=extgzip(quote(fullname))
  380.     when checkhpack(fullname) then arc=exthpack(quote(fullname))
  381.         otherwise arc="???"
  382. end
  383. return arc
  384.  
  385. extlha:
  386. lxc='lha -a -F -M x'
  387. if (lzxreg & lha_h_l(arg(1))~='02'x) then lxc='lzx -a -F x'
  388.                             else if pathexists('lhx') then lxc='lhx -a -F -M x'
  389. Address COMMAND lxc arg(1) '#?'
  390. return "LHA"
  391.  
  392. extzip: 
  393. Address COMMAND 'unzip -a -q 'arg(1)
  394. return "ZIP"
  395.  
  396. extarj: 
  397. Address COMMAND 'unarj x 'arg(1)
  398. return "ARJ"
  399.  
  400. extrar: 
  401. Address COMMAND 'unrar x 'arg(1)
  402. return "RAR"
  403.  
  404. extshr:
  405. Address COMMAND 'shrink x 'arg(1)
  406. return "Shrink"
  407.  
  408. extxar: 
  409. address command 'xarc -x 'arg(1)
  410. return "XARC"
  411.  
  412. exthpack: 
  413. Address COMMAND 'hpack x -DA -R 'arg(1)
  414. return "Hpack"
  415.  
  416. extarc:
  417. Address COMMAND 'arc e 'arg(1)
  418. return "ARC"
  419.  
  420. extzoo:
  421. Address COMMAND 'zoo eq/ 'arg(1)
  422. return "ZOO"
  423.  
  424. exttgz:
  425. extgzip(arg(1))
  426. exttar(exitname)
  427. return "Tar-Gzipped"
  428.  
  429. extgzip:
  430. sss = Left(file,(lastpos('.',file)-1))
  431. exitname=quote(tempdir'/'||(right(sss,(length(sss)-lastpos('/',sss)))))
  432. Address COMMAND 'gzip >'exitname '-cdN 'arg(1)
  433. drop sss;return "GZip"
  434.  
  435. exttar:
  436. if pathexists('tar') then txc='tar -a -x -f'
  437.             else if pathexists('gnutar') then txc='gnutar -p -x -f'
  438.                             else txc='detar'
  439. Address command txc arg(1)
  440. drop txc;return 'TAR'
  441.  
  442. extpak:
  443. Address COMMAND arg(1)
  444. return "PAK"
  445.  
  446. checklha: 
  447. call open(check,arg(1),r)
  448. seek(check,2,B)
  449. if readch(check,3)=="-lh" then     do 
  450.                 close(check)
  451.                 return 1
  452.                 end
  453. close(check) 
  454. return 0
  455.  
  456. lha_h_l:
  457. call open(headercheck,(strip(arg(1),B,'"')),r)
  458. seek(headercheck,20,B)
  459. val=readch(headercheck,1)
  460. close(headercheck)
  461. return val
  462.  
  463. checkzip: 
  464. call open(check,arg(1),r)
  465. if readch(check,2)=="PK" then do
  466.                 close(check)
  467.                 return 1
  468.                 end
  469. close(check)
  470. return 0
  471.  
  472. checkarj: 
  473. call open(check,arg(1),r)
  474. if readch(check,2)=="`ê" then do
  475.                 close(check)
  476.                 return 1
  477.                 end
  478. close(check)
  479. return 0
  480.  
  481. checkrar: 
  482. call open(check,arg(1),r)
  483. if readch(check,3)=="Rar" then do
  484.                 close(check)
  485.                 return 1
  486.                 end
  487. close(check)
  488. return 0
  489.  
  490. checkshr:
  491. return (checkxar(arg(1)) & (right(arg(1),(length(arg(1))-lastpos('.',arg(1))))='shr'))
  492.  
  493. checkxar: 
  494. call open(check,arg(1),r)
  495. if readch(check,4)=="FORM" & right(readch(check,8),4)=="CDAF" then do
  496.                 close(check)
  497.                 return 1
  498.                 end
  499. close(check) 
  500. return 0
  501.  
  502. checktgz:
  503. call open(check,arg(1),r)
  504. if (right(namein,3)='tgz' & readch(check,3)=='1f8b08'x) then do
  505.                                 close(check)
  506.                                 return 1
  507.                                 end
  508. close(check)
  509. return 0
  510.  
  511.  
  512. checktar:
  513. open(ch,arg(1),r)
  514. call seek(ch,100) /* Moves up to the needed position*/
  515. /* Nooow... let's try with lots of triple checks including datatype() calls....*/
  516. select
  517.     when ~tlc(7) then signal notar
  518.     when ~tlc(7) then signal notar
  519.     when ~tlc(7) then signal notar
  520.     when ~tlc(30) then signal notar
  521. otherwise close(ch);return 1
  522. end
  523.  
  524. notar:
  525. close(ch);return 0
  526.  
  527. tlc:
  528. do arg(1)
  529. ts=readch(ch,1)
  530. if ~(ts==' ' | datatype(ts,N) ) then return 0
  531. end
  532. if readch(ch,1)=='0'x then return 1 /* The string is 0 terminated....*/
  533. return 0
  534.  
  535.  
  536. checkgzip: 
  537. call open(check,arg(1),r)
  538. if readch(check,3)=='1f8b08'x then do
  539.                 close(check)
  540.                 return 1
  541.                 end
  542. close(check)
  543. return 0
  544.  
  545. checkhpack: 
  546. call open(check,arg(1),r)
  547. if readch(check,4)=="HPAK" then do
  548.                 close(check)
  549.                 return 1
  550.                 end
  551. close(check)
  552. return 0
  553.  
  554. checkzoo: 
  555. call open(check,arg(1),r)
  556. if readch(check,4)=="ZOO " then do
  557.                 close(check)
  558.                 return 1
  559.                 end
  560. close(check)
  561. return 0
  562.  
  563. checkarc:
  564. call open(check,arg(1),r)
  565. if readch(check,2)=='1a08'x then do
  566.                 close(check)
  567.                 return 1
  568.                 end
  569. close(check)
  570. return 0
  571.  
  572. checkpak:
  573. call open(check,arg(1),r)
  574. call seek(check,248)
  575. if readch(check,11)=='dos.library' then do
  576.                 close(check)
  577.                 return 1
  578.                 end
  579. close(check)
  580. return 0
  581.  
  582. Size: procedure
  583. return word(statef(arg(1)),2)
  584.  
  585. fano:
  586. do id=1 to omit.0
  587. if length(omit.id)-length(compress(omit.id,'#?'))=0 then
  588.                             if ~exists(omit.id) then iterate
  589. address command 'delete >NIL:' quote(omit.id) 'FORCE'
  590. end
  591. do id=1 to add.0
  592. if ~exists(add.id) then iterate
  593. ADDRESS COMMAND 'Copy' add.id tempdir
  594. end
  595. return
  596.  
  597. initano:
  598. if ~exists(anofile) then do 
  599.                 add.0=0
  600.                 omit.0=0
  601.                 return
  602.             end
  603.  
  604. open(in,anofile,r)
  605. do until eof(in)
  606.     inline=readln(in)
  607.     if goodline(inline) then break
  608. end
  609. middle:
  610. select
  611.     when inline=='ADD:' then call addano
  612.     when inline=='OMIT:' then call omitano
  613. otherwise nop
  614. end
  615. if ~eof(in) then signal middle
  616. if ~datatype(add.0,'N') then add.0=0
  617. if ~datatype(omit.0,'N') then omit.0=0
  618. return
  619.  
  620. addano:
  621. count=0
  622. do forever
  623. inline=readln(in)
  624. if (eof(in) | inline=='OMIT:') then do
  625.                     add.0=count
  626.                     return
  627.                     end
  628. if goodline(inline) then do
  629.                 count=count+1;add.count=inline
  630.             end
  631. end
  632. return
  633.  
  634. omitano:
  635. count=0
  636. do forever
  637. inline=readln(in)
  638. if (eof(in) | inline=='ADD:') then do
  639.                     omit.0=count
  640.                     return
  641.                     end
  642. if goodline(inline) then do
  643.                     count=count+1;omit.count=inline
  644.             end
  645. end
  646. return
  647.  
  648.  
  649. goodline: procedure
  650. if (left(arg(1),1)==';' | arg(1)=='') then return 0
  651. return 1
  652.  
  653. failure:
  654. signal off failure
  655. if (RC=10 | RC=104) then do
  656.             Say bold"WARNING:"normal"Failed extracting "fullname" archive... skipping!"
  657.             midcleanup()
  658.             Writelog('Extraction error while unpacking' fullname 'archive... skipping!')
  659.             if sfm then exit(10)
  660.                 else signal mainloop
  661.             end
  662.     else do
  663.         Say bold"WARNING:"normal"Problem encountered while creating new LZX archive (not enough memory ?)."
  664.         Say "Keeping original "fullname" archive."
  665.         call delete(dir||Newfile)
  666.         midcleanup()
  667.         Writelog('Could not create new LZX archive; keeping' fullname 'archive.')
  668.         if sfm then exit(10)
  669.             else signal mainloop
  670.         end
  671.  
  672. setuplib: procedure
  673. parse arg library,v1,v2,v3
  674.  
  675. if(~show('l',library))then    do
  676.                 if(~addlib(library,v1,v2,v3))then    do
  677.                                     say "Could not open" library"! Aborting..."
  678.                                     exit 10
  679.                                     end
  680.                 end
  681. return 1
  682.  
  683. writelog:
  684. return WriteLN(log,date(e) time() arg(1))
  685.  
  686. initlog:
  687. om='W'
  688. if exists(logname) then om='A'
  689. open(log,logname,om)
  690. Writeln(log,cr)
  691. WriteLog('Started 'verstring arg(1))
  692. close(log)
  693. open(log,logname,'A')
  694. drop om;return
  695.  
  696. writelogoptions:
  697. return Writelog('Options: Efficency' mode', BBSmode:' bbsmode', directory recursion:' rdm)
  698.  
  699. pathexists: procedure
  700. address command 'which >nil:' arg(1)
  701. if rc=5 then return 0
  702. return 1
  703.  
  704. whatis: procedure
  705. return word(statef(arg(1)),1)
  706.  
  707. checklzx:
  708. address command 'which >t:lzxfn lzx'
  709. if rc=5 then signal misslzx
  710. open(ln,'t:lzxfn',r)
  711. ref=readln(ln)
  712. close(ln)
  713. address command 'version >NIL:' quote(ref)
  714. drop ref;call delete('t:lzxfn')
  715. if rc>=5 then signal vererror
  716. lzxreg=exists('l:lzx.keyfile')
  717. return
  718.  
  719. misslzx:
  720. say "LZX is not in installed (or not in your search path)!"
  721. exit(205)
  722.  
  723. vererror:
  724. say "Repack requires LZX version 1.21 o greater to operate!!"
  725. exit(5)
  726.  
  727. mkdir: procedure
  728. return makedir(arg(1))
  729.  
  730. quote: procedure
  731. return '"'arg(1)'"'
  732.  
  733. halt:
  734. break_c:
  735. signal off break_c
  736. signal off halt
  737. signal off failure
  738. Say "Yo, man! You pressed Control-c! Stopping execution...."
  739. Writelog('User pressed Control-C, aborting....')
  740. call midcleanup()
  741. signal cleanup
  742.  
  743. exofte:
  744. /* Template! Template! Fate anche voi come me: io templo, template anche voi!*/
  745. Say bold||verstring||normal copyleft
  746. Say bold"Usage:"normal
  747. Say "[rx] "scriptname "DIR|FILE/K TEMPDIR/K MODE/N BBSMODE/S DIR.RECURSION/S"
  748. say
  749. say bold"Example:" normal
  750. say scriptname '"dh0:dir with many files" dh2:temp 3 ON OFF'
  751. Say
  752. say 'For more information,' under'RTFM!' normal
  753. say;exit
  754.  
  755. envsum: procedure
  756. address command "setenv tot2 `getenv tot`"
  757. address command 'eval >env:tot "`getenv tot2`" + 'arg(1)
  758. return 1
  759.  
  760. /*
  761. "Complimenti, capitano: li ha colpiti!"
  762. "Lo so, sono un figo!"
  763. Star Strik I
  764. */