module cubeedit_dump
  use cubetools_parameters
  use cubetools_structure
  use cubetools_keywordlist_types
  use cubetools_userspace
  use cubetools_structure
  use cubetools_userstruct
  use cube_types
  use cubeadm_cubeid_types
  use cubeedit_messaging
  !
  public :: dump
  private
  !
  type :: dump_comm_t
     type(option_t),      pointer :: comm
     type(cubeid_arg_t),  pointer :: cube
     type(option_t),      pointer :: format
     type(keywordlist_comm_t), pointer :: arg
     type(userspace_opt_t)        :: into
   contains
     procedure, public  :: register => cubeedit_dump_register
     procedure, private :: parse    => cubeedit_dump_parse
     procedure, private :: main     => cubeedit_dump_main 
  end type dump_comm_t
  type(dump_comm_t) :: dump
  !
  type dump_user_t
     type(cubeid_user_t)    :: cubeid
     character(len=16)      :: format
     type(userspace_user_t) :: userspace
   contains
     procedure, private :: toprog => cubeedit_dump_user_toprog
  end type dump_user_t
  !
  type dump_prog_t
     type(cube_t), pointer :: cube
     character(len=16)     :: format
     type(userstruct_t)    :: struct
   contains
     procedure, private :: do      => cubeedit_dump_prog_do
     procedure, private :: do_cube => cubeedit_dump_prog_do_cube
     procedure, private :: do_gdf  => cubeedit_dump_prog_do_gdf
     procedure, private :: do_fits => cubeedit_dump_prog_do_fits
  end type dump_prog_t
  !
