*
* CopyFile program
* Tony Gravagno, Nebula Research and Development
* http://Nebula-RnD.com
*
* Open Source v1.0 for D3 : 16 Jul 2002
* Please e-mail comments, enhancements, and other platform-specfic
* versions to Freeware@Nebula-RnD.com.
*
* Updates may be available at http://Nebula-Rnd.com/freeware
*
* Program comments are at the very bottom of the code.
*
* Responsibility for implementation and use of this program rests
* entirely with the user.  Nebula R&D will not be liable for any
* time, data, financial, or other loss incurred as a result of
* execution of this program.  This software is distributed as-is
* with no warranties or guarantees, explicit or implied.
*
EQUATE PLATFORM TO "D3"
DIM DATAINFO(50,2)
*
PRINT
PRINT "This program will copy an entire file."
PRINT "You will be prompted for the source and target accounts,"
PRINT "Then you will be prompted for the source and target filenames."
PRINT "Enter '*' at any prompt to exit."
PRINT
*
PRINT "Enter Source Account Name ":
INPUT SACCT
IF SACCT = "*" OR SACCT = "" THEN STOP
*
PRINT "Enter Target Account Name ":
INPUT TACCT
IF TACCT = "*" THEN STOP
IF TACCT = "" THEN TACCT = SACCT
*
PRINT "Enter Source File Name ":
INPUT SFILE
IF SFILE = "*" OR SFILE = "" THEN STOP
*
PRINT "Enter Target File Name ":
INPUT TFILE
IF TFILE = "*" THEN STOP
IF TFILE = "" THEN TFILE = SFILE
*
IF TACCT = SACCT AND TFILE = SFILE THEN
   PRINT "Can't copy a file onto itself."
   PRINT "Terminating!"
   STOP
END
*
BEGIN CASE
   CASE PLATFORM = "D3"
      GOSUB PROCESS.D3
      PRINT "Done"
   CASE 1
      PRINT "Invalid platform, cannot copy file"
END CASE
*
STOP
*
PROCESS.D3: 
*
* Open this account's Master Dictionary
*
OPEN "MD" TO THISMD ELSE
   PRINT "Cannot open master dictionary for this account"
   PRINT "Terminating!"
   STOP
END
*
* Open the Source File's Master Dictionary
*
OPEN SACCT:",," TO SMD ELSE
   PRINT "Cannot open ":SACCT:" master dictionary"
   PRINT "Terminating!"
   STOP
END
*
* Open the Source File's Dictionary, make sure it's valid
*
OPEN "DICT ":SACCT:",":SFILE:"," TO SDICT ELSE
   PRINT "Cannot open dict file ":SACCT:",":SFILE:","
   PRINT "Terminating!"
   STOP
END
*
* Yes, this is a valid dictionary
*
* Read the D-Pointer of Dict File from the source MD
*
READ DICTPOINTER FROM SMD,SFILE ELSE
   PRINT "Cannot read d-pointer for dictionary of source file"
   PRINT "  ":SACCT:",":SFILE
   PRINT "Terminating!"
   STOP
END
MODDICT = DICTPOINTER<3>
*
* Make sure that the Target account is valid
*
OPEN TACCT:",," TO TMD ELSE
   PRINT "Target account ":TACCT:" cannot be found"
   PRINT "Terminating!"
   STOP
END
*
* See if there is already someting in TACCT called SFILE
*
READ ANYTHING FROM TMD,TFILE THEN
   PRINT "Item already in md of ":TACCT:", cannot create file ":TFILE
   PRINT "Terminating!"
   STOP
END ELSE NULL
*
* It's safe to attempt creating file tacct,tfile
*
* Find all data files, note their name and modulo
*
MODDATA = ""; * Each attribute contains name]mod
*
EXECUTE "SSELECT DICT ":SACCT:",":SFILE:", WITH A1 D]"
EOF = 0
ERRORS = 0
MAT DATAINFO = ""
DATAFILES = 0
*
LOOP
   READNEXT DATANAME ELSE EOF = 1
