h5checktype <- function(
  h5id,
  type,
  fctname = deparse(match.call()[1]),
  allow.character = FALSE
) {
  if (!is(h5id, "H5IdComponent")) {
    if (allow.character) {
      stop(
        "Error in ",
        fctname,
        ". Argument neither of class H5IdComponent nor a character.",
        call. = FALSE
      )
    } else {
      stop(
        "Error in ",
        fctname,
        ". Argument not of class H5IdComponent.",
        call. = FALSE
      )
    }
  }
  isvalid <- H5Iis_valid(h5id)
  if (!isvalid) {
    stop("Error in ", fctname, ". H5Identifier not valid.", call. = FALSE)
  }
  truetype <- H5Iget_type(h5id)
  switch(
    type,
    file = {
      if (truetype != "H5I_FILE") {
        stop(
          "Error in ",
          fctname,
          ". The provided H5Identifier is not a file identifier.",
          call. = FALSE
        )
      }
      0
    },
    group = {
      if (truetype != "H5I_GROUP") {
        stop(
          "Error in ",
          fctname,
          ". The provided H5Identifier is not a group identifier.",
          call. = FALSE
        )
      }
      0
    },
    loc = {
      if (!truetype %in% c("H5I_FILE", "H5I_GROUP")) {
        stop(
          "Error in ",
          fctname,
          ". The provided H5Identifier is not a location identifier.",
          call. = FALSE
        )
      }
      0
    },
    dataset = {
      if (truetype != "H5I_DATASET") {
        stop(
          "Error in ",
          fctname,
          ". The provided H5Identifier is not a dataset identifier.",
          call. = FALSE
        )
      }
      0
    },
    object = {
      if (!truetype %in% c("H5I_FILE", "H5I_GROUP", "H5I_DATASET")) {
        stop(
          "Error in ",
          fctname,
          ". The provided H5Identifier is not an object identifier.",
          call. = FALSE
        )
      }
      0
    },
    dataspace = {
      if (truetype != "H5I_DATASPACE") {
        stop(
          "Error in ",
          fctname,
          ". The provided H5Identifier is not a dataspace identifier.",
          call. = FALSE
        )
      }
      0
    },
    attribute = {
      if (truetype != "H5I_ATTR") {
        stop(
          "Error in ",
          fctname,
          ". The provided H5Identifier is not an attribute identifier.",
          call. = FALSE
        )
      }
      0
    },
    type = {
      if (truetype != "H5I_DATATYPE") {
        stop(
          "Error in ",
          fctname,
          ". The provided H5Identifier is not a type identifier.",
          call. = FALSE
        )
      }
      0
    },
    plist = {
      if (truetype != "H5I_GENPROP_LST") {
        stop(
          "Error in ",
          fctname,
          ". The provided H5Identifier is not a property list.",
          call. = FALSE
        )
      }
      0
    },
    plistclass = {
      if (truetype != "H5I_GENPROP_CLS") {
        stop(
          "Error in ",
          fctname,
          ". The provided H5Identifier is not a property list class.",
          call. = FALSE
        )
      }
      0
    },
    {
      stop("argument for type unknown")
    }
  )
  return(invisible(NULL))
}

h5checktypeOrNULL <- function(h5id, type, fctname = deparse(match.call()[1])) {
  if (!is.null(h5id)) {
    h5checktype(h5id, type, fctname = fctname)
  }
  invisible(NULL)
}

h5FileIsOpen <- function(filename) {
  filename <- normalizePath(filename, mustWork = FALSE)
  L <- h5validObjects()
  isobject <- vapply(
    L,
    function(x) {
      H5Iget_type(x) %in% c("H5I_FILE", "H5I_GROUP", "H5I_DATASET")
    },
    logical(1)
  )
  isopen <- any(vapply(
    L[isobject],
    function(x) {
      H5Fget_name(x) == filename
    },
    logical(1)
  ))
  isopen
}

h5checktypeOrOpenLoc <- function(
  file,
  fctname = deparse(match.call()[1]),
  createnewfile = FALSE,
  readonly = FALSE,
  fapl = NULL,
  native
) {
  res <- list()
  if (is.character(file)) {
    file <- normalizePath(file, mustWork = FALSE)
    if (file.exists(file)) {
      if (h5FileIsOpen(file)) {
        warning(
          "An open HDF5 file handle exists. ",
          "If the file has changed on disk meanwhile, the function may not work properly. ",
          "Run 'h5closeAll()' to close all open HDF5 object handles."
        )
      }

      flags <- ifelse(readonly, "H5F_ACC_RDONLY", "H5F_ACC_RDWR")
      h5loc <- H5Fopen(file, flags = flags, fapl = fapl, native = native)

      if (!is(h5loc, "H5IdComponent")) {
        stop(
          "Error in ",
          fctname,
          ". File '",
          file,
          "' is not a valid HDF5 file."
        )
      }
      res$H5Identifier <- h5loc
      res$closeit <- TRUE
    } else {
      if (!createnewfile) {
        stop(
          "Error in ",
          fctname,
          ". Cannot open file. File '",
          file,
          "' does not exist."
        )
      }
      h5loc <- H5Fcreate(file, native = native)
      if (!is(h5loc, "H5IdComponent")) {
        stop("Error in ", fctname, ". Cannot create file.")
      }
      res$H5Identifier <- h5loc
      res$closeit <- TRUE
    }
  } else {
    ## We have passed an H5IdComponent, so it should not be closed after
    h5checktype(file, "loc", fctname = fctname, allow.character = TRUE)
    res$H5Identifier <- file
    res$closeit <- FALSE
  }
  invisible(res)
}

