!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubeadm_import
  use cubetools_structure
  use cubetools_keywordlist_types
  use cubedag_parameters
  use cubedag_link_type
  use cubedag_node_type
  use cubedag_node
  use cubedag_dag
  use cubeadm_messaging
  use cubeadm_directory_type
  use cubeadm_setup
  !
  type(cubedag_link_t) :: im  ! List of imported cubes
  type(cubedag_link_t) :: tw  ! List of current twins
  !
  public :: import
  private
  !
  type :: import_comm_t
     type(option_t),      pointer :: comm
     type(option_t),      pointer :: hdu
     type(option_t),      pointer :: mapping
     type(option_t),      pointer :: class
     type(option_t),      pointer :: optparse
     type(option_t),      pointer :: sort
     type(keywordlist_comm_t), pointer :: sort_arg
     type(option_t),      pointer :: verbose
  contains
     procedure, public  :: register => cubeadm_import_register
     procedure, private :: parse    => cubeadm_import_parse
     procedure, private :: main     => cubeadm_import_main
  end type import_comm_t
  type(import_comm_t) :: import
  !
  integer(kind=4), parameter :: fits_primary_hdu=1
  !
  integer(kind=code_k), parameter :: sort_none=1
  integer(kind=code_k), parameter :: sort_chro=2
  integer(kind=code_k), parameter :: sort_alph=3
  integer(kind=4), parameter :: nsort=3
  character(len=*), parameter :: sort_names(nsort) = &
    (/ 'NONE         ','CHRONOLOGICAL','ALPHABETICAL ' /)
  !
  type import_user_t
     character(len=file_l), allocatable :: argum(:)
     character(len=8)  :: hdu       = strg_star
     logical           :: domapping = .false.
     logical           :: doclass   = .false.
     logical           :: doparse   = .false.
     character(len=1)  :: parse_sep = '-'
     character(len=24) :: sort      = strg_star
     logical           :: doverbose = .false.
  contains
     procedure, private :: toprog => cubeadm_import_user_toprog
  end type import_user_t
  !
  type import_prog_t
    character(len=commandline_length)  :: line      ! Full command line to be inserted in history
    character(len=file_l), allocatable :: argum(:)  ! Arguments to be imported
    integer(kind=4)      :: seve       ! Severity of /VERBOSE messages
    logical              :: allhdus    ! Import all HDUs?
    integer(kind=4)      :: onehdu     ! If not all HDUs, which one?
    logical              :: domapping
    logical              :: doclass
    logical              :: doparse    ! /PARSE enabled?
    character(len=1)     :: parse_sep  ! /PARSE separator if option is enabled
    integer(kind=code_k) :: sort
  contains
    procedure, private :: act       => cubeadm_import_act
    procedure, private :: argument  => cubeadm_import_argument
    procedure, private :: pattern   => cubeadm_import_pattern
    procedure, private :: directory => cubeadm_import_directory
    procedure, private :: file      => cubeadm_import_onefile
    procedure, private :: cube      => cubeadm_import_onecube
  end type import_prog_t
  !
