#' Obtain Text from a PDF Document
#'
#' @description Extract text from a PDF document and write it to a plain-text
#'   file, one page per line. Pages with an extractable text layer are read
#'   directly; pages without one (e.g. scanned images) fall back to optical
#'   character recognition (OCR). The text is normalized to ASCII before writing.
#'
#'   Requires the \pkg{pdftools}, \pkg{tesseract}, and \pkg{callr} packages;
#'   image preprocessing additionally requires \pkg{magick}.
#'
#' @details
#'   Direct extraction is attempted first, as it is faster and more accurate than
#'   OCR for born-digital PDFs; a page is OCR'd only when its text layer yields
#'   fewer than `min_chars` non-whitespace characters, or when `force_ocr` is
#'   `TRUE`. Poppler reads and page rendering run in isolated child processes, so
#'   a renderer crash surfaces as a normal R error rather than aborting the
#'   session.
#'
#'   Directly extracted text is reordered into human reading order from word
#'   bounding boxes: full-width headers and captions are set aside, then the body
#'   is split into columns only on strong evidence of a multi-column layout. OCR
#'   uses Tesseract's LSTM engine, run in parallel across `cores` workers when
#'   several pages need it. The result is normalized to strictly ASCII: selected
#'   scientific symbols become ASCII tokens, accents are transliterated, line-break
#'   hyphenation is rejoined, and quotes, control characters, and repeated
#'   punctuation and whitespace are cleaned up.
#'
#' @param input 'character' string.
#'   File path to the PDF document.
#'
#' @param output 'character' string.
#'   File path for the text file to write. If the path lacks a `.txt` or `.text`
#'   extension, `.txt` is appended. Defaults to a temporary file.
#'
#' @param dpi 'integer' number between 100 and 1200.
#'   Resolution, in dots per inch, at which pages are rendered before OCR.
#'   Higher values improve OCR accuracy at the cost of speed; 300 (the default)
#'   suits most documents, while 400 to 600 may help with small fonts or poor
#'   scans. Ignored for pages read directly from the text layer.
#'
#' @param psm 'integer' number between 0 and 13.
#'   Tesseract Page Segmentation Mode, describing the expected page layout.
#'   The default of 1 segments the page automatically and detects orientation and
#'   script, which suits multi-column documents.
#'
#' @param force_ocr 'logical' flag.
#'   Whether to OCR every page regardless of its text layer. Use this when the
#'   embedded text is known to be unreliable (e.g. fonts that extract as gibberish,
#'   which `min_chars` cannot catch because the gibberish is long enough to pass).
#'   Defaults to `FALSE`.
#'
#' @param preprocess 'logical' flag.
#'   Whether to grayscale, deskew, despeckle, and normalize each page image before
#'   OCR, which improves accuracy on scanned documents at a modest per-page cost.
#'   Requires the \pkg{magick} package. Applies only to pages that are OCR'd.
#'   Defaults to `FALSE`.
#'
#' @param min_chars 'integer' number.
#'   Minimum number of non-whitespace characters a page's extracted text must
#'   have to be accepted without OCR. Pages below this threshold are sent to OCR.
#'   Defaults to 20.
#'
#' @param cores 'integer' number.
#'   Number of parallel workers to use for OCR. When `NULL` (the default), the
#'   count is taken from the `OCR_CORES` environment variable if set (useful for
#'   honoring a container CPU quota), otherwise from one fewer than the number of
#'   detected cores.
#'
#' @param timeout 'numeric' number.
#'   Maximum time, in seconds, to allow each child-process call to run before it
#'   is aborted. Applied independently to the text-extraction call and the
#'   page-rendering call. Defaults to 120.
#'
#' @return Returns the path to the text file, invisibly.
#'   Each page of the PDF is written as a separate line.
#'
#' @author J.C. Fisher, U.S. Geological Survey, Idaho Water Science Center
#'
#' @export
#'
#' @seealso [`add_content`] to add extracted text to the \pkg{inlpubs}-package corpus.
#'
#' @examples
#' \dontrun{
#'   input <- system.file("extdata", "test.pdf", package = "inlpubs")
#'   path <- get_pdf_text(input)
#'
#'   unlink(path)
#' }

