;+
; Project     :	SOHO - CDS/SUMER
;
; Name        :	MK_PLAN_WRITE
;
; Purpose     :	Rewrite PLAN entries
;
; Explanation :	Rewrites plan entries that have changed
;
; Use         :	MK_PLAN_WRITE, NPLAN, PLAN 
;
; Inputs      :	NPLAN = new PLAN structure array
;               PLAN =  old PLAN structure array
;
; Opt. Inputs : None
;
; Outputs     :	None.
;
; Opt. Outputs:	None.
;
; Keywords    : TGAP = secs gap between consecutive plans [def=1.e-2]
;               NOCHECK = do not check DB for possible overlapping plans. 
;               RETRY   = retry adding by deleting overlapping plans.
;               NOLOOP = do not loop when adding 
;               TRUNCATE = truncate MSECS off times
;
; Common      :	None.
;
; Restrictions:	None.
;
; Side effects:	PLAN is replaced by newly-written PLANS
;
; Category    :	Planning
;
; Prev. Hist. :	None.
;
; Written     :	Version 1, Dominic Zarro (ARC), 9 January 1995
;
; Modified    : Version 2, Liyun Wang, GSFC/ARC, May 23, 1995
;
; Version     :	Version 2, May 23, 1995
;-

pro mk_plan_write, nplan, plan,tgap=tgap,nocheck=nocheck,retry=retry,$
                   noloop=noloop,err=err,list=list,truncate=truncate

on_error,1
err=''

;dprint, '% MK_PLAN_WRITE: updating DB...'

nocheck=keyword_set(nocheck)
noloop=keyword_set(noloop)
retry=keyword_set(retry)
truncate=keyword_set(truncate)
if truncate then format='(f15.0)' else format='(f15.3)'

nnew=n_elements(nplan)
nold=n_elements(plan)

if (nold eq 0) and (nnew eq 0) then return

;--  Check type of entry

if nnew gt 0 then begin
 type=get_plan_type(nplan,inst=inst) 
 if type eq -1 then return
 itime=get_plan_itime(nplan) 
 if type eq 2 then inst=nplan(0).instrume
endif else begin
 type=get_plan_type(plan,inst=inst)
 if type eq -1 then return
 if type eq 2 then inst=plan(0).instrume
 itime=get_plan_itime(plan) 
endelse

;-- Get DB access routines for this type of plan

del_funct=get_plan_funct(type,/del)
add_funct=get_plan_funct(type,/add)
lis_funct=get_plan_funct(type,/lis)

cds=which_inst() ne 'S'

;--  Handle null case when new DB is empty

if nnew eq 0 then begin
 dprint, '%emptying DB...'
 for i = 0,nold-1 do begin
  err = ''
  if (type ne 2) and (type ne 4) then pname = plan(i).sci_spec else pname = plan(i).sci_obj
  dprint, '% MK_PLAN_WRITE: deleting '+strtrim(pname,2),'....'
  if ((type eq 2) or (type eq 4)) and cds then begin
   status=call_function(del_funct,plan(i).(itime),err=err,inst=inst)
  endif else begin
   status=call_function(del_funct,plan(i).(itime),err=err)
  endelse
  if not status then message, 'Delete error: '+err,/cont
 endfor
 delvarx,plan
 return
endif

;--  Look forward and backward in time for possible overlapping entries

if (nold gt 0) then begin

 if not nocheck then begin
  dprint,'% MK_PLAN_WRITE: checking DB..'
  new_tmin=min(nplan.(itime))
  new_tmax=max(nplan.(itime+1))
  old_tmin=min(plan.(itime))
  old_tmax=max(plan.(itime+1))
  if (str_format(new_tmax,format) gt str_format(old_tmax,format)) then $
   rd_plan,plan,old_tmax,new_tmax,type=type,inst=inst,list=list
  if (str_format(new_tmin,format) lt str_format(old_tmin,format)) then $
   rd_plan,plan,new_tmin,old_tmin,type=type,inst=inst,list=list
 endif
 nold=n_elements(plan)

;-- Check old entries that don't match new ones

 new_times=str_format(nplan.(itime),format)
 for i = 0, nold-1 do begin
  clook=where(str_format(plan(i).(itime),format) eq new_times,cnt)
  delete_this = 0
  if cnt eq 0 then delete_this=1 else begin
   same=mk_plan_comp(plan(i),nplan(clook(0)),/end_time,dtag=dtag,truncate=truncate)
   if not same then begin
    dprint,'% dtag-1 ',dtag
   endif
   if not same then delete_this=1
  endelse

