module cubeadm_opened_types
  use cubetools_parameters
  use cubelist_types
  use cubedag_node_class
  use cubedag_link_type
  use cubeadm_messaging
  !---------------------------------------------------------------------
  ! Support types registering cubes opened (in/out) opened by a command
  !---------------------------------------------------------------------
  !
  public :: cubeadm_opened_t
  public :: cubeadm_opened_ptr
  public :: cubeadm_opened_list_t
  private
  !
  type, extends(list_object_t) :: cubeadm_opened_t
    integer(kind=code_k)                  :: status
    integer(kind=code_k)                  :: action
    character(len=argu_l)                 :: userid
    class(cubedag_node_object_t), pointer :: dno
    class(list_object_t),         pointer :: arg_or_prod
  contains
    procedure, public :: final => cubeadm_opened_final
  end type cubeadm_opened_t

  type, extends(list_t) :: cubeadm_opened_list_t
  contains
    procedure, public :: unlink  => cubeadm_opened_list_pop
    procedure, public :: to_link => cubeadm_opened_list_to_link
  end type cubeadm_opened_list_t

contains

  function cubeadm_opened_ptr(lot,error)
    !-------------------------------------------------------------------
    ! Check if the input type is a 'cubeadm_opened_t', and return a
    ! pointer to it if relevant.
    !-------------------------------------------------------------------
    type(cubeadm_opened_t), pointer :: cubeadm_opened_ptr  ! Function value on return
    class(list_object_t), pointer       :: lot
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='OPENED>PTR'
    !
    select type(lot)
    type is (cubeadm_opened_t)
      cubeadm_opened_ptr => lot
    class default
      cubeadm_opened_ptr => null()
      call cubeadm_message(seve%e,rname,'Internal error: object is not a cubeadm_opened_t')
      error = .true.
      return
    end select
  end function cubeadm_opened_ptr

  subroutine cubeadm_opened_final(obj,error)
    !-------------------------------------------------------------------
    !-------------------------------------------------------------------
    class(cubeadm_opened_t), intent(inout) :: obj
    logical,                 intent(inout) :: error
    !
  end subroutine cubeadm_opened_final

  subroutine cubeadm_opened_list_pop(op,dno,error)
    !-------------------------------------------------------------------
    ! Pop-out from the list the cubeadm_opened_t referencing the given
    ! dno
    !-------------------------------------------------------------------
    class(cubeadm_opened_list_t), intent(inout) :: op
    class(cubedag_node_object_t), pointer       :: dno
    logical,                      intent(inout) :: error
    !
    integer(kind=list_k) :: iopen,ipop
    type(cubeadm_opened_t), pointer :: obj
    !
    ipop = 0
    do iopen=1,op%n
      obj => cubeadm_opened_ptr(op%list(iopen)%p,error)
      if (error)  return
      if (associated(obj%dno,dno)) then
        ipop = iopen
        exit
      endif
    enddo
    !
    if (ipop.gt.0) then
      call op%pop(ipop,error)
      if (error)  return
    endif
  end subroutine cubeadm_opened_list_pop

  subroutine cubeadm_opened_list_to_link(op,optx,error)
    !-------------------------------------------------------------------
    ! Convert a cubeadm_opened_list_t to a cubedag_link_t
    !-------------------------------------------------------------------
    class(cubeadm_opened_list_t), intent(in)    :: op
    type(cubedag_link_t),         intent(inout) :: optx
    logical,                      intent(inout) :: error
    !
    type(cubeadm_opened_t), pointer :: opened
    integer(kind=list_k) :: iopen
    !
    call optx%reallocate(op%n,error)
    if (error)  return
    do iopen=1,op%n
      opened => cubeadm_opened_ptr(op%list(iopen)%p,error)
      if (error)  return
      call optx%associate(opened%dno,error)
      if (error)  return
    enddo
    optx%n = op%n
  end subroutine cubeadm_opened_list_to_link

end module cubeadm_opened_types