get_pdf_text <- function(
  input,
  output = tempfile(fileext = ".txt"),
  dpi = 300,
  psm = 1,
  force_ocr = FALSE,
  preprocess = FALSE,
  min_chars = 20,
  cores = NULL,
  timeout = 120
) {
  # check system dependencies
  if (!requireNamespace("pdftools", quietly = TRUE)) {
    stop("Reading a PDF requires the 'pdftools' package", call. = FALSE)
  }
  if (!requireNamespace("tesseract", quietly = TRUE)) {
    stop("OCR requires the 'tesseract' package", call. = FALSE)
  }
  if (!requireNamespace("callr", quietly = TRUE)) {
    stop("Crash-safe PDF reading requires the 'callr' package", call. = FALSE)
  }
  if (preprocess && !requireNamespace("magick", quietly = TRUE)) {
    stop("Image preprocessing requires the 'magick' package", call. = FALSE)
  }

  # resolve default core count, honoring an env override (e.g. container quota)
  # and guarding against detectCores() returning NA
  if (is.null(cores)) {
    env <- Sys.getenv("OCR_CORES", unset = NA)
    if (!is.na(env)) {
      cores <- suppressWarnings(as.integer(env))
      if (is.na(cores)) {
        stop(
          "Environment variable 'OCR_CORES' must be a positive integer, got: ",
          sQuote(env),
          call. = FALSE
        )
      }
    } else {
      n <- parallel::detectCores()
      cores <- if (is.na(n)) 1L else max(1L, n - 1L)
    }
  }

  # check arguments
  input <- path.expand(input) |> normalizePath(winslash = "/", mustWork = FALSE)
  checkmate::assert_file_exists(input, access = "r", extension = "pdf")
  output <- path.expand(output) |> normalizePath(winslash = "/", mustWork = FALSE)
  checkmate::assert_path_for_output(output, overwrite = TRUE)
  checkmate::assert_int(dpi, lower = 100, upper = 1200)
  checkmate::assert_int(psm, lower = 0, upper = 13)
  checkmate::assert_flag(force_ocr)
  checkmate::assert_flag(preprocess)
  checkmate::assert_int(min_chars, lower = 0)
  checkmate::assert_int(cores, lower = 1)
  checkmate::assert_number(timeout, lower = 1)

  # ensure the output has a text-file extension
  if (!grepl("\\.(txt|text)$", tolower(output))) {
    output <- paste0(output, ".txt")
  }

  # Poppler can hard-crash the R process on certain files (e.g. STATUS_STACK_
  # BUFFER_OVERRUN on Windows) below the R level, where tryCatch cannot catch it.
  # Running the reads in a child process turns such a crash into a normal R error
  # instead of taking down the session or aborting a batch run. pdf_data() gives
  # per-word boxes used to reconstruct reading order.
  read <- tryCatch(
    callr::r(
      func = function(pdf, get_text) {
        info <- pdftools::pdf_info(pdf)
        list(
          pages = info$pages,
          data = if (get_text) pdftools::pdf_data(pdf) else NULL
        )
      },
      args = list(pdf = input, get_text = !force_ocr),
      timeout = timeout
    ),
    error = function(e) NULL
  )
  if (is.null(read)) {
    stop(
      "Could not read PDF (the renderer crashed or timed out on this file): ",
      sQuote(basename(input)),
      call. = FALSE
    )
  }

  # initialize one text slot per page so OCR results can be slotted back by index
  n_pages <- read$pages
  text <- character(n_pages)

  # try direct text-layer extraction first; cheap and accurate for born-digital
  # PDFs. force_ocr skips this and flags every page for OCR.
  if (force_ocr) {
    needs_ocr <- rep(TRUE, n_pages)
  } else {
    # reconstruct reading order per page from the word boxes
    direct <- vapply(read$data, .reconstruct_page, character(1))
    text <- direct
    # a page needs OCR if its text layer is empty or implausibly short
    needs_ocr <- nchar(trimws(direct)) < min_chars
  }

  # OCR only the pages that need it
  if (any(needs_ocr)) {
    text[which(needs_ocr)] <- .run_ocr_pages(
      input = input,
      pages = which(needs_ocr),
      dpi = dpi,
      psm = psm,
      preprocess = preprocess,
      cores = cores,
      timeout = timeout
    )
  }

  # normalize the text only when there is something to convert; guard against an
  # empty document so encoding handling does not error on a zero-length input
  if (length(text) > 0 && any(nzchar(text))) {
    # preserve high-value scientific symbols before the blanket ASCII squash
    # would drop them to spaces
    text <- gsub("\u00b5", "u", text) # micro sign -> u (e.g. ug/L)
    text <- gsub("\u03bc", "u", text) # Greek small mu -> u
    text <- gsub("\u00b0", " deg ", text) # degree sign
    text <- gsub("\u00b1", "+/-", text) # plus-minus sign

    # transliterate accents (keeps names searchable, e.g. "Mendez"), then force
    # the remainder to ASCII
    text <- stringi::stri_trans_general(text, "Latin-ASCII")
    text <- iconv(text, from = "UTF-8", to = "ASCII", sub = " ")

    # rejoin hyphenation BEFORE control chars are flattened, so the newline is
    # still present. The hyphen must end a line (directly precede \n) to count,
    # which rejoins true splits ("exam-\nple", "well-\n7B") but leaves mid-line
    # "890- square" alone; an uppercase continuation is treated as a real compound.
    text <- gsub("([a-z0-9])-\n[[:blank:]]*([a-z0-9])", "\\1\\2", text)
    text <- gsub("[[:cntrl:]]", " ", text)
    text <- gsub("[\u2018\u2019]", "'", text) # curly -> straight single quotes
    text <- gsub("[\u201C\u201D]", "\"", text) # curly -> straight double quotes
    text <- gsub("\\.{2,}", ".", text) # collapse repeated periods
    text <- gsub("\\s+", " ", text)
    text <- trimws(text)
  }

  # write text, one page per line. useBytes keeps the already-ASCII content from
  # being re-encoded under a non-UTF-8 native locale.
  writeLines(text, con = output, useBytes = TRUE)

  # confirm the file was written
  checkmate::assert_file_exists(output, access = "r")

  invisible(output)
}

