!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubemain_header
  use cubetools_parameters
  use cubetools_structure
  use cubetools_dataformat_types
  use cubetuple_format
  use cubeadm_cubeid_types
  use cubemain_messaging
  !
  public :: header
  private
  !
  type :: header_comm_t
     type(option_t),     pointer :: comm
     type(cubeid_arg_t), pointer :: cube
     type(dataformat_opt_t)      :: format
     type(datadescr_opt_t)       :: descr
     type(option_t),     pointer :: history
   contains
     procedure, public  :: register => cubemain_header_register
     procedure, private :: parse    => cubemain_header_parse
     procedure, private :: main     => cubemain_header_main
  end type header_comm_t
  type(header_comm_t) :: header
  !
  type header_user_t
     type(cubeid_user_t)  :: cubeids
     integer(kind=code_k) :: format = code_dataformat_cube
     integer(kind=code_k) :: descr  = code_dataformat_none
     logical              :: dohistory = .false.
   contains
     procedure, private :: toprog => cubemain_header_user_toprog
  end type header_user_t
  !
  type header_prog_t
     class(format_t), pointer :: cube
     integer(kind=code_k) :: format
     integer(kind=code_k) :: descr
     logical              :: dohistory = .false.
   contains
     procedure, private :: list => cubemain_header_prog_list
  end type header_prog_t
  !
contains
  !
  subroutine cubemain_header_command(line,error)
    !-------------------------------------------------------------------
    ! Support routine for command HEADER
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(header_user_t) :: user
    character(len=*), parameter :: rname='HEADER>COMMAND'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call header%parse(line,user,error)
    if (error) return
    call header%main(user,error)
    if (error) return
  end subroutine cubemain_header_command
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_header_register(header,error)
    use cubedag_allflags
    !-------------------------------------------------------------------
    ! Register SET\HEADER command and its options
    !-------------------------------------------------------------------
    class(header_comm_t), intent(inout) :: header
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: comm_abstract = &
         'List the cube header'
    character(len=*), parameter :: comm_help = &
         'The header can be shown in different formats by using&
         & option /FORMAT'
    !
    type(cubeid_arg_t) :: cubearg
    character(len=*), parameter :: rname='HEADER>REGISTER'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'HEADER','[cube]',&
         comm_abstract,&
         comm_help,&
         cubemain_header_command,&
         header%comm,error)
    if (error) return
    call cubearg%register( &
         'CUBE', &
         'Signal cube',  &
         strg_id,&
         code_arg_optional,  &
         [flag_any], &
         code_read_head, &
         code_access_any, &
         header%cube, &
         error)
    if (error) return
    !
    call header%format%register(error)
    if (error) return
    !
    call header%descr%register(error)
    if (error) return
    !
    call cubetools_register_option(&
         'HISTORY','',&
         'In addition to the header, also display the cube ancestors',&
         strg_id,&
         header%history,error)
    if (error) return
  end subroutine cubemain_header_register
  !
  subroutine cubemain_header_parse(header,line,user,error)
    !-------------------------------------------------------------------
    ! Parsing facility for command
    !   HEADER name
    !   /FORMAT Format
    !   /DESCR  Format
    !-------------------------------------------------------------------
    class(header_comm_t), intent(in)    :: header
    character(len=*),     intent(in)    :: line
    type(header_user_t),  intent(out)   :: user
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='HEADER>PARSE'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_parse(line,header%comm,user%cubeids,error)
    if (error) return
    !
    call header%format%parse(line,user%format,error)
    if (error) return
    call header%descr%parse(line,user%descr,error)
    if (error) return
    call header%history%present(line,user%dohistory,error)
    if (error) return
  end subroutine cubemain_header_parse
  !
  subroutine cubemain_header_main(header,user,error)
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    class(header_comm_t), intent(in)    :: header
    type(header_user_t),  intent(in)    :: user
    logical,              intent(inout) :: error
    !
    type(header_prog_t) :: prog
    character(len=*), parameter :: rname='HEADER>MAIN'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    call user%toprog(prog,error)
    if (error) return
    call prog%list(error)
    if (error) return
  end subroutine cubemain_header_main
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_header_user_toprog(user,prog,error)
    use cubeadm_get
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(header_user_t), intent(in)    :: user
    type(header_prog_t),  intent(out)   :: prog
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='HEADER>USER>TOPROG'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    prog%format = user%format
    prog%descr = user%descr
    prog%dohistory = user%dohistory
    !
    if (prog%descr.eq.code_dataformat_none) then
      ! /DESCR was omitted => /FORMAT invoked or implicit => need a cube header
      call cubeadm_get_fheader(header%cube,user%cubeids,prog%cube,error)
      if (error) return
    endif
  end subroutine cubemain_header_user_toprog
  !
  !----------------------------------------------------------------------
  !
  subroutine cubemain_header_prog_list(prog,error)
    use cubetools_header_vo
    use cubeadm_history, only: cubeadm_history_docube
    use cubedag_tuple
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(header_prog_t), intent(inout) :: prog
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='HEADER>PROG>LIST'
    !
    call cubemain_message(mainseve%trace,rname,'Welcome')
    !
    if (prog%descr.ne.code_dataformat_none) then
      ! /DESCR invoked
      select case (prog%descr)
      case (code_dataformat_vo)
        call cubetools_header_vodesc_list(error)
        if (error)  return
      case default
        call cubemain_message(seve%w,rname,'Description is not available for this format')
      end select
      return  ! Always
    endif
    !
    if (prog%format.ne.code_dataformat_vo) then
      call prog%cube%node%tuple%list(prog%cube%node%id,prog%cube%node%family,&
          prog%cube%node%flag,error)
      if (error) return
    endif
    call prog%cube%list(prog%format,error)
    if (error) return
    if (prog%dohistory) then
      call cubemain_message(seve%r,rname,blankstr)
      call cubeadm_history_docube(prog%cube%get_id(),error)
      if (error) return
    endif
  end subroutine cubemain_header_prog_list
  !
end module cubemain_header
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
