/*       $VER: 8.0 bbsArcExt.rexx 15 Sep 1994 (15.9.94)
   copyright 1990-94 Richard Lee Stockton FREELY DISTRIBUTABLE

****************************************************************************
CONVERTED FOR XENOLINK PRO BBS. $VERS:1.0 (18.03.95) by Derek Scott,2:259/75

Changes:

$VER  DATE      DESCRIPTION
----  ----      -----------
1.02  25/03/95  Added line to Xconfig:bbbbsCD.config for pre-copy selected 
                files to Hard disk before archiving. (LZX-AsimCDFS workaround)
                Also relieves strain on CD jukebox's on multi-node use.
****************************************************************************

Each archive should be no larger than 800,000 bytes
All combined, the uncompressed files must be less than SIZE_LIMIT

***Requires*** "Junkmail" Xenolink Utility, (c) Alan Bland, 1994.         */


LF='0A'x
PARSE ARG name nodex archiver selected
IF selected='' THEN EXIT
node=VALUE(WORD(nodex,1))

IF archiver='H' THEN extension='.LHA'
                ELSE extension='.LZX'

/* read the configuration parameters from XCONFIG:BBBBScd.CFG */
x=OPEN(f,'xconfig:BBBBScd.config','R')
IF x~=0 THEN 
  DO
    bbspath=READLN(f)
    junk=READLN(f)
    junk=READLN(f)
    jmailbase=VALUE(WORD(READLN(f),1))
    emailfrom=READLN(f)
    junk=READLN(f)
    SIZE_LIMIT=VALUE(WORD(READLN(f),1))
    junk=READLN(f)
    copy_path=WORD(READLN(f),1)
    CALL CLOSE(f)
  END
ELSE
  /* can't open config file, so use defaults... :) */
  DO
    bbspath='doors:bbbbsCD/'
    emailfrom='Teri Odin CD'
    jmailbase=0             
    SIZE_LIMIT=5000000      
    copy_path='0'
  END
/***************************************************************************/

outfile6='ram:tcdexec'nodex
x=OPEN(f6,outfile6,'W')
CALL WRITELN(f6,'WAIT 3')


namex=''
DO i=1 TO LENGTH(name)-1
  namext=RIGHT(name,LENGTH(name)-i)
  namext=LEFT(namext,1)
  IF namext='_' THEN namex=namex' '
                ELSE namex=namex''namext
END
namex=LEFT(name,1)''namex

CALL CLOSE(STDOUT)
outname1='RAM:ArcExt.STDOUT'node
CALL OPEN(STDOUT,outname1,'W')

bytes=0
tbytes=0
s.=''
s.0=1
lasti=0


DO i=1 TO WORDS(selected)
  IF RIGHT(WORD(selected,i),1)='*' & i>1 THEN
  DO /* if a recursive archive is next, we need to close current archive */
    s.0=s.0+1
    bytes=0
    lasti=i-1
  END
  IF RIGHT(WORD(selected,i),1)='*' THEN
  DO /* if this entry is a recursive archive process it on its own */
    n=s.0
    s.n=STRIP(s.n WORD(selected,i))
    IF i<WORDS(selected) THEN 
    DO
      s.0=s.0+1
      bytes=800001
      lasti=i
      ITERATE
    END
    ELSE LEAVE i
  END
  /* process normal files in up to 800Kb archives */
  info=STATEF(WORD(selected,i))
  IF info='' THEN ITERATE i
  bytes=bytes+WORD(info,2)
  tbytes=tbytes+WORD(info,2)
  IF tbytes>SIZE_LIMIT THEN LEAVE i
  IF bytes>800000 & (i-lasti)>1 THEN
  DO
    s.0=s.0+1
    bytes=0
    lasti=i
  END
  n=s.0
  s.n=STRIP(s.n WORD(selected,i))
END

fdir=bbspath'Files/'name

outfile2=bbspath'LastMail'node
x=OPEN(f,outfile2,'R')
IF x=0 THEN EXIT 25
lastm=READLN(f)
CALL CLOSE(f)
IF DATATYPE(lastm,'W') THEN lastm=lastm+1
ELSE lastm=1