# Reconstruct a page's reading order from word boxes returned by pdf_data().
# Full-width rows (headers, captions, table rows) are emitted in place and
# excluded from gutter detection. Splitting requires strong evidence (wide
# gutter, both sides substantial); otherwise the page reads single-column.
.reconstruct_page <- function(words) {
  if (is.null(words) || nrow(words) == 0L) {
    return("") # blank or image-only page
  }

  bucket <- 20
  min_gutter_buckets <- 3L # gutter = this many consecutive empty x-bands
  min_words_per_col <- 5L
  line_tol <- 3 # words within this y-distance (pts) share a line
  full_frac <- 0.6 # row spanning >= this fraction of extent = full-width

  # horizontal extent from the word boxes
  x_min <- min(words$x)
  x_max <- max(words$x + words$width)
  span <- x_max - x_min
  mid <- (x_min + x_max) / 2

  # group words into rows by y, then flag rows that cross the midline and span
  # most of the extent as full-width
  ord <- order(words$y, words$x)
  w <- words[ord, , drop = FALSE]
  row_id <- cumsum(c(TRUE, abs(diff(w$y)) > line_tol))
  rows <- split(seq_len(nrow(w)), row_id)
  is_full <- vapply(
    rows,
    function(idx) {
      rx_min <- min(w$x[idx])
      rx_max <- max(w$x[idx] + w$width[idx])
      (rx_min < mid) && (rx_max > mid) && ((rx_max - rx_min) >= span * full_frac)
    },
    logical(1)
  )

  # detect the gutter from body words only (full-width rows removed)
  center <- .detect_gutter(w, rows, is_full, x_min, span, bucket, min_gutter_buckets)

  # lines from a word set: top to bottom, left to right within a line
  emit_lines <- function(idx) {
    if (length(idx) == 0L) {
      return(character(0))
    }
    sub <- w[idx, , drop = FALSE]
    sub <- sub[order(sub$y, sub$x), , drop = FALSE]
    lid <- cumsum(c(TRUE, abs(diff(sub$y)) > line_tol))
    out <- character(0)
    for (id in unique(lid)) {
      ln <- sub[lid == id, , drop = FALSE]
      ln <- ln[order(ln$x), , drop = FALSE]
      out <- c(out, paste(ln$text, collapse = " "))
    }
    out
  }

  # a body run: column-split when a gutter was found and both sides substantial
  emit_body <- function(idx) {
    if (length(idx) == 0L) {
      return(character(0))
    }
    if (!is.na(center)) {
      left <- idx[w$x[idx] < center]
      right <- idx[w$x[idx] >= center]
      if (length(left) >= min_words_per_col && length(right) >= min_words_per_col) {
        return(c(emit_lines(left), emit_lines(right)))
      }
    }
    emit_lines(idx)
  }

  # walk top to bottom: full-width rows in place, body runs column-split between
  lines <- character(0)
  body_buffer <- integer(0)
  flush_body <- function() {
    if (length(body_buffer) > 0L) {
      lines <<- c(lines, emit_body(body_buffer))
      body_buffer <<- integer(0)
    }
  }
  for (k in seq_along(rows)) {
    idx <- rows[[k]]
    if (is_full[k]) {
      flush_body()
      lines <- c(lines, emit_lines(idx))
    } else {
      body_buffer <- c(body_buffer, idx)
    }
  }
  flush_body()

  paste(lines, collapse = "\n")
}

