!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubedag_tuple
  use gkernel_interfaces
  use cubetools_parameters
  use cubedag_messaging
  !
  public :: cubedag_tuple_t
  public :: cubedag_tuple_upsert,cubedag_tuple_setconsistent,cubedag_tuple_read,  &
            cubedag_tuple_write,cubedag_tuple_hasuptodatefile,cubedag_tuple_reset,  &
            cubedag_tuple_diskupdate,cubedag_tuple_rmmemo,cubedag_tuple_rmfiles
  private
  !
  integer(kind=4), parameter :: tuple_mdisk=4
  integer(kind=4), parameter :: tuple_mmemo=7
  !
  type :: cubedag_tuple_t
    integer(kind=code_k)  :: code(tuple_mmemo) = 0
    integer(kind=8)       :: tstamp(tuple_mmemo) = 0
    character(len=file_l) :: file(tuple_mmemo) = ''
  contains
    procedure :: list      => cubedag_tuple_list
    procedure :: hascube   => cubedag_tuple_hascube
    procedure :: filename  => cubedag_tuple_filename
    procedure :: location  => cubedag_tuple_location
    procedure :: debug     => cubedag_tuple_debug
    procedure :: disksizes => cubedag_tuple_disksizes
    procedure :: disksize  => cubedag_tuple_disksize
    procedure :: contains  => cubedag_tuple_contains
  end type cubedag_tuple_t
  !
  character(len=*), parameter :: form_tup='(A,T26,I11,I20,3X,A)'
  !
