R/ffm_manifest.R

In tidymedia: Media File Preprocessing and Metadata for the 'tidyverse'

# ffm_manifest() ----------------------------------------------------------

#' Read a Batch Provenance Manifest
#'
#' Retrieve the reproducibility manifest recorded by [ffm_batch()] when it was
#' run with \code{manifest = TRUE}. The manifest is a tibble with one row per
#' job. Each row has the compiled command and the FFmpeg and FFprobe versions
#' used. It also has the time of the run, the input and output paths, and the
#' output file size.
#' When the batch ran with \code{checksums = TRUE}, each row also has md5
#' checksums of the input and output files. With the manifest, a batch run
#' leaves a record that others can check.
#'
#' @param x A tibble returned by [ffm_batch()] with \code{manifest = TRUE}.
#' @param path An optional file path. When supplied, the manifest is also
#'   written there as CSV (via \code{utils::write.csv}, no row names) and
#'   returned invisibly.
#' @return The manifest [tibble][tibble::tibble-package]; invisibly when
#'   \code{path} is written.
#' @family verification functions
#' @seealso [ffm_batch()], which records the manifest.
#' @examplesIf nzchar(Sys.which("ffmpeg")) && has_encoder("libmp3lame")
#' video <- system.file("extdata", "sample.mp4", package = "tidymedia")
#' jobs <- tibble::tibble(input = video, output = tempfile(fileext = ".mp3"))
#' res <- ffm_batch(jobs, manifest = TRUE, .f = function(input, output, ...) {
#'   ffm_files(input, output) |>
#'     ffm_drop("video") |>
#'     ffm_codec(audio = "libmp3lame")
#' })
#' ffm_manifest(res)
#' @export
ffm_manifest <- function(x, path = NULL) {
  man <- attr(x, "manifest")
  if (is.null(man)) {
    cli::cli_abort(c(
      "No provenance manifest is attached to {.arg x}.",
      "i" = "Run the batch with {.code ffm_batch(..., manifest = TRUE)} first."
    ))
  }
  if (!is.null(path)) {
    rlang::check_string(path)
    utils::write.csv(man, path, row.names = FALSE)
    return(invisible(man))
  }
  man
}

# manifest_schema() -------------------------------------------------------

# The canonical, zero-row manifest template: the single source of truth for the
# provenance manifest's column names, order, and types. build_manifest() fills
# it for the rows that ran; the two-pass batch's all-silent path pads it (no row
# ever runs) so its result carries the same schema as a mixed batch (D011). The
# `checksums` flag toggles the optional md5 columns, matching build_manifest().
manifest_schema <- function(checksums = FALSE) {
  schema <- tibble::tibble(
    command = character(0),
    input = character(0),
    output = character(0),
    output_size = numeric(0),
    ffmpeg_version = character(0),
    ffprobe_version = character(0),
    timestamp = character(0)
  )
  if (checksums) {
    schema$input_md5 <- character(0)
    schema$output_md5 <- character(0)
  }
  schema
}

# build_manifest() --------------------------------------------------------

# Assemble the per-job manifest tibble from the batch's pipeline objects,
# compiled commands, and captured tool versions. Kept free of any binary calls
# (versions are passed in) so the assembly and checksum logic is CI-testable;
# ffm_batch() supplies `versions` from tool_versions() at run time. Multiple
# inputs (e.g. a stacked job) are joined with ";" in one cell. The column set is
# taken from manifest_schema() so the populated and empty-template paths cannot
# drift apart.
build_manifest <- function(pipelines, commands, versions, checksums) {
  inputs <- vapply(
    pipelines, function(p) paste(p$input, collapse = ";"), character(1)
  )
  outputs <- vapply(pipelines, function(p) p$output, character(1))
  sizes <- as.numeric(file.size(outputs))

  cols <- list(
    command = commands,
    input = inputs,
    output = outputs,
    output_size = sizes,
    ffmpeg_version = versions$ffmpeg,
    ffprobe_version = versions$ffprobe,
    timestamp = format(Sys.time(), "%Y-%m-%dT%H:%M:%S%z")
  )
  if (checksums) {
    cols$input_md5 <- vapply(
      pipelines,
      function(p) paste(unname(tools::md5sum(p$input)), collapse = ";"),
      character(1)
    )
    cols$output_md5 <- unname(tools::md5sum(outputs))
  }

  # Order and gate columns by the canonical schema (scalar version columns are
  # recycled to one row per job by tibble()).
  tibble::tibble(!!!cols[names(manifest_schema(checksums))])
}

