module cubeadm_update
  use cubetools_structure
  use cubedag_allflags
  use cubetuple_format
  use cubeadm_messaging
  use cubeadm_cubeid_types
  !
  public :: cubeadm_update_command,cubeadm_update_register
  private
  !
  integer(kind=4), parameter :: icube =1
  type :: update_comm_t
     type(option_t),      pointer :: update 
     type(option_t),      pointer :: flag
     type(option_t),      pointer :: family 
  end type update_comm_t
  type(update_comm_t) :: comm
  !
  type update_user_t
     type(cubeid_user_t)   :: id
     character(len=argu_l) :: family
     logical               :: dofamily
     character(len=argu_l) :: flags
     logical               :: doflag
  end type update_user_t
  !
  !
  ! UPDATE currid /FLAG +-= progflag,progflag,progflag  ! Here order matter
  !               /TAG  +-= usertag,usertag,usertag  ! Here order does not matter
  !               /FAMILY family
contains
  !
  subroutine cubeadm_update_register(error)
    use cubedag_parameters
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    logical, intent(inout) :: error
    !
    type(cubeid_arg_t) :: cubearg
    type(standard_arg_t) :: stdarg
    character(len=*), parameter :: comm_abstract = &
         'Update family name and/or flags'
    character(len=*), parameter :: comm_help = &
         strg_id
    character(len=*), parameter :: rname = 'UPDATE>REGISTER'
    !
    call cubeadm_message(admseve%trace,rname,'welcome')
    !
    call cubetools_register_command(&
         'UPDATE','[cube]',&
         comm_abstract,&
         comm_help,&
         cubeadm_update_command,&
         comm%update,error)
    if (error) return
    call cubearg%register( &
         'CUBE', &
         'Cube to be updated',  &
         strg_id,&
         code_arg_optional,  &
         [flag_any], &
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'FAMILY','NewFamily',&
         'Specify new family name',&
         strg_id,&
         comm%family,error)
    if (error) return
    call stdarg%register( &
         'NewFamily', &
         'New family name',  &
         strg_id,&
         code_arg_optional,  &
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'FLAG','flag1,...,flagn',&
         'Specify new flag(s)',&
         'ATTENTION: The order of the flags is important. To see a&
         & list of all available flags use ADM\FLAGLIST',&
         comm%flag,error)
    if (error) return
    call stdarg%register( &
         'flag', &
         'New flag(s)',  &
         strg_id,&
         code_arg_optional,  &
         error)
    if (error) return
  end subroutine cubeadm_update_register
  !
  subroutine cubeadm_update_command(line,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(update_user_t) :: user
    character(len=*), parameter :: rname = 'UPDATE>COMMAND'
    !
    call cubeadm_message(admseve%trace,rname,'welcome')
    !
    call cubeadm_update_parse(line,user,error)
    if (error) return
    call cubeadm_update_main(user,error)
    if (error) return
  end subroutine cubeadm_update_command
  !
  subroutine cubeadm_update_parse(line,user,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*),    intent(in)    :: line
    type(update_user_t), intent(out)   :: user
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname = 'UPDATE>PARSE'
    !
    call cubeadm_message(admseve%trace,rname,'welcome')
    !
    call cubeadm_cubeid_parse(line,comm%update,user%id,error)
    if (error) return
    !
    call comm%family%present(line,user%dofamily,error)
    if (error) return
    if (user%dofamily) then
       call cubetools_getarg(line,comm%family,1,user%family,mandatory,error)
       if (error) return
    endif
    call comm%flag%present(line,user%doflag,error)
    if (error) return
    if (user%doflag) then
       call cubetools_getarg(line,comm%flag,1,user%flags,mandatory,error)
       if (error) return
    endif
  end subroutine cubeadm_update_parse
  !
  subroutine cubeadm_update_main(user,error)
    use cubeadm_get
    use cubedag_node
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(update_user_t), intent(in)    :: user
    logical,             intent(inout) :: error
    !
    logical :: dojob
    type(flag_t), allocatable :: flags(:)
    class(format_t), pointer :: format
    character(len=*), parameter :: rname = 'UPDATE>MAIN'
    !
    call cubeadm_message(admseve%trace,rname,'welcome')
    !
    dojob = user%dofamily.or.user%doflag
    if (.not.dojob) then
       call cubeadm_message(seve%w,rname,'Nothing to do')
       return
    endif
    !
    call cubeadm_get_fheader(comm%update,icube,user%id,code_access_imaset_or_speset,&
         code_read_head,format,error)
    if (error) return
    !
    if (user%doflag) then
       call cubedag_string_toflaglist(user%flags,flags,error)
       if (error) return
       call cubedag_node_set_flags(format,flags,error)
       if (error)  return
    endif
    !
    if (user%dofamily) then
       call cubedag_node_set_family(format,user%family,error)
       if (error)  return
    endif
    !
  end subroutine cubeadm_update_main
end module cubeadm_update