contains
  !
  subroutine cubeadm_import_register(import,error)
    !---------------------------------------------------------------------
    ! 
    !---------------------------------------------------------------------
    class(import_comm_t), intent(inout) :: import
    logical,              intent(inout) :: error
    !
    type(standard_arg_t) :: stdarg
    type(keywordlist_comm_t) :: keyarg
    character(len=*), parameter :: comm_abstract = &
         'Import files into the DAG'
    character(len=*), parameter :: comm_help = &
         'With a file pattern as argument (e.g. raw/*{.lmv|.fits}),&
         & import files using this pattern (pattern is assumed&
         & relative from current directory, if relevant).'&
         & //strg_cr//strg_cr//&
         &'With a&
         & directory name as argument, import all files (*.*, only&
         & Gildas Data Format or FITS format files are imported) from&
         & this directory (no recursion).'&
         & //strg_cr//strg_cr//&
         & 'Several arguments can be present, for example:'&
         & //strg_cr//&
         &'  CUBE> import file1.fits file2.fits'&
         & //strg_cr//&
         &'but also when invoking CUBE from the shell, e.g.'&
         & //strg_cr//&
         &'  shell> cube import *'&
         & //strg_cr//&
         &'where the shell replaces the wilcard with all the matching&
         & files before executing CUBE.'&
         & //strg_cr//strg_cr//&
         & 'Without argument, import files from the RAW directory(ies).'
    character(len=*), parameter :: rname='IMPORT>REGISTER'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    call cubetools_register_command(&
         'IMPORT','[Directory|FilePattern]',&
         comm_abstract,&
         comm_help,&
         cubeadm_import_command,&
         import%comm,error)
    if (error) return
    call stdarg%register( &
         'Target',  &
         'Import target, a directory or a File Pattern', &
         strg_id,&
         code_arg_unlimited, &
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'HDU','Number',&
         'Specify the FITS HDU to be imported',&
         'Use * to import all possible images or cubes. Default is 1 (Primary HDU only).',&
         import%hdu,error)
    if (error) return
    call stdarg%register( &
         'HDU Number',  &
         'FITS HDU number', &
         'Default is 1 (Primary).',&
         code_arg_optional, &
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'MAPPING','',&
         'Import MAPPING files with flags based on extension',&
         'This option is ignored if the file header provides its own flags.',&
         import%mapping,error)
    if (error) return
    !
    call cubetools_register_option(&
         'CLASS','',&
         'Import CLASS files with flags based on extension',&
         'This option is ignored if the file header provides its own flags.',&
         import%class,error)
    if (error) return
    !
    call cubetools_register_option(&
         'PARSE','Separator',&
         'Split the file base name into family and flags',&
         'The computed flags are ignored if the file header provides its own '//&
         'flags. Without this option, the whole base name is used as family name.',&
         import%optparse,error)
    if (error) return
    call stdarg%register( &
         'Separator',  &
         'Single character separator in file base name', &
         'Default is "-".',&
         code_arg_optional, &
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'SORT','Mode',&
         'Specify the sorting order of imported files',&
         'Without this option, sorting is done in chronological order.',&
         import%sort,error)
    if (error) return
    call keyarg%register( &
         'Mode',  &
         'Sorting mode', &
         strg_id,&
         code_arg_mandatory, &
         sort_names, &
         .not.flexible, &
         import%sort_arg,&
         error)
    if (error) return
    !
    call cubetools_register_option(&
         'VERBOSE','',&
         'Indicate which files are imported or skipped',&
         strg_id,&
         import%verbose,error)
    if (error) return
  end subroutine cubeadm_import_register
  !
  subroutine cubeadm_import_command(line,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(import_user_t) :: user
    character(len=*), parameter :: rname='IMPORT>COMMAND'
    !
    call cubeadm_message(admseve%trace,rname,'welcome')
    !
    call import%parse(line,user,error)
    if (error) return
    call import%main(user,line,error)
    if (error) return
  end subroutine cubeadm_import_command
  !
  subroutine cubeadm_import_parse(comm,line,user,error)
    use gkernel_interfaces
    !---------------------------------------------------------------------
    ! Support routine for command:
    !   IMPORT
    !   IMPORT Directory
    !   IMPORT Pattern
    !---------------------------------------------------------------------
    class(import_comm_t), intent(in)    :: comm
    character(len=*),     intent(in)    :: line
    type(import_user_t),  intent(out)   :: user
    logical,              intent(inout) :: error
    !
    integer(kind=4) :: narg,iarg,ier
    logical :: dosort
    character(len=*), parameter :: rname='IMPORT>COMMAND'
    !
    ! Command arguments
    narg = import%comm%getnarg()  ! Can be 0 = no argument
    allocate(user%argum(narg),stat=ier)
    if (failed_allocate(rname,'arguments',ier,error)) return
    do iarg=1,narg
      call cubetools_getarg(line,import%comm,iarg,user%argum(iarg),mandatory,error)
      if (error) return
    enddo
    !
    ! /HDU
    call cubetools_getarg(line,import%hdu,1,user%hdu,.not.mandatory,error)
    if (error)  return
    !
    ! /MAPPING or /CLASS
    call import%mapping%present(line,user%domapping,error)
    if (error) return
    call import%class%present(line,user%doclass,error)
    if (error) return
    if (user%domapping.and.user%doclass) then
       call cubeadm_message(seve%e,rname,'Options /MAPPING and /CLASS conflict with each other')
       error = .true.
       return
    endif
    !
    ! /VERBOSE
    call import%verbose%present(line,user%doverbose,error)
    if (error) return
    !
    ! /PARSE
    call import%optparse%present(line,user%doparse,error)
    if (error) return
    if (user%doparse) then
      call cubetools_getarg(line,import%optparse,1,user%parse_sep,.not.mandatory,error)
      if (error)  return
    endif
    !
    ! /SORT
    call import%sort%present(line,dosort,error)
    if (error) return
    if (dosort) then
      call cubetools_getarg(line,import%sort,1,user%sort,mandatory,error)
      if (error) return
    else
      user%sort = strg_star
    endif
  end subroutine cubeadm_import_parse
  !
  subroutine cubeadm_import_main(import,user,line,error)
    !----------------------------------------------------------------------
    ! Import all arguments passed to the command, create CX, and terminate
    ! command.
    !----------------------------------------------------------------------
    class(import_comm_t), intent(in)    :: import
    type(import_user_t),  intent(in)    :: user
    character(len=*),     intent(in)    :: line
    logical,              intent(inout) :: error
    !
    type(import_prog_t) :: prog
    character(len=*), parameter :: rname='IMPORT>MAIN'
    !
    call user%toprog(line,prog,error)
    if (error)  return
    call prog%act(error)
    if (error)  return
  end subroutine cubeadm_import_main
  !
  subroutine cubeadm_import_act(prog,error)
    use cubedag_find
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(import_prog_t), intent(in)    :: prog
    logical,              intent(inout) :: error
    !
    logical :: do_cx
    integer(kind=4) :: iarg
    type(find_prog_t) :: criter
    character(len=*), parameter :: rname='IMPORT>MAIN'
    !
    do_cx = .false.
    !
    do iarg=1,size(prog%argum)
      call prog%argument(prog%argum(iarg),do_cx,error)
      if (error)  return
    enddo
    !
    if (do_cx) then
      ! Implicitly FIND everything in current index
      call criter%ix2cx(error)
      if (error) return
    endif
    !
    ! Insert in history
    call cubeadm_imported_flush_nodes(prog%line,error)
    if (error)  return
  end subroutine cubeadm_import_act
  !
  subroutine cubeadm_import_user_toprog(user,line,prog,error)
    use gkernel_interfaces
    use cubetools_string
    !-------------------------------------------------------------------
    !
    !-------------------------------------------------------------------
    class(import_user_t), intent(in)    :: user
    character(len=*),     intent(in)    :: line
    type(import_prog_t),  intent(inout) :: prog
    logical,              intent(inout) :: error
    !
    integer(kind=4) :: iarg,narg,ier
    character(len=argu_l) :: key
    character(len=*), parameter :: rname='IMPORT>USER>TOPROG'
    !
    call cubeadm_message(admseve%trace,rname,'Welcome')
    !
    prog%line = line
    !
    ! Command arguments
    if (size(user%argum).le.0) then
      ! No argument provided: import from dir%raw
      call cubetools_string_split(dir%raw,';',prog%argum,error)
      if (error)  return
    else
      ! Fetch user arguments
      narg = size(user%argum)
      allocate(prog%argum(narg),stat=ier)
      if (failed_allocate(rname,'arguments',ier,error)) return
      do iarg=1,narg
        prog%argum(iarg) = user%argum(iarg)
      enddo
    endif
    !
    if (user%doverbose) then
      prog%seve = seve%i
    else
      prog%seve = seve%d
    endif
    !
    prog%allhdus = user%hdu.eq.strg_star
    if (prog%allhdus) then
      prog%onehdu = 0  ! Unused
    else
      read(user%hdu,*) prog%onehdu
    endif
    !
    prog%domapping = user%domapping
    prog%doclass   = user%doclass
    prog%doparse   = user%doparse
    prog%parse_sep = user%parse_sep
    !
    if (user%sort.eq.strg_star) then
      prog%sort = sort_chro
    else
      call cubetools_keywordlist_user2prog(import%sort_arg,user%sort,prog%sort,key,error)
      if (error) return
    endif
  end subroutine cubeadm_import_user_toprog
  !
  subroutine cubeadm_import_argument(prog,argum,do_cx,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    ! Process 1 argument passed to the command
    !----------------------------------------------------------------------
    class(import_prog_t), intent(in)    :: prog
    character(len=*),     intent(in)    :: argum
    logical,              intent(inout) :: do_cx
    logical,              intent(inout) :: error
    !
    integer(kind=4) :: nc
    logical :: skipped
    character(len=*), parameter :: rname='IMPORT>ARGUMENT'
    !
    call cubeadm_message(admseve%trace,rname,'welcome')
    !
    nc = len_trim(argum)
    if (gag_isdir(argum(1:nc)).eq.0) then
       ! A directory
       do_cx = cubset%index%default.eq.code_index_current
       call prog%directory(argum,nc,error)
    elseif (gag_inquire(argum,nc).eq.0) then
       ! A file. Note it can contain unfriendly characters (space, parentheses, etc).
       do_cx = cubset%index%default.eq.code_index_current
       call prog%file(argum,skipped,error)
    elseif (gag_exists(argum(1:nc))) then
       ! Try a pattern. Unfriendly characters badly supported.
       do_cx = cubset%index%default.eq.code_index_current
       call prog%pattern(argum,error)
    else
       ! Resolves as nothing in the shell!
       call cubeadm_message(seve%w,rname,'No such file or directory '''//argum(1:nc)//'''')
    endif
    if (error) return
  end subroutine cubeadm_import_argument
  !
  function gag_exists(pattern)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! Return .true. if the pattern resolves as some file(s) or
    ! directory(ies) resolved by the shell.
    !-------------------------------------------------------------------
    logical :: gag_exists
    character(len=*), intent(in) :: pattern
    !
    integer(kind=4) :: nfile
    character(len=file_l), allocatable :: filelist(:)
    logical :: error
    !
    gag_exists = .false.
    !
    ! No better way to invoke a subroutine which translates the
    ! shell-dependant syntax (e.g. *, ?, ... for bash). The pattern
    ! is passed "as is":
    !  - exact directory name            => return the same exact name (not its contents)
    !  - exact file name                 => return the same exact name
    !  - wilcarded directory name        => return the expanded directory name (not its contents)
    !  - wilcarded file      name        => return the expanded file name
    !  - exact but non-existent name     => return empty list
    !  - wilcarded but non-existent name => return empty list
    ! (wilcarded combinations on existing material are possible).
    !
    error = .false.
    call gag_directory('.',pattern,filelist,nfile,error)
    if (error) return
    gag_exists = nfile.gt.0
  end function gag_exists
  !
  subroutine cubeadm_import_directory(prog,dirname,nc,error)
    !---------------------------------------------------------------------
    ! Import *.* files from a directory into the DAG
    !---------------------------------------------------------------------
    class(import_prog_t), intent(in)    :: prog
    character(len=*),     intent(in)    :: dirname
    integer(kind=4),      intent(in)    :: nc
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='IMPORT>DIRECTORY'
    !
    if (dirname(nc:nc).eq.'/') then
      call prog%pattern(dirname(1:nc)//'*.*',error)
    else
      call prog%pattern(dirname(1:nc)//'/*.*',error)
    endif
    if (error) return
  end subroutine cubeadm_import_directory
  !
  recursive subroutine cubeadm_import_pattern(prog,pattern,error)
    use gkernel_types
    use gkernel_interfaces
    !---------------------------------------------------------------------
    ! Import files given a pattern into the DAG
    !---------------------------------------------------------------------
    class(import_prog_t), intent(in)    :: prog
    character(len=*),     intent(in)    :: pattern
    logical,              intent(inout) :: error
    !
    integer(kind=4) :: nfile,ifile,nimported,nskipped,nc,myseve
    logical :: skipped
    character(len=file_l), allocatable :: filelist(:)
    character(len=mess_l) :: mess
    type(time_t) :: time
    character(len=*), parameter :: rname='IMPORT>PATTERN'
    !
    ! Get the file names and sorting array
    call gag_directory('.',trim(pattern),filelist,nfile,error)
    if (error) return
    call cubeadm_import_sort(filelist,nfile,prog%sort,error)
    if (error)  return
    !
    call gtime_init(time,nfile,error)
    if (error) return
    !
    ! Import the GDF and FITS files in the DAG
    nimported = 0
    nskipped = 0
    do ifile=1,nfile
      call gtime_current(time)
      nc = len_trim(filelist(ifile))
      if (gag_isdir(filelist(ifile)(1:nc)).eq.0) then
        ! This is a directory. NB: this is not precisely a recursion
        ! as cubeadm_import_directory imports "somedir/*.*"
        call cubeadm_message(prog%seve,rname,'Importing directory '//filelist(ifile)(1:nc))
        call prog%directory(filelist(ifile),nc,error)
        if (error) error = .false.  ! Skip errors indexing file
      else
        ! This is not a directory (regular file...)
        call prog%file(filelist(ifile),skipped,error)
        if (error) error = .false.  ! Skip errors indexing file
        if (skipped) then ! Duplicate or not supported kind
          nskipped = nskipped+1
        else
          nimported = nimported+1
        endif
      endif
    enddo
    deallocate(filelist)
    !
    write(mess,'(I0,A,A)')  nimported,' new file(s) imported from ',trim(pattern)
    if (nimported.le.0) then
      myseve = seve%w
    else
      myseve = seve%i
    endif
    if (nskipped.gt.0)  &
      write(mess,'(A,A,I0,A)')  trim(mess),', skipped ',nskipped,' file(s)'
    call cubeadm_message(myseve,rname,mess)
  end subroutine cubeadm_import_pattern
  !
  subroutine cubeadm_import_sort(filelist,nfile,sortmode,error)
    use gkernel_interfaces
    !-------------------------------------------------------------------
    ! Sort the file-list in-place according to sorting mode
    !-------------------------------------------------------------------
    integer(kind=4),      intent(in)    :: nfile
    character(len=*),     intent(inout) :: filelist(nfile)
    integer(kind=code_k), intent(in)    :: sortmode
    logical,              intent(inout) :: error
    !
    integer(kind=4) :: ifile,ier,nc
    integer(kind=4), allocatable :: sort(:)
    character(len=file_l), allocatable :: tmp(:)
    integer(kind=8), allocatable :: mtime(:)
    character(len=*), parameter :: rname='IMPORT>GETSORT'
    !
    nc = len(filelist(1))
    !
    select case (sortmode)
    case (sort_none)
      return
      !
    case (sort_chro)
      ! Get the file dates
      allocate(mtime(nfile))
      do ifile=1,nfile
        ier = gag_mtime(filelist(ifile),mtime(ifile))
        if (ier.ne.0) then
          call cubeadm_message(seve%w,rname,'Error evaluating date of file '//filelist(ifile))
          mtime(ifile) = 0
        endif
      enddo
      ! Compute sorting array
      allocate(sort(nfile))
      call gi8_trie(mtime,sort,nfile,error)
      if (error)  return
      deallocate(mtime)
      ! Sort the character array
      allocate(tmp(nfile))
      call gch_sort(filelist,tmp,sort,nc,nfile)
      deallocate(sort,tmp)
      !
    case (sort_alph)
      allocate(sort(nfile))
      call gch_trie(filelist,sort,nfile,nc,error)
      if (error)  return
      deallocate(sort)
    end select
  end subroutine cubeadm_import_sort
  !
  subroutine cubeadm_import_onefile(prog,filename,skipped,error)
    use gkernel_interfaces
    use cubefitsio_header
    !-------------------------------------------------------------------
    ! Try to import the named file
    !-------------------------------------------------------------------
    class(import_prog_t), intent(in)    :: prog
    character(len=*),     intent(in)    :: filename
    logical,              intent(out)   :: skipped
    logical,              intent(inout) :: error
    !
    integer(kind=4) :: nc,filekind,ihdu,fhdu,lhdu
    logical :: done
    character(len=*), parameter :: rname='IMPORT>ONEFILE'
    !
    nc = len_trim(filename)
    !
    call gag_file_guess(rname,filename,filekind,error)
    if (error) error = .false.  ! Skip errors indexing file
    !
    if (filekind.ne.1 .and. filekind.ne.2) then
      call cubeadm_message(prog%seve,rname,  &
        'Skipping non-GDF/non-FITS file '//filename(1:nc))
      skipped = .true.
      return
    endif
    !
    ! Which HDU range?
    if (prog%allhdus) then
      select case (filekind)
      case (1)  ! GDF
        fhdu = 1
        lhdu = 1
      case (2)  ! FITS
        fhdu = 1
        call cubefitsio_file_nhdu(filename,lhdu,error)
        if (error) then
          error = .false.
          skipped = .true.
          return
        endif
      end select
    else
      fhdu = prog%onehdu
      lhdu = prog%onehdu
    endif
    !
    ! Loop on HDUs
    done = .false.
    do ihdu=fhdu,lhdu
      call prog%cube(filename(1:nc),ihdu,skipped,error)
      if (error) then
        error = .false.
        cycle
      endif
      if (.not.skipped)  done = .true.
    enddo
    if (done) then  ! At least 1 HDU imported
      skipped = .false.
      call cubeadm_imported_flush_twins(error)
      if (error)  return
    endif
  end subroutine cubeadm_import_onefile
  !
  subroutine cubeadm_import_onecube(prog,filename,ihdu,skipped,error)
    use cube_types
    use cubedag_flag
    use cubedag_allflags
    use cubedag_tuple
    use cubeio_file
    use cubetuple_format
    use cubetuple_uv
    use cubeadm_engine_types
    use cubeadm_setup
    !---------------------------------------------------------------------
    !
    !---------------------------------------------------------------------
    class(import_prog_t), intent(in)    :: prog
    character(len=*),     intent(in)    :: filename
    integer(kind=4),      intent(in)    :: ihdu
    logical,              intent(out)   :: skipped
    logical,              intent(inout) :: error
    !
    character(len=base_l) :: family,cubeid
    character(len=file_l) :: fullname
    type(flag_t), allocatable :: flags(:)
    integer(kind=code_k) :: code_ftype
    type(cubeio_file_t), pointer :: file
    type(cube_t), pointer :: cube
    class(format_t), pointer :: fo
    class(cubedag_node_object_t), pointer :: dno
    character(len=*), parameter :: rname='IMPORT>ONECUBE'
    !
    write(fullname,'(2a,i0,a)')  trim(filename),'[',ihdu,']'
    skipped = .true.
    !
    if (cubedag_dag_contains(filename,ihdu)) then
      call cubeadm_message(prog%seve,rname,'Skipping cube already in DAG '//fullname)
      return
    endif
    !
    ! A word on flags associated to the imported cube. They can have
    ! several origins:
    ! 1a - Reading the file header (CUBE writes FITS with dedicated
    !      keywords for flags). It has precedence if available.
    ! 1b - Still in case of FITS, if the dedicated keywords are not
    !      found, the flags based on the HDU kind and name are used.
    ! 2a - Parsing the file base name (IMPORT /PARSE) for symetry with
    !      EXPORT,
    ! 2b - Parsing the file extention (IMPORT /MAPPING|/CLASS);
    !      2a can be combined with 2b,
    ! 4 -  Some default flag as fallback.
    !
    call cubeadm_import_default_familyflags(prog,filename,family,flags,cubeid,error)
    if (error)  return
    !
    file => file_allocate_new(error)
    if (error) return
    call file%read_header(filename,ihdu,cubeid,error)
    if (error) then
      call file%free(error)
      deallocate(file)
      return
    endif
    !
    cube => null()
    if (file%is_cube()) then
      code_ftype = code_ftype_cube
      cube => cube_allocate_new(cubset,error)
      if (error) return
      fo => cube
    elseif (file%is_uvt()) then
      code_ftype = code_ftype_uv
      fo => uv_allocate_new(cubset,error)
      if (error) return
    else
      ! Clean before skipping
      call cubeadm_message(prog%seve,rname,'Skipping non-cube/non-UVT file '//fullname)
      call file%close(error)
      call file%free(error)
      deallocate(file)
      return
    endif
    call fo%attach_file(file,error)
    if (error) return
    !
    ! Fix the header, if relevant
    if (associated(cube)) then
      call cube%default_order(error)
      if (error)  return
    endif
    !
    ! Attach a new cube to the DAG and set its attributes
    dno => fo
    call cubedag_dag_newbranch(dno,code_ftype,error)
    if (error) return
    call cubedag_node_set_origin(dno,code_origin_imported,error)
    if (error) return
    call cubeadm_import_actual_family(prog,family,fo,error)
    if (error) return
    call cubeadm_import_actual_flags(prog,flags,fo,error)
    if (error) return
    call cubedag_tuple_upsert(fo%node%tuple,fo%order(),code_buffer_disk,  &
      filename,ihdu,error)
    if (error) return
    !
    ! Need some cleaning. At least the GIO slots. We could go through
    ! the cubeadm_finish_all at the end of the command execution, but
    ! IMPORT can open hundreds of cubes, and GIO slots are more limited
    ! than this. We have to avoid accumulating them:
    call file%close(error)
    if (error) return
    !
    call cubeadm_imported_add_node(dno)  ! Fill list of all cubes imported
    call cubeadm_imported_add_twin(dno)  ! Fill list of current twins imported
    !
    call fo%node%tuple%location(fo%order(),code_buffer_disk,fullname)
    call cubeadm_message(prog%seve,rname,'Importing file '//fullname)
    skipped = .false.
  end subroutine cubeadm_import_onecube
  !
  subroutine cubeadm_import_default_familyflags(prog,filename,  &
    family,flags,cubeid,error)
    use gkernel_interfaces
    use cubedag_flag
    use cubedag_allflags
    use cubeadm_cubeid_types
    !-------------------------------------------------------------------
    ! Create the default family, flags, and cubeid based on file name
    ! and parsing option.
    ! Note that this might not be the final family and flags attached to
    ! the cube, since the file header might provide its own ones.
    !-------------------------------------------------------------------
    type(import_prog_t), intent(in)    :: prog
    character(len=*),    intent(in)    :: filename
    character(len=*),    intent(out)   :: family
    type(flag_t),        allocatable   :: flags(:)
    character(len=*),    intent(out)   :: cubeid
    logical,             intent(inout) :: error
    !
    character(len=base_l) :: filebase
    character(len=exte_l) :: fileext
    type(flag_t), allocatable :: baseflags(:),extflags(:)
    type(flag_t) :: noflag(0)
    integer(kind=4) :: pos
    !
    call sic_parse_name(filename,filebase,fileext)
    !
    ! Flags from the basename
    if (prog%doparse) then
      pos = index(filebase,prog%parse_sep)
      if (pos.gt.0) then
        call cubedag_string_toflaglist(filebase(pos+1:),.true.,baseflags, &
             error,sep=prog%parse_sep)
        if (error)  return
        filebase(pos:) = ''  ! Drop the parsed flags
      else
        ! filebase unchanged
        ! baseflags remains unallocated
      endif
    endif
    family = filebase
    !
    ! Flags from the extension
    if (prog%domapping) then
       call cubedag_mapping_ext2flag(fileext,extflags,error)
       if (error) return
    else if (prog%doclass) then
       call cubedag_class_ext2flag(fileext,extflags,error)
       if (error) return
    else
       ! No special flags
    endif
    !
    ! Merge baseflags+extflags
    if (.not.allocated(baseflags))  call cubeadm_import_reallocate_flags(baseflags,noflag,error)
    if (.not.allocated(extflags))   call cubeadm_import_reallocate_flags(extflags,noflag,error)
    if (size(baseflags)+size(extflags).gt.0) then
      call cubeadm_import_reallocate_flags(flags,[baseflags,extflags],error)
      if (error)  return
    else
      ! Allocate empty list of flags. It will be improved after the file
      ! header is actually read.
      call cubeadm_import_reallocate_flags(flags,noflag,error)
      if (error)  return
    endif
    !
    ! Create a cubeid (for feedback) from these default family and flags
    if (size(flags).gt.0) then
      call cubeadm_cubeid_familyflags2string(family,flags,cubeid,error)
      if (error) return
    else
      ! Put a 'cube' flag as poor-man solution. Avoid 'unknown' which can be
      ! misleading.
      call cubeadm_cubeid_familyflags2string(family,[flag_cube],cubeid,error)
      if (error) return
    endif
  end subroutine cubeadm_import_default_familyflags
  !
  subroutine cubeadm_import_actual_family(prog,deffamily,fo,error)
    use cubetuple_format
    !-------------------------------------------------------------------
    ! Set the node family name, if not yet done at read header time
    !-------------------------------------------------------------------
    type(import_prog_t), intent(in)    :: prog
    character(len=*),    intent(in)    :: deffamily  ! Default family to be applied
    class(format_t),     intent(inout) :: fo
    logical,             intent(inout) :: error
    !
    character(len=*), parameter :: rname='IMPORT>ACTUAL>FAMILY'
    !
    if (fo%node%family.ne.'') then
      ! The family name was read from the header: it has precedence
      if (prog%doparse)  &
        call cubeadm_message(seve%w,rname,'Family read from header; /PARSE ignored')
    else
      ! No family yet: apply the precomputed default
      call cubedag_node_set_family(fo,deffamily,error)
      if (error) return
    endif
  end subroutine cubeadm_import_actual_family
  !
  subroutine cubeadm_import_actual_flags(prog,defflags,fo,error)
    use cubedag_flag
    use cubedag_allflags
    use cubetuple_format
    !-------------------------------------------------------------------
    ! Set the node flags, if not yet done at read header time
    !-------------------------------------------------------------------
    type(import_prog_t), intent(in)    :: prog
    type(flag_t),        intent(in)    :: defflags(:)  ! Default flags to be applied
    class(format_t),     intent(inout) :: fo
    logical,             intent(inout) :: error
    !
    type(flag_t), allocatable :: flags(:)
    character(len=*), parameter :: rname='IMPORT>ACTUAL>FLAGS'
    !
    if (fo%node%flag%n.gt.0) then
      ! Some flags were read from the header: they have precedence
      if (prog%doparse) &
        call cubeadm_message(seve%w,rname,'Flags read from header; /PARSE ignored')
      if (prog%domapping) &
        call cubeadm_message(seve%w,rname,'Flags read from header; /MAPPING ignored')
      if (prog%doclass) &
        call cubeadm_message(seve%w,rname,'Flags read from header; /CLASS ignored')
    else
      ! No flags yet
      if (size(defflags).gt.0) then
        ! Default flags available
        call cubeadm_import_reallocate_flags(flags,defflags,error)
        if (error)  return
      else
        ! No pre-computed default. Use fallback flags
        if (fo%tuple%current%file%is_cube()) then
          call cubeadm_import_reallocate_flags(flags,[flag_cube],error)
          if (error)  return
        elseif (fo%tuple%current%file%is_uvt()) then
          call cubeadm_import_reallocate_flags(flags,[flag_uv,flag_table],error)
          if (error)  return
        endif
      endif
      ! Apply them
      call cubedag_node_set_flags(fo,flags,error)
      if (error) return
    endif
  end subroutine cubeadm_import_actual_flags
  !
  subroutine cubeadm_import_reallocate_flags(list,flags,error)
    use gkernel_interfaces
    use cubedag_flag
    !-------------------------------------------------------------------
    ! Ad-hoc subroutine which reallocates and stores a list of flags
    !-------------------------------------------------------------------
    type(flag_t), allocatable   :: list(:)
    type(flag_t), intent(in)    :: flags(:)
    logical,      intent(inout) :: error
    !
    integer(kind=4) :: nflags,ier
    character(len=*), parameter :: rname='IMPORT>REALLOCATE>FLAGS'
    !
    if (allocated(list))  deallocate(list)
    nflags = size(flags)
    allocate(list(nflags),stat=ier)  ! Size can be 0 on purpose
    if (failed_allocate(rname,'flags',ier,error)) return
    if (nflags.gt.0)  list(:) = flags(:)
  end subroutine cubeadm_import_reallocate_flags
  !
  subroutine cubeadm_imported_add_node(dno)
    class(cubedag_node_object_t), pointer :: dno
    logical :: error
    error = .false.
    call cubeadm_imported_add(im,dno,error)
    if (error)  return
  end subroutine cubeadm_imported_add_node
  !
  subroutine cubeadm_imported_add_twin(dno)
    class(cubedag_node_object_t), pointer :: dno
    logical :: error
    error = .false.
    call cubeadm_imported_add(tw,dno,error)
    if (error)  return
  end subroutine cubeadm_imported_add_twin
  !
  subroutine cubeadm_imported_add(list,dno,error)
    type(cubedag_link_t),         intent(inout) :: list
    class(cubedag_node_object_t), pointer       :: dno
    logical,                      intent(inout) :: error
    call list%reallocate(list%n+1,error)
    if (error)  return
    list%n = list%n+1
    list%list(list%n)%p => dno
    list%flag(list%n) = 0
  end subroutine cubeadm_imported_add
  !
  subroutine cubeadm_imported_flush_nodes(line,error)
    use cubedag_history
    !-------------------------------------------------------------------
    ! Insert all imported nodes in history and reset the list
    !-------------------------------------------------------------------
    character(len=*), intent(in)    :: line
    logical,          intent(inout) :: error
    !
    type(cubedag_link_t) :: void
    integer(kind=entr_k) :: hid
    !
    call cubedag_history_add_tohx('IMPORT',line,void,im,hid,error)
    if (error)  return
    call cubedag_node_history(im,hid,error)
    if (error)  return
    call im%final(error)
    if (error)  return
  end subroutine cubeadm_imported_flush_nodes
  !
  subroutine cubeadm_imported_flush_twins(error)
    !-------------------------------------------------------------------
    ! Link all current twins and reset the list
    !-------------------------------------------------------------------
    logical, intent(inout) :: error
    !
    call cubedag_node_links_twins(tw,error)
    if (error)  return
    call tw%final(error)
    if (error)  return
  end subroutine cubeadm_imported_flush_twins
  !
end module cubeadm_import
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
