! @(#)filer2.prg	17.1.1.1 (ES0-DMD) 01/25/02 17:46:09
! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
! MIDAS procedure filer2.prg  to implement RENAME/IMA, TABLE, FIT
! K.Banse       900313,910529, 910920, 920706, 941104
!
! use via RENAME/IMA, /TABLE, /FIT oldframe newframe [history_flag] [overwrite]
! 
!  if history_flag = NO, the history descriptor of the new frame is
!                        not updated, defaulted to YES
!  if overwrite = CONFIRM, we check, if a file with the new name already exists
!		  and if so, ask for confirmation, defaulted to NO_CONFIRM
!
!
! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
CROSSREF old new history overwrite
! 
define/param p3 YES C "Enter history_update flag, YES/NO: "
define/param p4 NO  C "Enter overwrite flag, CONFIRM/NO_CONFIRM: "
! 
define/local aux/c/1/2 {mid$cmnd(11:12)}	!save type
define/local subcom/c/1/10 subtr/{aux(1:1)}cat
define/local addcom/c/1/8 add/{aux(1:1)}cat
! 
define/local ifile/c/1/60 " " ALL
define/local ofile/c/1/60 " " ALL
define/local test/i/1/1 0
define/local k/i/1/1 0
define/local j/i/1/2 0,0
!
! branch according to file type
!
branch aux(1:2) IM,TA,FI D_IMAGE,D_TABLE,D_FIT
write/error 3
return
!
D_IMAGE:
define/param p1 ? IMA "Enter image name: "
define/param p2 ? IMA "Enter result frame: "
define/local filtyp/c/1/4 .bdf
k = 6
goto next
!
D_TABLE:
define/param p1 ? T "Enter table name: "
define/param p2 ? T "Enter result frame: "
define/local filtyp/c/1/4 .tbl
k = 8
goto next
!
D_FIT:
define/param p1 ? F "Enter fit file name: "
define/param p2 ? F "Enter result frame: "
define/local filtyp/c/1/4 .fit
k = 9
goto next
!
NEXT:
write/keyw in_a {p1}
write/keyw out_a {p2}
! 
! look for directory specs + then file type
! 
if aux_mode .lt. 2 then
   define/local dirend/c/1/1 "]" ? +lower		!VMS
else
   define/local dirend/c/1/1 "/" ? +lower		!Unix
endif
j(1) = m$indexb(in_a,dirend)+1
j(2) = m$indexb(out_a,dirend)+1
if m$index(in_a({j(1)}:),".") .le. 0 then
   write/keyw ifile {in_a}{filtyp}
else
   write/keyw ifile {in_a}
endif
if m$index(out_a({j(2)}:),".") .le. 0 then
   write/keyw ofile {out_a}{filtyp}
else
   write/keyw ofile {out_a}
endif
!
! if p4 == YES, check, if new frame exists already 
!
if p4(1:1) .eq. "C" then
   j = m$exist(ofile)
   if j .eq. 1 then			!file exists already - get confirmation
      aux(1:2) = "NO"
      write/out  file with name {ofile} already exists, 
      inquire/keyw aux -
      "enter YES or NO to overwrite it or not:"
      if aux(1:1) .ne. "Y" return no
   endif
endif
!
! first rename in the host system then subtract old entry + add new entry
!
-rename {ifile} {ofile}
! 
if p3(1:1) .ne. "N" -
   write/descr {ofile} history/c/-1/80 "Renamed from {ifile} to {ofile}"
!
if catalinf({k}) .ne. 0 then
   test = m$index(ifile,"*")		!look for wild card specs in file name
   if test .gt. 0 then
      write/out "no catalog processing with wild card filenames..."
   else
      {subcom} ? {ifile}
      {addcom} ? {ofile}
   endif
endif
return yes