;-- Try deleting

  if delete_this then begin
   err=''
   if (type ne 2) and (type ne 4) then pname = plan(i).sci_spec else pname = plan(i).sci_obj
   dprint, '% MK_PLAN_WRITE: deleting '+strtrim(pname,2)+$
            ' from '+tai2utc(plan(i).(itime),/ecs)
   if exist(inst) then dprint,'=> instrument: ',inst
   if ((type eq 2) or (type eq 4)) and cds then $
    status=call_function(del_funct,plan(i).(itime),err=err,inst=inst) else $
     status=call_function(del_funct,plan(i).(itime),err=err)

;-- Problem deleting?

   if not status then begin
    message,'Cannot remove '+pname+' : '+err,/contin
    if not exist(serr) then serr=err else serr=[serr,err]
   endif
  endif

 endfor
endif

;-- Check new entries that have changed

if exist(plan) then old_times=str_format(plan.(itime),format)
again:
tplan=nplan
for i = 0, nnew-1 do begin

 if nold eq 0 then add_this=1 else begin
  clook=where(str_format(nplan(i).(itime),format) eq old_times,cnt)
  add_this=0
  if cnt eq 0 then add_this=1 else begin
   same=mk_plan_comp(nplan(i),plan(clook(0)),/end_time,dtag=dtag,truncate=truncate)
   if not same then begin
    dprint,'% dtag-2 ',dtag
   endif
   if not same then add_this=1 
  endelse
 endelse

;-- Try adding

 if add_this then begin
  if (type ne 2) and (type ne 4) then pname = nplan(i).sci_spec else pname = nplan(i).sci_obj
  dprint, '% MK_PLAN_WRITE: adding '+strtrim(pname,2)+$
           ' to '+tai2utc(nplan(i).(itime),/ecs)
  if exist(inst) then dprint,'=> instrument: ',inst
  if noloop then begin
   if not exist(aplans) then aplans=nplan(i) else $
    aplans=concat_struct(temporary(aplans),nplan(i))
  endif
 endif

;-- writing to DB is faster when NOLOOP is used

 if not noloop then begin
  added=1
  if add_this then begin
   err=''
   if (type eq 2) and cds then $
    status=call_function(add_funct,nplan(i),err=err,inst=inst) else $
     if (type eq 0) and cds then $
      status=call_function('add_detail',nplan(i),err=err,/nocheck) else $
       status=call_function(add_funct,nplan(i),err=err)

;-- Problem adding?

   if status eq 0 then begin
    message,'cannot add '+pname+' : '+err,/contin
    if not exist(serr) then serr=err else serr=[serr,err]
    added=0 & err=''

;-- Look for overlapping plans and remove them if RETRY is set

    if (type eq 2) and cds then $
     call_procedure,lis_funct,nplan(i).(itime),nplan(i).(itime+1),bplan,nbad,inst=inst,err=err else $
      call_procedure,lis_funct,nplan(i).(itime),nplan(i).(itime+1),bplan,nbad,err=err
    if nbad gt 0 then begin
     dprint,'--> overlapping plans:'
     for k=0,nbad-1 do begin
      if (type ne 2) and (type ne 4) then bname = bplan(k).sci_spec else bname = bplan(k).sci_obj
      print,bname,' ',tai2utc(bplan(k).(itime),/ecs)
      if retry then begin
       dprint,'% MK_PLAN_WRITE: retrying'
       if (type eq 2) and cds then begin
        status=call_function(del_funct,bplan(k).(itime),err=err,inst=inst)
       endif else begin
        status=call_function(del_funct,bplan(k).(itime),err=err)
       endelse
      endif
     endfor
     if retry then begin
      if (type eq 2) and cds then $
       status=call_function(add_funct,nplan(i),err=err,inst=inst) else $
        if (type eq 0) and cds then $
         status=call_function('add_detail',nplan(i),err=err,/nocheck) else $
          status=call_function(add_funct,nplan(i),err=err)
      if status eq 0 then dprint,'% MK_PLAN_WRITE: retry failed' else added=1
     endif
    endif
   endif
  endif
  if not added then mk_plan_rem,nplan(i),tplan
 endif
endfor

;-- add in one hit (try looping if failure occurs and retry is set)

if noloop and exist(aplans) then begin
 err=''
 if (type eq 2) and cds then $
  status=call_function(add_funct,aplans,err=err,inst=inst) else $
   if (type eq 0) and cds then $
    status=call_function('add_detail',aplans,err=err,/nocheck) else $
     status=call_function(add_funct,aplans,err=err)
 if not status then begin
  message,err,/cont
  if retry then begin
   noloop=0 & goto,again
  endif
 endif
endif 

if exist(tplan) then plan=tplan else delvarx,plan
if exist(serr) then err=arr2str(serr,delim=' ')

return & end