contains
  !
  subroutine cubedag_tuple_reset(tuple)
    !---------------------------------------------------------------------
    ! Fully reset a tuple
    !---------------------------------------------------------------------
    type(cubedag_tuple_t), intent(out) :: tuple
    return
  end subroutine cubedag_tuple_reset
  !
  subroutine cubedag_tuple_read(lun,tup,error)
    !---------------------------------------------------------------------
    ! Read tuple from disk
    !---------------------------------------------------------------------
    integer(kind=4),       intent(in)    :: lun
    type(cubedag_tuple_t), intent(out)   :: tup
    logical,               intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='TUPLE>READ'
    integer(kind=4) :: ier,access,pos,i
    integer(kind=8) :: tstamp
    character(len=file_l) :: file
    character(len=12) :: key
    !
    do i=1,tuple_mdisk
      read(lun,form_tup,iostat=ier)  key,access,tstamp,file
      if (ier.lt.0)                exit  ! EOF
      if (ier.gt.0) then
        call putios('E-TUPLE>READ,  ',ier)
        error = .true.
        return
      endif
      pos = cubedag_tuple_position(access,code_buffer_disk)
      tup%code(pos) = access
      tup%tstamp(pos) = tstamp
      tup%file(pos) = file
    enddo
  end subroutine cubedag_tuple_read
  !
  subroutine cubedag_tuple_write(lun,tup,error)
    !---------------------------------------------------------------------
    ! Write tuple to disk
    !---------------------------------------------------------------------
    integer(kind=4),       intent(in)    :: lun
    type(cubedag_tuple_t), intent(in)    :: tup
    logical,               intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='TUPLE>WRITE'
    integer(kind=4) :: i
    !
    do i=1,tuple_mdisk
      write(lun,form_tup)  'TUPLE',tup%code(i),tup%tstamp(i),trim(tup%file(i))
    enddo
  end subroutine cubedag_tuple_write
  !
  subroutine cubedag_tuple_upsert(tup,access,location,onefile,error)
    !---------------------------------------------------------------------
    ! Insert (if the file is new) or update (if the file has changed) one
    ! file in the tuple file. Nothing done if file is already up-to-date.
    ! If file does not exist, its timestamp is set to 0.
    !---------------------------------------------------------------------
    type(cubedag_tuple_t), intent(inout) :: tup
    integer(kind=code_k),  intent(in)    :: access
    integer(kind=code_k),  intent(in)    :: location
    character(len=*),      intent(in)    :: onefile
    logical,               intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='TUPLE>UPSERT'
    logical :: updated
    !
    updated = .false.
    call cubedag_tuple_upsert_one(tup,access,location,onefile,updated,error)
    if (error)  return
  end subroutine cubedag_tuple_upsert
  !
  subroutine cubedag_tuple_upsert_one(tup,access,location,onefile,updated,error)
    !---------------------------------------------------------------------
    ! Upsert one entry
    !---------------------------------------------------------------------
    type(cubedag_tuple_t), intent(inout) :: tup
    integer(kind=code_k),  intent(in)    :: access
    integer(kind=code_k),  intent(in)    :: location
    character(len=*),      intent(in)    :: onefile
    logical,               intent(inout) :: updated
    logical,               intent(inout) :: error
    ! Local
    integer(kind=4) :: ier,pos
    integer(kind=8) :: mtime
    logical :: update
    !
    pos = cubedag_tuple_position(access,location)
    !
    if (location.eq.code_buffer_disk) then
      if (gag_inquire(onefile,len_trim(onefile)).eq.0) then
        ! File exists or it disappeared
        ier = gag_mtime(onefile,mtime)
        ! ZZZ should trap error
        update = mtime.gt.tup%tstamp(pos)
      else
        mtime = 0
        update = .true.
      endif
    else
      mtime = 1
      update = .true.
    endif
    !
    if (update) then
      ! ZZZ Should we complain if file name has changed?
      tup%code(pos) = access
      tup%tstamp(pos) = mtime
      tup%file(pos) = onefile
      updated = .true.
    endif
  end subroutine cubedag_tuple_upsert_one
  !
  subroutine cubedag_tuple_diskupdate(tup,error)
    !-------------------------------------------------------------------
    ! Update the disk file timestamps of all the files ONLY IF THEY HAVE
    ! CHANGED. The consistency timestamp is left unchanged on purpose.
    !-------------------------------------------------------------------
    type(cubedag_tuple_t), intent(inout) :: tup
    logical,               intent(inout) :: error
    ! Local
    logical :: updated
    !
    updated = .false.
    call cubedag_tuple_diskupdate_one(tup,code_cube_imaset,code_buffer_disk,updated,error)
    if (error)  return
    call cubedag_tuple_diskupdate_one(tup,code_cube_speset,code_buffer_disk,updated,error)
    if (error)  return
  end subroutine cubedag_tuple_diskupdate
  !
  subroutine cubedag_tuple_diskupdate_one(tup,access,location,updated,error)
    !-------------------------------------------------------------------
    ! Update the timestamp of one file ONLY IF IT HAS CHANGED.
    !-------------------------------------------------------------------
    type(cubedag_tuple_t), intent(inout) :: tup
    integer(kind=code_k),  intent(in)    :: access
    integer(kind=code_k),  intent(in)    :: location
    logical,               intent(inout) :: updated
    logical,               intent(inout) :: error
    ! Local
    integer(kind=4) :: pos,pos_cons
    !
    if (location.eq.code_buffer_memory)  return  ! Only relevant for disk files
    pos = cubedag_tuple_position(access,location)
    if (tup%tstamp(pos).eq.0)  return  ! Nothing to update for this access
    !
    if (gag_inquire(tup%file(pos),len_trim(tup%file(pos))).ne.0) then
      ! File is referenced but it disappeared: discard it
      ! ZZZ Warning?
      tup%tstamp(pos) = 0
      tup%file(pos) = ''
      ! For safety also disable the consistency flag
      pos_cons = cubedag_tuple_position(code_null,code_null)
      tup%tstamp(pos_cons) = 0
      tup%file(pos_cons) = ''
      updated = .true.
      return
    endif
    !
    ! File exists: update if needed
    call cubedag_tuple_upsert_one(tup,access,location,tup%file(pos),updated,error)
    if (error)  return
  end subroutine cubedag_tuple_diskupdate_one
  !
  subroutine cubedag_tuple_setconsistent(tup,error)
    !---------------------------------------------------------------------
    ! Insert or update the consistency flag. It is the responsibility of
    ! the caller to ensure the files are consistent at the time this
    ! subroutine is called.
    !---------------------------------------------------------------------
    type(cubedag_tuple_t), intent(inout) :: tup
    logical,               intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='TUPLE>SETCONSISTENCY'
    integer(kind=4) :: ier,pos
    integer(kind=8) :: time
    !
    if (tup%tstamp(cubedag_tuple_position(code_cube_imaset,code_buffer_disk)).le.0 .or.  &
        tup%tstamp(cubedag_tuple_position(code_cube_speset,code_buffer_disk)).le.0) then
      call cubedag_message(seve%e,rname,  &
        'Can not set consistency while the 2 cubes are not present in tuple')
      error = .true.
      return
    endif
    !
    ier = gag_time(time)
    pos = cubedag_tuple_position(code_null,code_null)
    tup%code(pos) = code_null
    tup%tstamp(pos) = time
    tup%file(pos) = 'consistency'
  end subroutine cubedag_tuple_setconsistent
  !
  function cubedag_tuple_hasuptodatefile(tup,access,location,onefile,error)
    use cubetools_access
    !---------------------------------------------------------------------
    ! Get the file for the given access. The file is assumed "found" if
    ! 1) it is present in the tuple and
    ! 2 the tuple is consistent, or the tuple is inconsistent but the
    !   requested file is the newest.
    !---------------------------------------------------------------------
    logical :: cubedag_tuple_hasuptodatefile
    type(cubedag_tuple_t), intent(in)    :: tup
    integer(kind=code_k),  intent(in)    :: access  ! code_cube_*
    integer(kind=code_k),  intent(in)    :: location
    character(len=*),      intent(out)   :: onefile
    logical,               intent(inout) :: error
    ! Local
    integer(kind=4) :: pos
    integer(kind=8):: tstamp,ttstamp,ctstamp
    !
    cubedag_tuple_hasuptodatefile = .false.
    onefile = ''
    !
    pos = cubedag_tuple_position(access,location)
    if (pos.le.0) then
      error = .true.
      return
    endif
    !
    onefile = tup%file(pos)
    tstamp  = tup%tstamp(pos)
    !
    if (access.eq.code_cube_unkset) then
      ! Consistency has no much meaning
      cubedag_tuple_hasuptodatefile = tstamp.gt.0
    else
      ! Check for consistent file between image set and spectrum set
      ttstamp = tup%tstamp(cubedag_tuple_position(cubetools_transpose_access(access),location))
      ctstamp = tup%tstamp(cubedag_tuple_position(code_null,code_null))
      if (tstamp.le.0) then
        ! File does not exist
        cubedag_tuple_hasuptodatefile = .false.
      elseif (ttstamp.le.0) then
        ! Transposed file does not exist: no consistency issue
        cubedag_tuple_hasuptodatefile = .true.
      elseif (tstamp.le.ctstamp .and. ttstamp.le.ctstamp) then
        ! Files are consistent
        cubedag_tuple_hasuptodatefile = .true.
      elseif (ttstamp.le.tstamp) then
        ! Files are not consistent, and the requested one is the newest
        cubedag_tuple_hasuptodatefile = .true.
      else
        ! Files are not consistent, and the transposed one is the newest
        cubedag_tuple_hasuptodatefile = .false.
      endif
    endif
  end function cubedag_tuple_hasuptodatefile
  !
  subroutine cubedag_tuple_list(tup,id,family,flag,error)
    use cubetools_format
    use cubedag_parameters
    use cubedag_flag
    !---------------------------------------------------------------------
    ! List the tuple contents
    !---------------------------------------------------------------------
    class(cubedag_tuple_t), intent(inout) :: tup
    integer(kind=iden_l),   intent(in)    :: id
    character(len=*),       intent(in)    :: family
    type(tools_list_t),     intent(in)    :: flag
    logical,                intent(inout) :: error
    ! Local
    logical :: consistent
    integer(kind=4) :: cpos,ipos,spos,upos,lenght,lstrflag
    character(len=128) :: strflag
    integer(kind=8) :: ctstamp,itstamp,ststamp,utstamp
    character(len=file_l) :: file,name
    character(len=32) :: status
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='TUPLE>LIST'
    !