contains
  !
  subroutine cubeedit_dump_command(line,error)
    use cubeedit_opened_types
    !-------------------------------------------------------------------
    ! Support routine for command DUMP
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(dump_user_t) :: user
    character(len=*), parameter :: rname='DUMP>COMMAND'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    call dump%parse(line,user,error)
    if (error) return
    call dump%main(user,error)
    if (error) return
  end subroutine cubeedit_dump_command
  !
  !----------------------------------------------------------------------
  !
  subroutine cubeedit_dump_register(dump,error)
    use cubedag_allflags
    !-------------------------------------------------------------------
    ! Register EDIT\DUMP and its options
    !-------------------------------------------------------------------
    class(dump_comm_t), intent(inout) :: dump
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: comm_abstract = &
         'dump cube header onto a SIC structure'
    character(len=*), parameter :: comm_help = &
         'Header can be dumped into a variable in 3 formats (see&
         & option /FORMAT). Editing the dumped header has no Effect&
         & on the actual cube header. If option /INTO is not given&
         & the parent structure will be called EDITDUMP'
    character(len=*), parameter :: formats(3)  = ['CUBE','FITS','GDF ']
    !
    type(cubeid_arg_t)   :: cubearg
    type(keywordlist_comm_t)  :: keyarg
    character(len=*), parameter :: rname='DUMP>REGISTER'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'DUMP','[cube]',&
         comm_abstract,&
         comm_help,&
         cubeedit_dump_command,&
         dump%comm,error)
    if (error) return
    call cubearg%register( &
         'CUBE', &
         'Cube from which fetch header',  &
         strg_id,&
         code_arg_optional,  &
         [flag_any], &
         code_read_head, &
         code_access_imaset_or_speset, &
         dump%cube, &
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'FORMAT','format',&
         'Define the format of the header to be dumped', &
         'The 3 available formats are: GDF, a representation of the&
         & GDF file format header; FITS a representation of the FITS&
         & header; CUBE a minimalist representation of the&
         & internal header. Formats FITS and GDF are only available&
         & for files that are FITS and GDF respectively. If option is&
         & not given default format is CUBE.',&
         dump%format,error)
    if (error) return
    call keyarg%register( &
         'format',  &
         '', &
         strg_id,&
         code_arg_mandatory, &
         formats,&
         .not.flexible,&
         dump%arg, &
         error)
    if (error) return
    !
    call dump%into%register(error)
    if (error) return
  end subroutine cubeedit_dump_register
  !
  subroutine cubeedit_dump_parse(dump,line,user,error)
    !-------------------------------------------------------------------
    ! Parse routine for command DUMP
    !-------------------------------------------------------------------
    class(dump_comm_t), intent(in)    :: dump
    character(len=*),   intent(in)    :: line
    type(dump_user_t),  intent(out)   :: user
    logical,            intent(inout) :: error
    !
    logical :: doformat
    character(len=*), parameter :: rname='DUMP>PARSE'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    call cubeadm_cubeid_parse(line,dump%comm,user%cubeid,error)
    if (error) return
    !
    user%format = 'CUBE'
    call dump%format%present(line,doformat,error)
    if (error) return
    if (doformat) then
       call cubetools_getarg(line,dump%format,1,user%format,mandatory,error)
       if (error) return
    endif
    !
    call dump%into%parse(line,user%userspace,error)
    if (error) return
  end subroutine cubeedit_dump_parse
  !
  subroutine cubeedit_dump_main(dump,user,error)
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(dump_comm_t), intent(in)    :: dump
    type(dump_user_t),  intent(in)    :: user
    logical,            intent(inout) :: error
    !
    type(dump_prog_t) :: prog
    character(len=*), parameter :: rname='DUMP>MAIN'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    call user%toprog(prog,error)
    if (error) return
    !
    call prog%do(error)
    if (error) return
  end subroutine cubeedit_dump_main
  !
  !----------------------------------------------------------------------
  !
  subroutine cubeedit_dump_user_toprog(user,prog,error)
    use cubeadm_get
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(dump_user_t), intent(in)    :: user
    type(dump_prog_t),  intent(out)   :: prog
    logical,            intent(inout) :: error
    !
    integer(kind=4) :: ikey
    character(len=*), parameter :: defvarname = 'editdump'
    character(len=*), parameter :: rname='DUMP>USER>TOPROG'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    call cubeadm_get_header(dump%cube,user%cubeid,prog%cube,error)
    if (error) return
    !
    if (user%userspace%do) then
       call dump%into%user2prog(user%userspace,prog%struct,error)
       if (error) return
       call prog%struct%def(error)
       if (error) return
    else
       call prog%struct%create(defvarname,local,overwrite_user,error)
       if (error) return
    endif
    !
    call cubetools_keywordlist_user2prog(dump%arg,user%format,ikey,prog%format,error)
    if (error) return
  end subroutine cubeedit_dump_user_toprog
  !
  !------------------------------------------------------------------------
  !
  subroutine cubeedit_dump_prog_do(prog,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(dump_prog_t), intent(inout) :: prog
    logical,            intent(inout) :: error
    !
    character(len=*), parameter :: rname='DUMP>PROG>DO'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    select case(prog%format)
    case('CUBE')
       call prog%do_cube(error)
       if (error) return
    case('FITS')
       call prog%do_fits(error)
       if (error) return
    case('GDF')
       call prog%do_gdf(error)
       if (error) return
    end select
  end subroutine cubeedit_dump_prog_do
  !
  subroutine cubeedit_dump_prog_do_gdf(prog,error)
    use gkernel_interfaces
    use cubetools_dataformat_types
    use cubeio_file
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    class(dump_prog_t), intent(inout) :: prog
    logical,            intent(inout) :: error
    !
    type(userstruct_t) :: gdf
    logical, parameter :: readwrite = .false.
    character(len=*), parameter :: rname='DUMP>PROG>DO>GDF'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    call prog%struct%def_substruct('gdf',gdf,error)
    if (error) return
    if (associated(prog%cube%tuple%current)) then
       if (prog%cube%haskind(code_dataformat_gdf)) then
          call sic_def_header(gdf%name,prog%cube%tuple%current%file%hgdf,readwrite,error)
          if (error) return
       else
          call cubeedit_message(seve%e,rname,'Cube is not a GDF file')
          error = .true.
          return
       endif
    else
       call cubeedit_message(seve%e,rname,'Internal error: No associated GDF header')
       error = .true.
       return
    endif
  end subroutine cubeedit_dump_prog_do_gdf
  !
  subroutine cubeedit_dump_prog_do_cube(prog,error)
    use cubetools_header_types
    use cubetools_header_interface
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    class(dump_prog_t), intent(inout) :: prog
    logical,            intent(inout) :: error
    !
    type(cube_header_interface_t) :: interf
    character(len=*), parameter :: rname='DUMP>PROG>DO>CUBE'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    call cubetools_header_export(prog%cube%head,interf,error)
    if (error) return
    call interf%to_struct(prog%struct,error)
    if (error) return
  end subroutine cubeedit_dump_prog_do_cube
  !
  subroutine cubeedit_dump_prog_do_fits(prog,error)
    use gkernel_types
    !-------------------------------------------------------------------
    ! 
    !-------------------------------------------------------------------
    class(dump_prog_t), intent(inout) :: prog
    logical,            intent(inout) :: error
    !
    integer(kind=4) :: icard
    type(userstruct_t) :: card,fits
    character(len=80) :: val
    character(len=varn_l) :: varname
    type(gfits_hdict_t), pointer :: gfits
    character(len=*), parameter :: rname='DUMP>PROG>DO>FITS'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    gfits => prog%cube%tuple%current%file%hfits%dict
    !
    call prog%struct%def_substruct('fits',fits,error)
    if (error) return
    if (gfits%ncard.le.0) then       
       call cubeedit_message(seve%e,rname,'Cube is not a FITS file')
       error = .true.
       return
    else
       call fits%set_member('ncard',gfits%ncard,error)
       if (error) return
    endif
    do icard=1,gfits%ncard
       call cubeedit_dump_fits_proper_varname(gfits%card(icard)%key,varname,error)
       if (error) return
       call fits%def_substruct(varname,card,error)
       if (error) return
       call cubeedit_dump_fits_remove_quotes(gfits%card(icard)%val,val,error)
       if (error) return
       call card%set_member('val',val,error)
       if (error) return
       call card%set_member('cmt',gfits%card(icard)%comment,error)
       if (error) return          
    enddo
  end subroutine cubeedit_dump_prog_do_fits
  !
  !----------------------------------------------------------------------
  !
  subroutine cubeedit_dump_fits_remove_quotes(instr,oustr,error)
    !-------------------------------------------------------------------
    ! Copies instr to oustr excluding quotes
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: instr
    character(len=*), intent(out)   :: oustr
    logical,          intent(inout) :: error
    !
    integer(kind=4) :: ichar,ochar,nchar
    character(len=*), parameter :: rname='DUMP>FITS>REMOVE>QUOTES'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    oustr = ''
    nchar = len_trim(instr)
    ochar = 1
    do ichar=1,nchar
       if (instr(ichar:ichar).eq."'") cycle
       oustr(ochar:ochar) = instr(ichar:ichar)
       ochar = ochar+1
    enddo
  end subroutine cubeedit_dump_fits_remove_quotes
  !
  subroutine cubeedit_dump_fits_proper_varname(invarname,ouvarname,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! Replace improper characters in variable name by _ using a kernel routine
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: invarname
    character(len=*), intent(out)   :: ouvarname
    logical,          intent(inout) :: error
    !
    character(len=*), parameter :: rname='DUMP>FITS>PROPER>VARNAME'
    !
    call cubeedit_message(edseve%trace,rname,'Welcome')
    !
    ouvarname = ''
    ouvarname = trim(invarname)
    call sic_underscore(ouvarname)
  end subroutine cubeedit_dump_fits_proper_varname
  !
end module cubeedit_dump
