/* Hacked by Andrew Zaitsev (SAVOA COrporation)
   SAVOA = Sandris, Andrei, Vadim, Oleg, Aivars
   CopyLeft (l) 1998 - do whatever you want with this prg,
   though it would be cool if you left my name in the titles :)

   Note: program uses archive attribute to see whether files
   have been updated. If you already have most of the files
   online, it might be a good idea to do ATTRIB -A on your
   local files before running COPYU for the first time.
*/

PARSE ARG LOC REM
IF REM='' THEN DO
   SAY 'Usage: COPYU {local path} {ftp_site\path}'
   SAY 'Program will sync the ftp directory with local one.'
   SAY 'New and updated files are uplaoded.'
   SAY
   SAY 'COPYU expects to find user/passwd info in file COPYU.DAT'
   SAY 'Lines in this file have following format:'
   SAY 'FTP_HOST USERNAME PASSWORD'
   EXIT 1
END
CALL INIT
CALL COPYU LOC 'ftp://'U':'P'@'REM
SAY 'Done.'
EXIT

/* ------------- Yellow Subroutines ------------- */

COPYU:PROCEDURE EXPOSE IC
PARSE ARG LOCAL REMOTE
REMOTE=TRANSLATE(REMOTE,'/','\') /* Force forward slashes */
PARSE VAR REMOTE 'ftp://' U ':' P '@' H '/' RDI

CALL LOCAL_FILES
/* Once we are back from LOCAL_FILES, CH contains files with +A
   NO are files with no archive attr - we'll see if any of them
   are not on FTP - then ul them too
*/
CALL FTP_FILES U P H RDI
IF IC>0 THEN DO
   SAY 'Resetting archive attributes...'
   CALL RESET_ATTR
END
RETURN


INIT:
DO FOREVER
   INF=LINEIN('COPYU.DAT')
   PARSE VAR INF H U P
   IF POS(H,REM)>0 THEN DO
      YES=1
      LEAVE
   END
END
IF YES<>1 THEN DO
   SAY H 'not found in COPYU.DAT'
   EXIT 28
END
RETURN /* INIT */

LOCAL_FILES:PROCEDURE EXPOSE LOCAL IC CH CH. IN NO.
call RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
call SysLoadFuncs

CALL SYSFILETREE LOCAL'\*.*' , 'F.','F','*-***'
/* Last parm can seed on attr: +****
   from ADHRS - show only +As !
   The parm before it is supposed to have option 'files only'
   when it's value is 'F' - but it didn't work. No matter,
   attr mask can do same thing.
   Same func can be used to set attrs too !! */

/* Format of dir entry:
6/21/97   1:07p           0  -D---  C:\PUB\MIDI\NEW */

/**TRACE ?R */
IC=0; CH.=''; IN=0; NO.=''; CH=''
/* Originally I just put all fnames in long string - but this didn't
   work with long filenames */

DO I=1 TO F.0
   FAJ=LOWER(FILENAME(WORD(F.I,5)))
   AT=WORD(F.I,4)
   IF LEFT(AT,1)='A' THEN DO
      IC=IC+1
      CH.IC=FAJ
      CH=CH FAJ
   END
   ELSE DO
      IN=IN+1
      NO.IN=FAJ
   END
END
CH=STRIP(CH)
IF CH<>'' THEN SAY 'These files have archive attr set:' CH
/* Files in CH. will be uploaded as 'changed
   Rest will be compared against remote list to see
   if there are any files that are not on FTP */
RETURN

FILENAME:PROCEDURE
/* This prg returns filename portion of the full path */
RETURN FILESPEC('NAME',ARG(1)) /* front end for built-in func! */
/**RETURN SUBSTR(A,LASTPOS('\',A)+1) */

FTP_FILES:PROCEDURE EXPOSE LOCAL IC IIC CH CH. IN NO. /* It's cool to have EXPOSE - that is, full REXX feature set */
PARSE ARG U P H RDI
/**TRACE ?R */
CALL RxFuncAdd "FTPLoadFuncs","rxFtp","FTPLoadFuncs"
CALL FtpLoadFuncs
SAY 'Establishing connection...'
CALL FtpSetUser H,U,P
CALL FtpSetBinary "Binary"

CALL FTPCHDIR RDI
SAY 'Connected to' H', getting directory listing...'

RC=FtpLs('*','F.')
AL=''
DO I=1 TO F.0
   AL=AL F.I
END
/* Now we have list of remote files in AL. Compare it against NO -
   see if there are any local files that are not online */

IIC=IC /* will use it later - when resetting +A attributes */
DO I=1 TO IN
   W=LOWER(NO.I)
   IF WORDPOS(W,AL)=0 THEN DO
      IC=IC+1
      CH.IC=W
      CH=CH W
/* file is not online, add to 'changed' list */
   END
END

IF IC=0 THEN SAY 'No updates are needed'
ELSE DO
   SAY 'Following files will be uploaded:' STRIP(CH)

   /* And now the final stage - we UPLOAD THEM! */
   DO I=1 TO IC
      F=CH.I
      SAY 'Uploading' F'...'
      CALL FtpPut LOCAL'\'F,F
   END
END
rc = FtpLogoff()
RETURN /* COPYU */

LOWER:PROCEDURE
/* Object REXX lacks LOWER() funcs. Well, here it is */
PARSE ARG A
RETURN TRANSLATE(A,XRANGE('a','z'),XRANGE('A','Z'))

RESET_ATTR: PROCEDURE EXPOSE CH. IIC LOCAL
CH.0=IIC
CALL SYSFILETREE LOCAL'\*.*' , 'CH.','F','*****','-****'
/* This mask tells proc to turn archive attr off */
RETURN