# Find the x-center of the column gutter from body (non-full-width) word boxes.
# Returns NA_real_ when no strong gutter is found.
.detect_gutter <- function(w, rows, is_full, x_min, span, bucket, min_gutter_buckets) {
  body_idx <- unlist(rows[!is_full], use.names = FALSE)
  if (length(body_idx) == 0L) {
    return(NA_real_)
  }

  b0 <- floor(w$x[body_idx] / bucket)
  b1 <- floor((w$x[body_idx] + w$width[body_idx]) / bucket)
  occupied <- integer(0)
  for (i in seq_along(b0)) {
    occupied <- c(occupied, b0[i]:b1[i])
  }
  occupied <- unique(occupied)

  lo <- floor((x_min + span * 0.33) / bucket)
  hi <- floor((x_min + span * 0.66) / bucket)
  best_run <- 0L
  run <- 0L
  run_start <- NA_integer_
  center <- NA_real_
  for (b in lo:hi) {
    if (!(b %in% occupied)) {
      if (run == 0L) {
        run_start <- b
      }
      run <- run + 1L
      if (run > best_run) {
        best_run <- run
        center <- (run_start + b) / 2 * bucket + bucket / 2
      }
    } else {
      run <- 0L
    }
  }
  if (best_run < min_gutter_buckets) NA_real_ else center
}

# Render the requested pages of a PDF to PNG images in a child process, run OCR
# on them (in parallel when worthwhile), and return a character vector of text
# (one element per page, in the same order as `pages`).
.run_ocr_pages <- function(input, pages, dpi, psm, preprocess, cores, timeout) {
  # Render page images in a child process (pdf_convert is also Poppler and can
  # crash the same way). The child renders into a temp dir and returns absolute paths.
  render_dir <- tempfile("ocr_pages_")
  dir.create(render_dir, showWarnings = FALSE)
  on.exit(unlink(render_dir, recursive = TRUE), add = TRUE)

  images <- tryCatch(
    callr::r(
      func = function(pdf, pages, dpi, dir) {
        wd <- setwd(dir)
        on.exit(setwd(wd), add = TRUE)
        files <- pdftools::pdf_convert(
          pdf = pdf,
          pages = pages,
          dpi = dpi,
          format = "png",
          verbose = FALSE
        )
        normalizePath(files, winslash = "/", mustWork = FALSE)
      },
      args = list(pdf = input, pages = pages, dpi = dpi, dir = render_dir),
      timeout = timeout
    ),
    error = function(e) NULL
  )
  if (is.null(images)) {
    stop(
      "Could not render PDF pages for OCR (the renderer crashed or timed out on this file): ",
      sQuote(basename(input)),
      call. = FALSE
    )
  }

  # OCR worker: transcribes one page image with a pre-built engine
  ocr_page <- function(img, engine, preprocess) {
    if (preprocess) {
      clean <- magick::image_read(img) |>
        magick::image_convert(colorspace = "gray") |>
        magick::image_deskew() |>
        magick::image_despeckle() |>
        magick::image_normalize()
      img <- magick::image_write(clean, format = "png")
    }
    tesseract::ocr(img, engine = engine)
  }

  # helper to build an engine with the LSTM engine mode
  build_engine <- function(psm) {
    tesseract::tesseract(
      options = list(
        "tessedit_pageseg_mode" = psm,
        "tessedit_ocr_engine_mode" = 1 # LSTM only
      )
    )
  }

  # Parallelize across pages only when it is worth the worker-startup cost.
  use_parallel <- cores > 1L && length(images) >= cores * 2L

  if (use_parallel) {
    cl <- parallel::makeCluster(cores, rscript_args = c("--no-site-file", "--no-init-file"))
    on.exit(parallel::stopCluster(cl), add = TRUE)

    parallel::clusterExport(cl, "build_engine", envir = environment())
    parallel::clusterExport(cl, "psm", envir = environment())
    parallel::clusterEvalQ(cl, {
      .ocr_engine <- build_engine(psm)
      NULL
    })

    # load-balanced: per-page OCR time varies, so dynamic scheduling avoids idle cores
    ocr_text <- parallel::parLapplyLB(
      cl,
      images,
      fun = function(img, preprocess) {
        if (preprocess) {
          clean <- magick::image_read(img) |>
            magick::image_convert(colorspace = "gray") |>
            magick::image_deskew() |>
            magick::image_despeckle() |>
            magick::image_normalize()
          img <- magick::image_write(clean, format = "png")
        }
        tesseract::ocr(img, engine = .ocr_engine)
      },
      preprocess = preprocess
    )
  } else {
    engine <- build_engine(psm)
    ocr_text <- lapply(images, FUN = ocr_page, engine = engine, preprocess = preprocess)
  }

  unlist(ocr_text) |> suppressWarnings()
}