DO i=1 TO s.0
  outfile3=bbspath'LastMail'node
  ADDRESS COMMAND 'ECHO >'outfile3' 'lastm
  outfile4='RAM:ArcList'node
  x=OPEN(f,outfile4,'W')
  IF x=0 THEN EXIT 26
  CALL WRITELN(f,s.i) /* list in a file can be of unlimited length */
  CALL CLOSE(f)
  OPTIONS FAILAT 999
  filearcname=fdir'_'node'_'lastm''extension

  IF copy_path~='0' THEN /* pre-copy files to hard disk before archiving */
  DO
    x=OPEN(f,outfile4,'R')
    IF x=0 THEN EXIT 26
    copy_name=copy_path''node
    ADDRESS COMMAND  'delete 'copy_name' ALL'
    ADDRESS COMMAND  'makedir 'copy_name
    DO rl=1
      line=READLN(f)
      IF EOF(f) THEN LEAVE rl
      IF line='' THEN iterate rl
      DO rl2=1 to WORDS(line)
        fname1=WORD(line,rl2)
        fname2=LEFT(fname1,LENGTH(fname1)-2)
        IF RIGHT(fname1,1)='*' THEN 
           comm='COPY 'fname2' 'copy_name'/ ALL CLONE'
        ELSE
           comm='COPY 'fname1' 'copy_name'/'
        ADDRESS COMMAND comm
      END
    END
    IF archiver='H' THEN
       comm='LHA -b64 -P-2 -2amNrZ -r a 'filearcname' 'copy_name'/*'
    ELSE
       comm='LZX -X0 -bi128 -bo128 -m -e -r a 'filearcname' 'copy_name'/*'
    ADDRESS COMMAND comm
    ADDRESS COMMAND 'delete 'copy_name' ALL'
    CALL CLOSE(f)
  END

  IF copy_path='0' & archiver='H' THEN
  DO
    comm='LHA -b64 -P-2 -2amNrZ a 'filearcname' @RAM:ArcList'node
    ADDRESS COMMAND comm
  END

  If copy_path='0' & archiver='X' THEN
    DO 
    x=OPEN(f,outfile4,'R')
    IF x=0 THEN EXIT 26
    comm='LZX -X0 -bi128 -bo128 -m -e -r a 'filearcname
    DO rl=1
      line=READLN(f)
      IF EOF(f) THEN LEAVE rl
      IF line='' THEN iterate rl
      DO rl2=1 to WORDS(line)
        fname1=WORD(line,rl2)
        ADDRESS COMMAND comm' 'fname1
      END
    END
    CALL CLOSE(f)
  END

  temp=WORD(s.i,WORDS(s.i))
  dev=LEFT(temp,POS(':',temp)-1)
  x=OPEN(f,fdir'_'node'_'lastm''extension'.xdl','W')
  IF x=0 THEN EXIT 27
  CALL WRITELN(f,dev)
  CALL WRITELN(f,WORDS(s.i))
  CALL CLOSE(f)
  outfile5=bbspath'Email/'name'_'node'_'lastm
  x=OPEN(f,outfile5,'W')
  IF x=0 THEN EXIT 28
  CALL WRITELN(f,' Mail: 'lastm'   FILE: 'name'_'node' 'lastm''extension)
  CALL WRITELN(f,' From: 'emailfrom)
  CALL WRITELN(f,'   To: 'name)
  temp=' Subj: Archive of selected external device files'
  temp2=''
  IF s.0>1 THEN 
  DO
    temp=temp', part' i 'of' s.0'.'
    temp2=', part' i 'of' s.0'.' 
  END
  CALL WRITELN(f,temp)
  CALL WRITELN(f,' Date: 'DATE('W') DATE() TIME('C'))
  CALL WRITELN(f,LEFT('=',75,'='))
  CALL WRITELN(f,'Here is the archive of files you requested.')
  DO j=1 TO WORDS(s.i)
    CALL WRITELN(f,WORD(s.i,j))
  END
  CALL CLOSE(f)
  lastm=lastm+1
  junkmsgcmd='xutils:junkmail -f "'emailfrom'" -t "'namex'" -s "External file archive'temp2'" -m 0 -i 'outfile5' -b 'jmailbase' -a 'filearcname' -p -k' 
  CALL WRITELN(f6,junkmsgcmd)
  CALL WRITELN(f6,'WAIT 2')
END


CALL CLOSE(f6)

comm='c:runback c:execute ram:tcdexec'node
ADDRESS COMMAND comm
EXIT
/* bbsArcExt.rexx */