# tool_versions() ---------------------------------------------------------

# Capture version strings for a set of programs. Returns a named list with NA
# for a binary that cannot be located or queried. The binary call lives here;
# parsing is factored into parse_version_line() so it can be tested without a
# binary.
#
# `programs` defaults to the two the manifest records, which is the only shape
# ffm_batch() ever asks for; program_status() asks for all four (M113). The
# manifest's own columns are unchanged by the widening -- it reads `$ffmpeg`
# and `$ffprobe` out of the result and nothing else.
#
# `locations` lets a caller that has already resolved the binaries hand them
# over rather than have them looked up a second time. program_status() does
# that, because it resolves each program itself -- muffling find_program()'s
# plain not-found warning while letting the two classed config warnings through
# (M116) -- and must not fire any of them a second time here.
#
# This is where the timed-out probe becomes audible, because this is where the
# probes are assembled -- one warning naming the tools the limit gave up on, not one
# per tool. M69 left an NA version in the manifest reading exactly like a
# missing binary, so a bounded hang under ffm_batch(manifest = TRUE) was
# invisible (D048). The RECORDED value is unchanged: NA is what a version that
# could not be read has always been.
tool_versions <- function(programs = c("ffmpeg", "ffprobe"),
                          locations = NULL,
                          call = rlang::caller_env()) {
  # A caller-supplied `locations` is paired with `programs` positionally by the
  # Map() below, which recycles a length-1 list silently and warns -- rather
  # than refuses -- on any other mismatch. Either way the probes would be
  # labelled with the wrong program names. Checked only on the non-NULL arm:
  # the default resolves each program itself, so it cannot be the wrong length.
  if (!is.null(locations) && length(locations) != length(programs)) {
    cli::cli_abort(
      c(
        # Not {.arg locations}: `call` is the caller's frame, and
        # program_status() -- the caller that supplies one -- has no such
        # argument, so cli would name an argument the blamed call does not
        # take (M116 re-review [O]4).
        "The locations supplied must name one location for each program.",
        "x" = "{length(programs)} program{?s}, but \\
               {length(locations)} location{?s}."
      ),
      class = "tidymedia_locations_mismatch",
      tm_n_programs = length(programs),
      tm_n_locations = length(locations),
      call = call
    )
  }
  if (is.null(locations)) locations <- lapply(programs, tm_find_program_for_version)
  # The limit is resolved once, here, above every probe. capture_version()
  # turns any error below it into a silent NA, which is the right answer for a
  # binary that will not answer its version flag and the wrong one for a
  # `tidymedia.timeout` the caller set to something unusable: that is a
  # machine-independent argument refusal and belongs above the availability
  # question (D036), reported from the frame `call` names. run_program()
  # resolves it again per probe; the value is the same and the call is cheap.
  resolve_timeout(call = call)
  probes <- Map(
    function(loc, program) {
      capture_version(loc, tm_program_labels[[program]],
                      flag = tm_version_flags[[program]], call = call)
    },
    locations, programs
  )
  names(probes) <- programs
  timed_out <- vapply(probes, is_absorbed_timeout, logical(1))
  if (any(timed_out)) {
    hit <- probes[[which(timed_out)[[1]]]]
    # Named from `probes`, not from each probe's own `program` field: that
    # field carries the display label the version flag is asked under
    # ("FFmpeg"), while program_status() prints "ffmpeg" in the column beside
    # the NA this warning explains, and a reader should not have to match two
    # spellings of one program. A separate local rather than rebinding
    # `programs`, which is what this block used to do: the count read
    # correctly off the rebound name, so nothing was broken, but any later
    # reader of `programs` below this point would have got the timed-out
    # subset instead of the argument (M116).
    late <- names(probes)[timed_out]
    cli::cli_warn(
      c(
        "The version probe timed out after {hit$limit} second{?s}.",
        "x" = "{late}",
        # Says what the NA means without naming a caller: the same warning is
        # raised from ffm_batch(manifest = TRUE), where the value lands in a
        # manifest, and from program_status(), where it lands in a returned
        # tibble that is no manifest at all.
        "i" = "{cli::qty(length(late))}{?That version is/Those versions are} \\
               recorded as {.val {NA}}; raise or remove \\
               {.code options(tidymedia.timeout = )}."
      ),
      class = "tidymedia_probe_timeout",
      call = call
    )
  }
  lapply(probes, function(x) if (is_absorbed_timeout(x)) NA_character_ else x)
}