!!$ *** JP dagseve%trace is not (yet) defined
!!$    call cubedag_message(dagseve%trace,rname,'Welcome') 
    !
    ! *** JP Why a listing needs to update the content of the tuple? To be
    ! *** sure JP sur to be uptodate? If yes, this should be stated in the
    ! *** header of the subroutine.
    call cubedag_tuple_diskupdate(tup,error)
    if (error)  return
    !
    cpos = cubedag_tuple_position(code_null,code_null)
    spos = cubedag_tuple_position(code_cube_speset,code_buffer_disk)
    ipos = cubedag_tuple_position(code_cube_imaset,code_buffer_disk)
    upos = cubedag_tuple_position(code_cube_unkset,code_buffer_disk)
    ctstamp = tup%tstamp(cpos)
    ststamp = tup%tstamp(spos)
    itstamp = tup%tstamp(ipos)
    utstamp = tup%tstamp(upos)
    !
    ! Consistency
    consistent = .false.
    if (ststamp.le.0 .or. itstamp.le.0) then
       status = 'INCOMPLETE'
    elseif (ststamp.le.ctstamp .and. itstamp.le.ctstamp) then
       status = 'CONSISTENT'
       consistent = .true.
    else
       status = 'INCONSISTENT'
    endif
    !
    call cubedag_flaglist_tostr(flag,strflag=strflag,lstrflag=lstrflag,error=error)
    if (error)  return
    write(name,'(i0,2x,3a)') id,trim(family),":",strflag(1:lstrflag)
    !
    mess = cubetools_format_stdkey_boldval('Identifier',name,60)
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('Status',status,18)
    call cubedag_message(seve%r,rname,mess)
    !
    if (ststamp.le.0) then
       file = 'none'
       status = '---'
    else
       name = tup%file(spos)
       lenght = len_trim(name)
       if (lenght.gt.50) then
          file = name(1:15)//'...'//name(lenght-30:lenght)
       else
          file = name(1:lenght)
       endif
       if (consistent) then
          status = 'UPTODATE'
       elseif (ststamp.gt.itstamp) then
          status = 'NEWER'
       else
          status = 'OUTDATED'
       endif
    endif
    mess = cubetools_format_stdkey_boldval('SpeSet',file,60)
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('Status',status,18)
    call cubedag_message(seve%r,rname,mess)
    !
    if (itstamp.le.0) then
       file = 'none'
       status = '---'
    else
       name = tup%file(ipos)
       lenght = len_trim(name)
       if (lenght.gt.50) then
          file = name(1:15)//'...'//name(lenght-30:lenght)
       else
          file = name(1:lenght)
       endif
       if (consistent) then
          status = 'UPTODATE'
       elseif (itstamp.gt.ststamp) then
          status = 'NEWER'
       else
          status = 'OUTDATED'
       endif
    endif
    mess = cubetools_format_stdkey_boldval('ImaSet',file,60)
    mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('Status',status,18)
    call cubedag_message(seve%r,rname,mess)
    !
    if (utstamp.gt.0) then
       name = tup%file(upos)
       lenght = len_trim(name)
       if (lenght.gt.50) then
          file = name(1:15)//'...'//name(lenght-30:lenght)
       else
          file = name(1:lenght)
       endif
       status = '---'
       mess = cubetools_format_stdkey_boldval('UnkSet',file,60)
       mess = trim(mess)//'  '//cubetools_format_stdkey_boldval('Status',status,18)
       call cubedag_message(seve%r,rname,mess)
    endif
    !
    call cubedag_message(seve%r,rname,'')
  end subroutine cubedag_tuple_list
  !
  function cubedag_tuple_position(access,location)
    !-------------------------------------------------------------------
    ! Convert an access code to the position in the cubedag_tuple_t
    !-------------------------------------------------------------------
    integer(kind=4) :: cubedag_tuple_position
    integer(kind=code_k), intent(in) :: access
    integer(kind=code_k), intent(in) :: location
    ! Local
    character(len=*), parameter :: rname='TUPLE>POSITION'
    !
    select case (access)
    case (code_null)
      cubedag_tuple_position = 1
    case (code_cube_speset)
      if (location.eq.code_buffer_disk) then
        cubedag_tuple_position = 2
      else
        cubedag_tuple_position = 5
      endif
    case (code_cube_imaset)
      if (location.eq.code_buffer_disk) then
        cubedag_tuple_position = 3
      else
        cubedag_tuple_position = 6
      endif
    case (code_cube_unkset)
      if (location.eq.code_buffer_disk) then
        cubedag_tuple_position = 4
      else
        cubedag_tuple_position = 7
      endif
    case default
      call cubedag_message(seve%e,rname,'Internal error: requesting unknown access')
      cubedag_tuple_position = 0
      return
    end select
  end function cubedag_tuple_position
  !
  function cubedag_tuple_hascube(tup,access,location)
    !-------------------------------------------------------------------
    ! Return true if the tuple provides the access+location cube
    !-------------------------------------------------------------------
    logical :: cubedag_tuple_hascube
    class(cubedag_tuple_t), intent(in) :: tup
    integer(kind=code_k),   intent(in) :: access
    integer(kind=code_k),   intent(in) :: location
    ! Local
    integer(kind=4) :: pos
    !
    pos = cubedag_tuple_position(access,location)
    cubedag_tuple_hascube = tup%tstamp(pos).gt.0
    !
  end function cubedag_tuple_hascube
  !
  function cubedag_tuple_filename(tup,access,location)
    !-------------------------------------------------------------------
    ! Return the file name for access+location cube
    !-------------------------------------------------------------------
    character(len=file_l) :: cubedag_tuple_filename
    class(cubedag_tuple_t), intent(in) :: tup
    integer(kind=code_k),   intent(in) :: access
    integer(kind=code_k),   intent(in) :: location
    ! Local
    integer(kind=4) :: pos
    !
    pos = cubedag_tuple_position(access,location)
    if (tup%tstamp(pos).le.0) then
      cubedag_tuple_filename = '<not-yet-defined>'
    else
      cubedag_tuple_filename = tup%file(pos)
    endif
    !
  end function cubedag_tuple_filename
  !
  subroutine cubedag_tuple_location(tup,access,location,shortloc,error)
    !-------------------------------------------------------------------
    ! Return the location of the cube referenced by the tuple,
    ! in a string suited for LIST (i.e. properly truncating it)
    !-------------------------------------------------------------------
    class(cubedag_tuple_t), intent(in)    :: tup
    integer(kind=code_k),   intent(in)    :: access
    integer(kind=code_k),   intent(in)    :: location
    character(len=*),       intent(out)   :: shortloc
    logical,                intent(inout) :: error
    ! Local
    character(len=file_l) :: cubename
    integer(kind=4) :: nc,lmax
    !
    cubename = tup%filename(access,location)
    nc = len_trim(cubename)
    lmax = len(shortloc)
    if (nc.gt.lmax) then
      shortloc = '...'//cubename(nc-(lmax-4):nc)
    else
      shortloc = cubename(1:nc)
    endif
  end subroutine cubedag_tuple_location

  subroutine cubedag_tuple_rmmemo(tup,error)
    !-------------------------------------------------------------------
    ! Unreference the memory buffers for all accesses
    !-------------------------------------------------------------------
    type(cubedag_tuple_t), intent(inout) :: tup
    logical,               intent(inout) :: error
    ! Local
    integer(kind=4) :: iaccess,pos
    integer(kind=code_k) :: accesses(3) =  &
      (/ code_cube_imaset,code_cube_speset,code_cube_unkset /)
    !
    do iaccess=1,3
      pos = cubedag_tuple_position(accesses(iaccess),code_buffer_memory)
      if (tup%tstamp(pos).gt.0) then
        tup%code(pos) = 0
        tup%file(pos) = ''
        tup%tstamp(pos) = 0
      endif
    enddo
    !
  end subroutine cubedag_tuple_rmmemo

  subroutine cubedag_tuple_rmfiles(tup,error)
    !-------------------------------------------------------------------
    ! Remove all files on disk for the given tuple
    !-------------------------------------------------------------------
    type(cubedag_tuple_t), intent(inout) :: tup
    logical,               intent(inout) :: error
    ! Local
    integer(kind=4) :: iaccess,pos
    integer(kind=code_k) :: accesses(3) =  &
      (/ code_cube_imaset,code_cube_speset,code_cube_unkset /)
    !
    do iaccess=1,3
      pos = cubedag_tuple_position(accesses(iaccess),code_buffer_disk)
      if (tup%tstamp(pos).gt.0) then
        call gag_filrm(tup%file(pos))
        tup%code(pos) = 0
        tup%file(pos) = ''
        tup%tstamp(pos) = 0
      endif
    enddo
    !
  end subroutine cubedag_tuple_rmfiles

  subroutine cubedag_tuple_debug(tup)
    class(cubedag_tuple_t), intent(in) :: tup
    ! Local
    integer(kind=4) :: i
    do i=1,tuple_mmemo
      write(stdout,form_tup)  'TUPLE',tup%code(i),tup%tstamp(i),trim(tup%file(i))
    enddo
  end subroutine cubedag_tuple_debug

  function cubedag_tuple_disksizes(tup)
    !-------------------------------------------------------------------
    ! Return the disk footprint of ALL the files referenced by the tuple
    !-------------------------------------------------------------------
    integer(kind=size_length) :: cubedag_tuple_disksizes  ! [bytes]
    class(cubedag_tuple_t), intent(in) :: tup
    !
    cubedag_tuple_disksizes =  &
      tup%disksize(code_cube_imaset,code_buffer_disk) + &
      tup%disksize(code_cube_speset,code_buffer_disk) + &
      tup%disksize(code_cube_unkset,code_buffer_disk)
  end function cubedag_tuple_disksizes

  function cubedag_tuple_disksize(tup,access,location)
    !-------------------------------------------------------------------
    ! Return the disk footprint of one file in the tuple, if relevant
    !-------------------------------------------------------------------
    integer(kind=size_length) :: cubedag_tuple_disksize  ! [bytes]
    class(cubedag_tuple_t), intent(in) :: tup
    integer(kind=code_k),   intent(in) :: access
    integer(kind=code_k),   intent(in) :: location
    ! Local
    integer(kind=4) :: ier,nc
    integer(kind=8) :: onesize
    character(len=file_l) :: filename
    !
    cubedag_tuple_disksize = 0
    if (location.eq.code_buffer_memory)  return
    !
    filename = tup%filename(access,location)
    nc = len_trim(filename)
    if (gag_inquire(filename,nc).ne.0)  return
    !
    ier = gag_filsize(filename(1:nc),onesize)
    if (ier.ne.0)  return
    !
    cubedag_tuple_disksize = onesize
  end function cubedag_tuple_disksize

  function cubedag_tuple_contains(tup,file)
    !-------------------------------------------------------------------
    ! Return .true. is the tuple references the named file
    !-------------------------------------------------------------------
    logical :: cubedag_tuple_contains
    class(cubedag_tuple_t), intent(in) :: tup
    character(len=*),       intent(in) :: file
    !
    cubedag_tuple_contains = &
      gag_filsame(tup%filename(code_cube_imaset,code_buffer_disk),file) .or.  &
      gag_filsame(tup%filename(code_cube_speset,code_buffer_disk),file) .or.  &
      gag_filsame(tup%filename(code_cube_unkset,code_buffer_disk),file)
  end function cubedag_tuple_contains

end module cubedag_tuple
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