UNTIL EOF = 1 DO
   PRINT "Filename ":DATANAME
*
   OPEN SACCT:",":SFILE:",":DATANAME:"," TO SDATA THEN
*	Just made sure that this is a valid file, dont use SDATA
      READ DPOINTER FROM SDICT,DATANAME THEN
         DATAFILES = DATAFILES + 1
         DATAINFO(DATAFILES,1) = DATANAME
         DATAINFO(DATAFILES,2) = DPOINTER
      END ELSE
         PRINT "Can't read mod from ":SACCT:",":SFILE:", ":DATANAME
         ERRORS = ERRORS + 1
      END
   END ELSE
      PRINT "Can't open data ":SACCT:",":SFILE:",":DATANAME:","
      ERRORS = ERRORS + 1
   END
REPEAT
IF ERRORS > 0 THEN
   PRINT ERRORS:" errors were encountered prior to file creation."
   PRINT "Enter 'C' to Continue, any other entry to exit ":
   INPUT CONT
   IF CONT # "C" THEN
      PRINT "Terminating"
      STOP
   END
END
*
PRINT "Creating files..."
*
* Create the file in the local account, move to target acct when done
*
UNIQUEFILE = "COPY*":SFILE:"*":TFILE
*
STMT1 = "CREATE-FILE DICT ":UNIQUEFILE:" ":MODDICT
EXECUTE STMT1
*
* Open the new dict so we can work with data pointers
*
OPEN "DICT ":UNIQUEFILE TO TDICT ELSE
   PRINT "Can't open new file ":UNIQUEFILE:" in this account."
   PRINT "Terminating!"
   STOP
END
*
* Eliminate the "placemarker" q-pointer put into the dict
*
DELETE TDICT,UNIQUEFILE
*
* Update new dict d-pointer with info from source
*
READ SDPOINTER FROM SMD,SFILE ELSE
   PRINT "Can't read d-pointer for source file"
   PRINT "Terminating!"
   STOP
END
*
READ TDPOINTER FROM THISMD,UNIQUEFILE ELSE
   PRINT "Can't read d-pointer for file just created: ":UNIQUEFILE
   PRINT "Terminating!"
   STOP
END
*
LASTATB = DCOUNT(SDPOINTER,CHAR(254))
*
TDPOINTER<1> = SDPOINTER<1>
FOR ATB = 5 TO LASTATB
   TDPOINTER<ATB> = SDPOINTER<ATB>
NEXT ATB
*
* Modify the Index references in Correlative so we can regen the indexes
*
CORR = TDPOINTER<8>
GOSUB PROCESS.D3.INDEXES
TDPOINTER<8> = CORR
*
* Some systems might get in trouble for writing a d-pointer here,
* especially since we have the file open.
*
WRITE TDPOINTER ON THISMD,UNIQUEFILE
*
* Regenerate the Index references
*
STMT1 = "CREATE-INDEX DICT ":UNIQUEFILE:" * (O"
EXECUTE STMT1
*
* Now copy dict items
*
PRINT "Copying dictionary items for ":SFILE:"..."
*
STMT1 = "COPY DICT ":SACCT:",":SFILE:","
STMT1 = STMT1 : " (ISO"
STMT2 = "(DICT ":UNIQUEFILE

DATA STMT2
EXECUTE STMT1
*
* Create the data files
*
FOR FNUM = 1 TO DATAFILES
   DATANAME = DATAINFO(FNUM,1)
   MODULO = DATAINFO(FNUM,2)<3>
   STMT1 = "CREATE-FILE DATA ":UNIQUEFILE:",":DATANAME:" ":MODULO
   EXECUTE STMT1
*
* Update new data d-pointer with info from source
*
   READ DPOINTER FROM TDICT,DATANAME ELSE
      PRINT "Can't open file just created: ":UNIQUEFILE:",":DATANAME
      PRINT "Terminating!"
      STOP
   END
*
   LASTATB = DCOUNT(DATAINFO(FNUM,2),CHAR(254))