h5checktypeOrOpenLocS3 <- function(
  file,
  fctname = deparse(match.call()[1]),
  createnewfile = FALSE,
  readonly = FALSE,
  fapl = NULL,
  native
) {
  res <- list()
  if (is.character(file)) {
    flags <- ifelse(readonly, "H5F_ACC_RDONLY", "H5F_ACC_RDWR")
    h5loc <- H5Fopen(file, flags = flags, fapl = fapl, native = native)

    if (!is(h5loc, "H5IdComponent")) {
      stop(
        "Error in ",
        fctname,
        ". File '",
        file,
        "' is not a valid HDF5 file."
      )
    }
    res$H5Identifier <- h5loc
    res$closeit <- TRUE
  } else {
    ## We have passed an H5IdComponent, so it should not be closed after
    h5checktype(file, "loc", fctname = fctname, allow.character = TRUE)
    res$H5Identifier <- file
    res$closeit <- FALSE
  }
  invisible(res)
}

h5closeitLoc <- function(file, fctname = deparse(match.call()[1])) {
  res <- TRUE
  if (file$closeit) {
    if (H5Iis_valid(file$H5Identifier)) {
      res <- H5Fclose(file$H5Identifier)
    } else {
      res <- FALSE
    }
  } else {
    res <- FALSE
  }
  invisible(res)
}

h5checktypeOrOpenObj <- function(
  obj,
  file,
  fctname = deparse(match.call()[1]),
  native
) {
  res <- list()
  if (is.character(obj)) {
    if (missing(file)) {
      stop(
        "Error in ",
        fctname,
        ". If the object is specified by name, then you have to specify the file."
      )
    }
    loc <- h5checktypeOrOpenLoc(file, fctname = fctname, native = native)

    if (!H5Lexists(loc$H5Identifier, obj)) {
      stop("Error in ", fctname, ". Object '", obj, "' not found in file.")
    }
    h5obj <- H5Oopen(loc$H5Identifier, obj)
    if (!is(h5obj, "H5IdComponent")) {
      stop("Error in ", fctname, ". Cannot open object.")
    }
    res$H5Identifier <- h5obj
    res$closeit <- TRUE
    h5closeitLoc(loc)
  } else {
    h5checktype(obj, "object", fctname = fctname, allow.character = TRUE)
    res$H5Identifier <- obj
    res$closeit <- FALSE
  }
  invisible(res)
}

h5closeitObj <- function(obj, fctname = deparse(match.call()[1])) {
  res <- TRUE
  if (obj$closeit) {
    if (H5Iis_valid(obj$H5Identifier)) {
      res <- H5Oclose(obj$H5Identifier)
    } else {
      res <- FALSE
    }
  } else {
    res <- FALSE
  }
  invisible(res)
}

h5checktypeAndPLC <- function(
  h5id,
  plc,
  allowNULL = FALSE,
  fctname = deparse(match.call()[1])
) {
  if (is.null(h5id)) {
    if (!allowNULL) {
      stop("Error in ", fctname, ". Property list is null", call. = FALSE)
    }
    h5id <- new("H5IdComponent", ID = character(0), native = logical(0))
  } else {
    if (!is(h5id, "H5IdComponent")) {
      stop(
        "Error in ",
        fctname,
        ". Argument not of class H5IdComponent.",
        call. = FALSE
      )
    }
    isvalid <- H5Iis_valid(h5id)
    if (!isvalid) {
      stop("Error in ", fctname, ". H5Identifier not valid.", call. = FALSE)
    }
    truetype <- H5Iget_type(h5id)
    if (truetype != "H5I_GENPROP_LST") {
      stop(
        "Error in ",
        fctname,
        ". The provided H5Identifier is not a property list.",
        call. = FALSE
      )
    }
    h5plc <- H5Pget_class(h5id)
    if (!plc %in% names(h5constants[["H5P"]])) {
      stop("plist class '", plc, "' unknown")
    }
    if (
      !.Call(
        "_H5Pequal",
        h5plc@ID,
        h5constants[["H5P"]][plc],
        PACKAGE = "rhdf5"
      )
    ) {
      stop("property list is not of class '", plc, "'")
    }
    H5Pclose_class(h5plc)
  }
  return(invisible(h5id))
}