# The four programs the package knows, in the order every report lists them.
# One declaration: program_status() and the manifest's version probes both read
# it, and the vocabulary find_program()/set_program() default to is pinned to it
# by a test. unset_program() takes no default (D079), so it is pinned instead as
# the set arg_match() accepts.
tm_programs <- function() c("ffmpeg", "ffprobe", "ffplay", "mediainfo")

# The display name a version probe reports the program under, and the flag that
# asks it for its version. MediaInfo answers `--version`; the three FFmpeg
# binaries answer `-version`.
tm_program_labels <- c(ffmpeg = "FFmpeg", ffprobe = "FFprobe",
                       ffplay = "FFplay", mediainfo = "MediaInfo")
tm_version_flags <- c(ffmpeg = "-version", ffprobe = "-version",
                      ffplay = "-version", mediainfo = "--version")

# Resolve one program for a version probe. Written as a switch over the four
# find_*() exports rather than as find_program(program), because the suite's
# timeout tests mock find_ffmpeg() and find_ffprobe() by name and a single
# generic call would walk past those mocks.
tm_find_program_for_version <- function(program) {
  switch(
    program,
    ffmpeg = find_ffmpeg(),
    ffprobe = find_ffprobe(),
    ffplay = find_ffplay(),
    mediainfo = find_mediainfo()
  )
}

# capture_version() -------------------------------------------------------

# Run `<tool> <flag>` and parse the version token; NA if the binary is absent
# or the call fails.
# `call` is the frame a refusal is reported from, threaded down to
# run_program() so that a bad `options(tidymedia.timeout = )` blames the
# exported call the user typed -- program_status() -- rather than this helper,
# which is the first spawn on that path (M113; the blame sweep in
# test-timeout-refusal-blame.R is what asks).
# Returns the absorbed-timeout sentinel when the limit ended the wait, so
# tool_versions() can tell that apart from every other reason a version is
# missing. absorb_timeout() sits INSIDE the tryCatch() for the same reason it
# does in count_audio_streams(): the outer handler catches every error, so a
# timeout reaching it first would be flattened back into a silent NA.
capture_version <- function(loc, name, flag = "-version",
                            call = rlang::caller_env()) {
  if (is.null(loc) || is.na(loc) || !nzchar(loc)) return(NA_character_)
  out <- tryCatch(
    absorb_timeout(run_program(loc, flag, program = name, call = call)),
    error = function(e) NULL
  )
  if (is_absorbed_timeout(out)) return(out)
  parse_version_line(out)
}

# parse_version_line() ----------------------------------------------------

# Pull the version token out of a `<tool> -version` first line, e.g.
# "ffmpeg version 8.1.2 ..." -> "8.1.2". NA when there is nothing to parse.
#
# MediaInfo answers `--version` in a shape with no "version" token in it: the
# command line's own banner on the first line and the library's version on the
# next, as `MediaInfoLib - v26.05` (read off `mediainfo --version` on
# 2026-09-05, MediaInfo v26.05). That second shape is tried only when the first
# finds nothing, so what the FFmpeg binaries return is parsed exactly as before.
parse_version_line <- function(lines) {
  if (is.null(lines) || !length(lines)) return(NA_character_)
  m <- regmatches(lines[[1]], regexpr("version \\S+", lines[[1]]))
  if (length(m)) return(sub("^version ", "", m))
  lib <- unlist(regmatches(lines, regexpr("MediaInfoLib - v\\S+", lines)))
  if (length(lib)) return(sub("^MediaInfoLib - v", "", lib[[1]]))
  NA_character_
}