*
   DPOINTER<1> = DATAINFO(FNUM,2)<1>
   FOR ATB = 5 TO LASTATB
      DPOINTER<ATB> = DATAINFO(FNUM,2)<ATB>
   NEXT ATB
*
* Modify the Index references in Correlative so we can regen the indexes
*
   CORR = DPOINTER<8>
   GOSUB PROCESS.D3.INDEXES
   DPOINTER<8> = CORR
*
* Some systems may have an issue with writing a d-pointer
*
   WRITE DPOINTER ON TDICT,DATANAME
*
* Regenerate the Index references
*
   STMT1 = "CREATE-INDEX ":UNIQUEFILE:",":DATANAME:" * (O"
   EXECUTE STMT1
*
* Now copy data items
*
   PRINT "Copying data for data file ":DATANAME:"..."
*
   STMT1 = "COPY ":SACCT:",":SFILE:",":DATANAME:","
   STMT1 = STMT1 : " (ISO"
   STMT2 = "(":UNIQUEFILE:",":DATANAME

   DATA STMT2
   EXECUTE STMT1

NEXT FNUM
*
* Move file to target account
*
STMT1 = "MOVE-FILE MD ":UNIQUEFILE
STMT2 = "(":TACCT:",, ":TFILE

DATA STMT2
EXECUTE STMT1
*
*  Re-generate indexes on file
*
*
RETURN
*
*
PROCESS.D3.INDEXES: 
*
VALS = DCOUNT(CORR,CHAR(253))
FOR VAL = 1 TO VALS
   CODE = CORR<1,VAL>
* See if the correlative is an Index code
   IF CODE[1,1] = 'I' THEN
* Find the beginning of the A-correlative
      BEG = INDEX(CODE,'A',1)
* Zero the frame reference
      CODE = "i0a" : CODE[BEG+1,99999]
      CORR<1,VAL> = CODE
   END
NEXT VAL
RETURN
*
*
*
END
*
* Comments
*	If you make enhancements or port this code to another platform,
*	please send the code back to Tony Gravagno so that everyone benefits.
*
*	An attempt was made to write code for maximum cross-platform
*	compatibility:
*	- Code is in Case-Sensistive Upper Case.
*	- All empty lines have a '*' comment.
*	- Execute statements use Data to stack the secondary buffer.
*	- System delimiters are made with char(z) rather than @am and @vm.
*
*	If there are no items in the source file to copy, the Execute
*	statement will return an error that can simply be ignored.
*
*	Program will not work for D3NT in the FSI. VME use is fine for all
*	D3 platforms.  File pointers are cached in the FSI and the
*	read/write operations to the file pointers won't work.  Also,
*	FSI has R(emote) pointers and not D-Pointers, and indexes are
*	handled differently.  An FSI version can be written if required.
*
*	To make a version of this code for another platform, try to keep
*	all of the existing code in place, and simply add platorm-specific
*	code, along with an update to the CASE statement to call the right
*	routines.  If this is not possible do to compiler restrictions,
*	create another program called "copyfile.>yourplatform<" and we'll
*	make all of these available for download.  Send new versions to
*     Freeware@Nebula-RnD.com.
*
*	No attempt was made to make this a robust or user-friendly tool,
*	simply to make it functional and free.
*
*	Copy retrieval/update locks are copied from the source d-pointers
*	to the target.	The presence of these codes at the file and/or
*	account level may prevent access to the source file.  Testing 
*	in D3 seemed to show that the presence of these codes was ignored
*	for the specific functions performed.  This may be a D3 bug.
*	Please e-mail Tony with your results if you try this.
*
*	Code was written and tested over D3NT 7.2.0.  The Move-File verb
*	has had some issues in prior releases which may affect functionality
*	if used with D3 7.1 or below.
*
*     Will probably not work immediately in Advanced Pick because of the
*     use of Move-File.
*
*     D3-specific version has no handling for file Separation.  Target
*     file will be recreated at original Modulo, not the one specified in
*     attribute 13 for resizing.  (Resize parameter is copied.)  Maybe an
*     a good first enhancement would be to recreate files at new modulos.
*