verifyr2 coverage - 93.22%

Files
Source

#' RtfFileComparator.R
#'
#' Specialiced comparator for RTF file comparison.
#' This comparator contains the custom handling for handling only RTF content
#' part for the comparison.
#'
#' @import striprtf
#'
#' @include TxtWithImagesComparator.R
#'
#' @examples
#'
#' # The normal way for creating a comparator would be to call the generic
#' # factory method verifyr2::create_comparator that will automatically create
#' # the correct comparator instance based on the file types.
#'
#' file1 <- 'my_file1.rtf'
#' file2 <- 'my_file2.rtf'
#' comparator <- verifyr2::create_comparator(file1, file2)
#'
#' # If needed, an explicit comparator can be created as well.
#'
#' file1 <- 'my_file1.rtf'
#' file2 <- 'my_file2.rft'
#' comparator <- RtfFileComparator$new(file1, file2)
#'
#' @export
#'
RtfFileComparator <- R6::R6Class(
  "RtfFileComparator",
  inherit = TxtWithImagesFileComparator,
  public = list(

    #' @description
    #' Method for getting the single file contents for the comparison. The
    #' method returns the file contents in two separate vectors inside a list.
    #' The first vector is the file contents and the second one is the file
    #' contents with the rows matching the omit string excluded. This method
    #' can be overwritten by more specialized comparator classes. This method
    #' is intended to be called only by the comparator classes in the processing
    #' and shouldn't be called directly by the user.
    #'
    #' For RtfComparator, only the RTF file content part is returned for
    #' comparison.
    #'
    #' @param file   file for which to get the contents
    #' @param config configuration values
    #' @param omit   string pattern to omit from the comparison
    #'
    vrf_contents = function(file, config, omit) {
      self$vrf_open_debug("Rtf::vrf_contents", config)

      # Get the RTF text content
      contents <- striprtf::read_rtf(file = file)
      result   <- self$vrf_contents_inner(contents, config, omit)

      self$vrf_close_debug()
      result
    },

    #' @description
    #' "Abstract" method for getting the raw image hex vector array from the
    #' given source file.
    #'
    #' @param file   file for which to get the embedded image details
    #' @param config configuration values
    #'
    vrf_images = function(file, config) {
      self$vrf_open_debug("Rtf::vrf_images", config)

      # return empty list if embedded image processing is disabled
      if ("no" == super$vrf_option_value(config, "rtf.images")) {
        self$vrf_close_debug()
        return(list())
      }

      # return empty list if image processing is disabled
      if ("no" == super$vrf_option_value(config, "generic.images")) {
        self$vrf_close_debug()
        return(list())
      }

      result <- list()

      #  Read the RTF file embedded images
      rtf_content <- readLines(file, warn = FALSE)
      rtf_content <- paste(rtf_content, collapse = "\n")

      # regexp for finding the png pictures from the raw RTF content.
      pattern <- "\\\\pict\\\\pngblip[^{]+([A-Za-z0-9+/=]+)"
      matches <- stringr::str_extract_all(rtf_content, pattern)[[1]]

      if (length(matches) > 0) {
        for (index in seq_along(matches)) {
          split_parts <- strsplit(matches[index], " ")[[1]]
          base64_data_with_braces <- split_parts[2]
          base64_data <- strsplit(base64_data_with_braces, "}")[[1]][1]

          if (!is.na(base64_data) && nchar(base64_data) > 0) {
            raw_data <- self$hex2raw(base64_data)
            result <- c(result, list(raw_data))
          }
        }
      }

      self$vrf_close_debug()
      result
    }
  )
)

#' ImgFileComparator.R
#'
#' Specialiced comparator for image file (jpg, jpef, png)  comparison.
#' This comparator contains the custom handling for handling only img content
#' part for the comparison.
#'
#' @import base64enc
#'
#' @include BinaryFileComparator.R
#'
#' @field image1_raw extracted raw data for image1.
#' @field image2_raw extracted raw data for image2.
#'
#' @examples
#'
#' # The normal way for creating a comparator would be to call the generic
#' # factory method verifyr2::create_comparator that will automatically create
#' # the correct comparator instance based on the file types.
#'
#' file1 <- 'my_file1.jpg'
#' file2 <- 'my_file2.jpg'
#' comparator <- verifyr2::create_comparator(file1, file2)
#'
#' # If needed, an explicit comparator can be created as well.
#'
#' file1 <- 'my_file1.png'
#' file2 <- 'my_file2.png'
#' comparator <- ImgFileComparator$new(file1, file2)
#'
#' # This comparator has also second explicit creation method that is used
#' # by the library for processing embedded image contents.
#'
#' image1_raw <- 'raw hex vector data'
#' image2_raw <- 'raw hex vector data'
#' comparator <- ImgFileComparator$new(NULL, NULL, image1_raw, image2_raw)
#'
#' @export
#'
ImgFileComparator <- R6::R6Class(
  "ImgFileComparator",
  inherit = BinaryFileComparator,
  public = list(
    image1_raw = NULL,
    image2_raw = NULL,

    #' @description
    #' Initialize a ImgFileComparator instance
    #'
    #' @param file1 First file to compare.
    #' @param file2 Second file to compare.
    #' @param raw1  First image in raw format to compare.
    #' @param raw2  Second image in raw format to compare.
    #'
    initialize = function(
      file1 = NULL,
      file2 = NULL,
      raw1  = NULL,
      raw2  = NULL
    ) {
      self$image1_raw <- raw1
      self$image2_raw <- raw2
      super$initialize(file1, file2)
    },

    #' @description
    #' Method for comparing the inner part for the details query. This method
    #' can be overwritten by more specialized comparator classes. This method is
    #' intended to be called only by the comparator classes in the processing
    #' and shouldn't be called directly by the user.
    #'
    #' @param config configuration values
    #' @param omit   string pattern to omit from the comparison
    #'
    vrf_details_inner = function(config, omit) {
      self$vrf_open_debug("Img::vrf_details_inner", config)

      if ("no" == super$vrf_option_value(config, "generic.images")) {
        result <- list(
          list(
            type = "text",
            contents = "Image comparison disabled; no comparison done."
          )
        )

        self$vrf_close_debug()
        return(result)
      }

      if (is.null(self$image1_raw) || is.null(self$image2_raw)) {
        result <- self$vrf_details_inner_from_files(config)

        self$vrf_close_debug()
        return(result)
      }

      result <- self$vrf_details_inner_from_raw(config)

      self$vrf_close_debug()
      result
    },

    #' @description
    #' Internal method for comparing the earlier populated raw image contents in
    #' details and generating the difference highlight image in case differences
    #' are found.
    #'
    #' @param config configuration values
    #*
    vrf_details_inner_from_raw = function(config) {
      self$vrf_open_debug("Img::vrf_details_inner_from_raw", config)

      png_prefix <- "data:image/png;base64,"
      image1_raw <- self$image1_raw
      image2_raw <- self$image2_raw
      image3_base64 <- NULL

      if (!identical(image1_raw, image2_raw)) {
        image1 <- magick::image_read(image1_raw)
        image2 <- magick::image_read(image2_raw)

        diff      <- magick::image_compare(image1, image2, metric = "AE")
        highlight <- magick::image_composite(image1, diff, operator = "atop")

        image3_raw    <- magick::image_write(highlight, format = "png")
        image3_base64 <- paste0(png_prefix, base64enc::base64encode(image3_raw))
      }

      image1_base64 <- paste0(png_prefix, base64enc::base64encode(image1_raw))
      image2_base64 <- paste0(png_prefix, base64enc::base64encode(image2_raw))

      result <- list(
        type = "image",
        contents = list(
          image1 = image1_base64,
          image2 = image2_base64,
          image3 = image3_base64
        )
      )

      self$vrf_close_debug()
      list(result)
    },

    #' @description
    #' Method for comparing the inner part for the details query with the file
    #' names as the base arguments. This is a part of a group of image
    #' processing functions that work with different image abstractions (file,
    #' image, raw image). These methods are intended to improve the performance
    #' so that best suiting method version can be used depending on what data is
    #' available from the earlier method calls to the same comparator instance.
    #'
    #' @param config configuration values
    #'
    vrf_details_inner_from_files = function(config) {
      self$vrf_open_debug("Img::vrf_details_inner_from_files", config)

      file1_size <- file.info(self$file1)$size
      self$image1_raw <- readBin(self$file1, what = "raw", n = file1_size)

      file2_size <- file.info(self$file2)$size
      self$image2_raw <- readBin(self$file2, what = "raw", n = file2_size)

      result <- self$vrf_details_inner_from_raw(config)

      self$vrf_close_debug()
      result
    },

    #' @description
    #' Inherited method for indicating whether detailed comparison is available
    #' with the current comparator. Returns an empty string if the comparator is
    #' is supported, otherwise a string that will be concatenated with the
    #' summary string.
    #'
    #' @param config configuration values
    #'
    vrf_details_supported = function(config) {
      if ("no" == super$vrf_option_value(config, "generic.images")) {
        return("Image details comparison disabled.")
      }
      ""
    }
  )
)

#' PdfFileComparator.R
#'
#' Specialiced comparator for PDF file comparison.
#' This comparator contains the custom handling for handling only PDF content
#' part for the comparison.
#'
#' @include BinaryFileComparator.R
#' @include TxtFileComparator.R
#'
#' @examples
#'
#' # The normal way for creating a comparator would be to call the generic
#' # factory method verifyr2::create_comparator that will automatically create
#' # the correct comparator instance based on the file types.
#'
#' file1 <- 'my_file1.pdf'
#' file2 <- 'my_file2.pdf'
#' comparator <- verifyr2::create_comparator(file1, file2)
#'
#' # If needed, an explicit comparator can be created as well.
#'
#' file1 <- 'my_file1.pdf'
#' file2 <- 'my_file2.pdf'
#' comparator <- PdfFileComparator$new(file1, file2)
#'
#' @export
#'
PdfFileComparator <- R6::R6Class(
  "PdfFileComparator",
  inherit = TxtFileComparator,
  public = list(

    #' @description
    #' Method for getting the single file contents for the comparison. The
    #' method returns the file contents in two separate vectors inside a list.
    #' The first vector is the file contents and the second one is the file
    #' contents with the rows matching the omit string excluded. This method
    #' can be overwritten by more specialized comparator classes. This method
    #' is intended to be called only by the comparator classes in the processing
    #' and shouldn't be called directly by the user.
    #'
    #' @param file   file for which to get the contents
    #' @param config configuration values
    #' @param omit   string pattern to omit from the comparison
    #'
    vrf_contents = function(file, config, omit) {
      self$vrf_open_debug("Pdf::vrf_contents", config)

      if ("no" == super$vrf_option_value(config, "pdf.details")) {
        result <- super$vrf_contents(file, config, omit)

        self$vrf_close_debug()
        return(result)
      }

      content <- pdftools::pdf_text(file)
      content <- paste(content, collapse = "")
      content <- strsplit(content, "\n")[[1]]

      result <- self$vrf_contents_inner(content, config, omit)

      self$vrf_close_debug()
      result
    },

    #' @description
    #' Inherited method for indicating whether detailed comparison is available
    #' with the current comparator. Returns an empty string if the comparator is
    #' is supported, otherwise a string that will be concatenated with the
    #' summary string.
    #'
    #' @param config configuration values
    #'
    vrf_details_supported = function(config) {
      if ("no" == super$vrf_option_value(config, "pdf.details")) {
        return("Pdf details comparison disabled.")
      }
      super$vrf_details_supported(config)
    }
  )
)

#' TextFileComparator.R
#'
#' Fallback comparator for text files without any specific definied comparator.
#' This comparator contains the methods for doing basic comparisons on raw text
#' contents.
#'
#' @import stringr
#'
#' @include BinaryFileComparator.R
#'
#' @examples
#'
#' # The normal way for creating a comparator would be to call the generic
#' # factory method verifyr2::create_comparator that will automatically create
#' # the correct comparator instance based on the file types.
#'
#' file1 <- 'my_file1.txt'
#' file2 <- 'my_file2.txt'
#' comparator <- verifyr2::create_comparator(file1, file2)
#'
#' # If needed, an explicit comparator can be created as well.
#'
#' file1 <- 'my_file1.lst'
#' file2 <- 'my_file2.lst'
#' comparator <- TxtFileComparator$new(file1, file2)
#'
#' @export
#'

# Disable cyclomatic complexity lint for the R6 class definition as lintr
# considers the whole class definition as a single function.
#
# nolint start: cyclocomp_linter
TxtFileComparator <- R6::R6Class(
  "TxtFileComparator",
  inherit = BinaryFileComparator,
  public = list(

    #' @description
    #' Method for comparing the inner part for the details query. This method
    #' can be overwritten by more specialized comparator classes. This method is
    #' intended to be called only by the comparator classes in the processing
    #' and shouldn't be called directly by the user.
    #'
    #' @param config configuration values
    #' @param omit   string pattern to omit from the comparison
    #'
    vrf_summary_inner = function(config, omit) {
      self$vrf_open_debug("Txt::vrf_summary_inner" , config)

      file1_contents_list <- self$file1_contents_list
      file2_contents_list <- self$file2_contents_list

      if (is.null(file1_contents_list)) {
        file1_contents_list <- self$vrf_contents(self$file1, config, omit)
        self$file1_contents_list <- file1_contents_list
      }

      if (is.null(file2_contents_list)) {
        file2_contents_list <- self$vrf_contents(self$file2, config, omit)
        self$file2_contents_list <- file2_contents_list
      }

      file1_contents_processed <- file1_contents_list[[2]]
      file2_contents_processed <- file2_contents_list[[2]]

      difference    <- all.equal(file1_contents_processed, file2_contents_processed)
      result        <- "File content comparison failed!"
      result_images <- ""
      pattern       <- "Lengths \\((\\d+), (\\d+)\\) differ \\(string compare on first"

      if (typeof(difference) == "logical") {
        # all.equal returns logical vector if there are no differences
        result <- "No differences."
      } else if (length(difference) >= 1 && grepl(pattern, difference[1])) {
        # all.equal returns length 1/2 vector with first element comtaining text
        #  matching the pattern
        result <- "Different number of lines in compared content."
      } else if (length(difference) == 1) {
        # all.equal returns length 1 vector if the number of rows are the same but
        # there are differences
        count  <- as.numeric(gsub("[^[:digit:].]", "", difference))
        result <- paste0("File content has changes in ", count, " place(s).")
      }

      self$vrf_close_debug()
      return(result)
    },

    #' @description
    #' Method for comparing the inner part for the details query. This method
    #' can be overwritten by more specialized comparator classes. This method is
    #' intended to be called only by the comparator classes in the processing
    #' and shouldn't be called directly by the user.
    #'
    #' @param config configuration values
    #' @param omit   string pattern to omit from the comparison
    #'
    vrf_details_inner = function(config, omit) {
      self$vrf_open_debug("Txt::vrf_details_inner" , config)

      file1_contents_list <- self$file1_contents_list
      file2_contents_list <- self$file2_contents_list

      if (is.null(file1_contents_list)) {
        file1_contents_list <- self$vrf_contents(self$file1, config, omit)
        self$file1_contents_list <- file1_contents_list
      }

      if (is.null(file2_contents_list)) {
        file2_contents_list <- self$vrf_contents(self$file2, config, omit)
        self$file2_contents_list <- file2_contents_list
      }

      file1_contents_whole <- file1_contents_list[[1]]
      file2_contents_whole <- file2_contents_list[[1]]

      context <- 2
      if ("full" == super$vrf_option_value(config, "details.mode")) {
        context <- -1
      }

      my_equalizer_with_omit <- function(x, x.chr) {
        my_finalizer(x, x.chr, omit)
      }

      style <- diffobj::StyleHtmlLightRgb(
        html.output = "diff.w.style",
        finalizer = my_equalizer_with_omit
      )

      self$vrf_open_debug("Txt::vrf_details_inner::diffPrint" , config)
      diff_print <- diffobj::diffChr(
        file1_contents_whole,
        file2_contents_whole,
        context = context,
        style = style,
        ignore.white.space = ("yes" == super$vrf_option_value(config, "generic.spaces")),
        mode = "sidebyside",
        word.diff = ("word" == super$vrf_option_value(config, "generic.level"))
      )
      self$vrf_close_debug()

      result <- list(
        list(
          type = "text",
          contents = diff_print
        )
      )

      self$vrf_close_debug()
      return(result)
    },

    #' @description
    #' Method for getting the inner part for the file contents query. The method
    #' returns the file contents in two separate vectors inside a list. The
    #' first vector is the file contents and the second one is the file contents
    #' processed for empty spaces and omit terms if applicable. This method can
    #' be overwritten by more specialized comparator classes. This method is
    #' intended to be called only by the comparator classes in the processing
    #' and shouldn't be called directly by the user.
    #'
    #' @param contents file contents
    #' @param config   configuration values
    #' @param omit     string pattern to omit from the comparison
    #'
    vrf_contents_inner = function(contents, config, omit) {
      self$vrf_open_debug("Txt::vrf_contents_inner" , config)

      contents_processed <- contents

      if (!is.null(omit) && "" != paste0(omit)) {
        contents_processed <- stringr::str_subset(
          string = contents,
          pattern = paste0(omit),
          negate = TRUE
        )
      }

      if ("yes" == super$vrf_option_value(config, "generic.spaces")) {
          contents_processed <- stringr::str_replace_all(contents_processed, "[ \t]+", " ")
          contents_processed <- stringr::str_trim(contents_processed, side = "both")
      }

      self$vrf_close_debug()
      return(list(contents, contents_processed))
    },

    #' @description
    #' Inherited method for indicating whether detailed comparison is available
    #' with the current comparator. Returns an empty string if the comparator is
    #' is supported, otherwise a string that will be concatenated with the
    #' summary string.
    #'
    #' @param config configuration values
    #'
    vrf_details_supported = function(config) {
      return("")
    }
  )
)
# nolint end: cyclocomp_linter

#' Custom finalizer method for diffobj html content finalizing. This method is
#' used to modify the diff html output so that omitted rows have their own
#' special styling and gutters.
#'
#' @param x     comparator instance used for the comparison that is meant to
#'              be created with the factory method vrf_comparator.
#' @param x.chr character text representation of x, typically generated with
#'              the as character
#' @param omit  all lines containing the omit string will be excluded from the
#'              comparison (detaulf = NULL)
#'
#' @keywords internal

my_finalizer <- function(x, x.chr, omit) {

  split <- strsplit(x.chr, "<div class='diffobj-row'>")[[1]]
  width <- nchar(length(split))
  index <- 0

  # add row numbers to compare results manually for diffChr. diffobj-header
  # values need to be processed to identify the actual line numbers in summary
  # results.
  for (i in seq_along(split)) {
    row <- split[[i]]

    # remove the special note regarding whitespace ignoring as it is not
    # relevant with the custom whitespace ignoring supported.
    if (1 == i) {
      old <- paste0(
        "<div class='diffobj-container light rgb'>",
        "<pre class='diffobj-content'>",
        "No visible differences between objects, but there are some ",
        "differencessuppressed by `ignore.white.space`, ",
        "`convert.hz.white.space`, `strip.sgr`,and/or `trim`. Set all ",
        "those arguments to FALSE to highlight the differences."
      )

      if (old == row) {
        split[[i]] <- paste0(
          "<div class='diffobj-container light rgb'>",
          "<pre class='diffobj-content'>",
          "No visible differences between objects."
        )
      }
    }

    if (grepl("<div class='diffobj-header'>@@ .*@@</div>", row)) {
      index <- as.integer(sub(".*@@\\s*([0-9]+),.*@@.*", "\\1", row)) - 1
    }

    if (i > 3) {
      if (grepl("<div class='diffobj-header'>@@ .*@@</div>", row)) {
        index <- as.integer(sub(".*@@\\s*([0-9]+),.*@@.*", "\\1", row)) - 1
      } else {
        index <- index + 1
      }
      row_str <- sprintf("%*s", width + 3, sprintf("[%d] ", index))

      row <- gsub(
        "<div class='diffobj-text'><div class='diffobj-match'>",
        paste0(
          "<div class='diffobj-text'><div class='diffobj-match'>",
          "<span class='diffobj-trim'>",
          row_str,
          "</span>"
        ),
        row
      )

      row <- gsub(
        "<div class='diffobj-text'><div class='delete'>",
        paste0(
          "<div class='diffobj-text'><div class='delete'>",
          "<span class='diffobj-trim'>",
          row_str,
          "</span>"
        ),
        row
      )

      row <- gsub(
        "<div class='diffobj-text'><div class='insert'>",
        paste0(
          "<div class='diffobj-text'><div class='insert'>",
          "<span class='diffobj-trim'>",
          row_str,
          "</span>"
        ),
        row
      )

      split[[i]] <- row
    }
  }

  # custom processing for omit row styles
  if (!is.null(omit) && "" != paste0(omit)) {
    for (i in seq_along(split)) {
      if (grepl(omit, split[[i]])) {
        row <- split[[i]]

        # modifying maching row markup
        row <- gsub(
          "class='diffobj-match'",
          "class='ignore'",
          row
        )

        row <- gsub(
          "<div class='diffobj-gutter'><div class='ignore'>&nbsp;",
          "<div class='diffobj-gutter'><div class='ignore'>x",
          row
        )

        # modifying inserted row markup
        row <- gsub(
          "class='insert'",
          "class='ignore'",
          row
        )

        row <- gsub(
          "class='diffobj-word insert'",
          "class='diffobj-word ignore'",
          row
        )

        row <- gsub(
          "<div class='diffobj-gutter'><div class='ignore'>&gt;",
          "<div class='diffobj-gutter'><div class='ignore'>X",
          row
        )

        # modifying deleted row markup
        row <- gsub(
          "class='delete'",
          "class='ignore'",
          row
        )

        row <- gsub(
          "class='diffobj-word delete'",
          "class='diffobj-word ignore'",
          row
        )

        row <- gsub(
          "<div class='diffobj-gutter'><div class='ignore'>&lt;",
          "<div class='diffobj-gutter'><div class='ignore'>X",
          row
        )

        # highlight the ommitted part
        row <- gsub(
          omit,
          paste0(
            "<span class='diffobj-word-highlight ignore'>",
            omit,
            "</span>"
          ),
          row
        )

        split[[i]] <- row
      }
    }
  }

  html_string <- paste(split, collapse = "<div class='diffobj-row'>")

  diffobj::finalizeHtml(x, html_string)
}

#' BinaryFileComparator.R
#'
#' Fallback comparator for binary files without any specific definied
#' comparator.
#'
#' @include FileComparator.R
#'
#' @examples
#'
#' # The normal way for creating a comparator would be to call the generic
#' # factory method verifyr2::create_comparator that will automatically create
#' # the correct comparator instance based on the file types.
#'
#' file1 <- 'my_file1.bin'
#' file2 <- 'my_file2.bin'
#' comparator <- verifyr2::create_comparator(file1, file2)
#'
#' # If needed, an explicit comparator can be created as well.
#'
#' file1 <- 'my_file1.bin'
#' file2 <- 'my_file2.bin'
#' comparator <- BinaryFileComparator$new(file1, file2)
#'
#' @export
#'
BinaryFileComparator <- R6::R6Class(
  "BinaryFileComparator",
  inherit = FileComparator,
  public = list(

    #' @description
    #' Method for getting the single file contents for the comparison. This
    #' method returns the file contents in two separate vectors inside a list.
    #' The first vector is the file contents and the second one is the file
    #' contents with the rows matching the omit string excluded. This method
    #' can be overwritten by more specialized comparator classes. This method
    #' is intended to be called only by the comparator classes in the processing
    #' and shouldn not be called directly by the user.
    #'
    #' @param file   file for which to get the contents
    #' @param config configuration values
    #' @param omit   string pattern to omit from the comparison
    #'
    vrf_contents = function(file, config, omit) {
      self$vrf_open_debug("Binary::vrf_contents", config)

      contents <- readLines(file, warn = FALSE)
      result   <- self$vrf_contents_inner(contents, config, omit)

      self$vrf_close_debug()
      result
    },

    #' @description
    #' Method for getting the inner part for the file contents query. The method
    #' returns the file contents in two separate vectors inside a list. The
    #' first vector is the file contents and the second one is the file contents
    #' with the rows matching the omit string excluded. This method can be
    #' overwritten by more specialized comparator classes. This method is
    #' intended to be called only by the comparator classes in the processing
    #' and shouldn not be called directly by the user.
    #'
    #' @param contents file contents
    #' @param config   configuration values
    #' @param omit     string pattern to omit from the comparison
    #'
    vrf_contents_inner = function(contents, config, omit) {
      self$vrf_add_debug("Binary::vrf_contents_inner")
      list(contents, contents)
    },

    #' @description
    #' Method for comparing the inner part for the details query. The method
    #' returns the file contents in two separate vectors inside a list. The
    #' first vector is the file contents and the second one is the file contents
    #' processed for empty spaces and omit terms if applicable. This method can
    #' be overwritten by more specialized comparator classes. This method is
    #' intended to be called only by the comparator classes in the processing
    #' and shouldn not be called directly by the user.
    #'
    #' @param config configuration values
    #' @param omit   string pattern to omit from the comparison
    #'
    vrf_summary_inner = function(config, omit) {
      self$vrf_open_debug("Binary::vrf_summary_inner", config)

      file_info1 <- file.info(self$file1)
      file_info2 <- file.info(self$file2)

      if (file_info1$size != file_info2$size) {
        self$vrf_close_debug()
        return("Different file sizes for compared files.")
      }

      file1_contents_list <- self$file1_contents_list
      file2_contents_list <- self$file2_contents_list

      if (is.null(file1_contents_list)) {
        file1_contents_list <- self$vrf_contents(self$file1, config, omit)
        self$file1_contents_list <- file1_contents_list
      }

      if (is.null(file2_contents_list)) {
        file2_contents_list <- self$vrf_contents(self$file2, config, omit)
        self$file2_contents_list <- file2_contents_list
      }

      file1_contents_processed <- file1_contents_list[[2]]
      file2_contents_processed <- file2_contents_list[[2]]

      if (!identical(file1_contents_processed, file2_contents_processed)) {
        self$vrf_close_debug()
        return("Different content in compared files.")
      }

      self$vrf_close_debug()
      "No differences."
    },

    #' @description
    #' Method for comparing the inner part for the details query. This method
    #' can be overwritten by more specialized comparator classes. This method is
    #' intended to be called only by the comparator classes in the processing
    #' and shouldn't be called directly by the user.
    #'
    #' @param config configuration values
    #' @param omit   string pattern to omit from the comparison
    #'
    vrf_details_inner = function(config, omit) {
      self$vrf_add_debug("Binary::vrf_details_inner")
      result <- list(
        type = "text",
        contents = "Binary file without applicable comparator."
      )
      list(result)
    }
  )
)

#' FileComparator.R
#'
#' Comparator 'abstract' class containing the generic comparison methods and
#' handling for high level checks (like file existence). This class should never
#' be instantiated - doing that and calling the comparison methods will lead to
#' error.
#'
#' @importFrom R6 R6Class
#'
#' @field file1               file1
#' @field file2               file2
#' @field file1_contents_list file1 contents
#' @field file2_contents_list file2 contents
#' @field summary_comparison  summary comparison result
#' @field details_comparison  details comparison result
#' @field debugger            debugger instance
#'
#' @export
#'

# Disable cyclomatic complexity lint for the R6 class definition as lintr
# considers the whole class definition as a single function.
#
# nolint start: cyclocomp_linter
FileComparator <- R6::R6Class(
  "FileComparator",
  public <- list(
    file1 = NULL,
    file2 = NULL,
    file1_contents_list = NULL,
    file2_contents_list = NULL,
    summary_comparison  = NULL,
    details_comparison  = NULL,
    debugger = NULL,

    #' @description
    #' Initialize a FileComparator instance
    #'
    #' @param file1 First file to compare.
    #' @param file2 Second file to compare.
    #'
    initialize = function(file1 = NULL, file2 = NULL) {
      self$file1 <- file1
      self$file2 <- file2
      self$details_comparison <- list("summary" = NULL, "full" = NULL)
    },

    #' @description
    #' Method for comparing the file summary information. This method is
    #' intended to be implemented only this class level. For comparator
    #' specific rules, the internal method vrf_summary_inner should be
    #' customized on lower levels instead.
    #'
    #' @param config configuration values
    #' @param omit   string pattern to omit from the comparison
    #'
    vrf_summary = function(config, omit = NULL) {
      self$vrf_open_debug("File::vrf_summary", config)
      self$vrf_add_debug_files()

      if (!is.null(self$summary_comparison)) {
        self$vrf_add_debug("Returning previously calculated comparison results")
        return(self$summary_comparison)
      }

      if (!file.exists(self$file1) || !file.exists(self$file2)) {
        self$vrf_add_debug("One of both of the files not available, unable perform comparison")
        result <- "File(s) not available; unable to compare."
      } else {
        tryCatch({
          result   <- self$vrf_summary_inner(config, omit)
          addition <- self$vrf_details_supported(config)

          if ('' != addition) {
            result <- paste(result, addition)
          }
        }, error = function(e) {
          self$vrf_add_debug(paste("Processing failed with exception: ", conditionMessage(e)))
          result <- paste0("Error reading file contents: ", conditionMessage(e))
        })

      }

      self$summary_comparison <- result
      self$vrf_close_debug()

      return(result)
    },

    #' @description
    #' Method for comparing the file details information. This method is
    #' intended to be implemented only this class level. For comparator
    #' specific rules, the internal method vrf_summary_inner should be
    #' customized on lower levels instead.
    #'
    #' @param config configuration values
    #' @param omit   string pattern to omit from the comparison
    #'
    vrf_details = function(config, omit = NULL) {
      mode <- self$vrf_option_value(config, "details.mode")
      if ("NA" == mode) {
        mode <- "summary"
      }

      self$vrf_open_debug(paste("File::vrf_details, mode:", mode), config)
      self$vrf_add_debug_files()

      if (!is.null(self$details_comparison[[mode]])) {
        self$vrf_add_debug("Returning previously calculated comparison results")
        return(self$details_comparison[[mode]])
      }

      if (!file.exists(self$file1) || !file.exists(self$file2)) {
        self$vrf_add_debug("One of both of the files not available, unable perform comparison")
        result <- list(
          list(
            type = "text",
            contents = "File(s) not available; unable to compare."
          )
        )
      } else if ('' != self$vrf_details_supported(config)) {
        self$vrf_add_debug("Details comparison not supported/enabled, unable perform comparison")
        result <- list(
          list(
            type = "text",
            contents = self$vrf_details_supported(config)
          )
        )
      } else {
        tryCatch({
          result <- self$vrf_details_inner(config, omit)
        }, error = function(e) {
          self$vrf_add_debug(paste("Processing failed with exception: ", conditionMessage(e)))
          result <- list(
            list(
              type = "text",
              contents = paste0("Error reading file contents: ", conditionMessage(e))
            )
          )
        })
      }

      self$details_comparison[[mode]] <- result
      self$vrf_close_debug()

      return(result)
    },

    #' @description
    #' "Abstract" method for comparing the inner part for the summary. This
    #' method has to be overwritten by more specialized comparator classes. This
    #' method is intended to be called only by the comparator classes in the
    #' processing and shouldn't be called directly by the user.
    #'
    #' @param config configuration values
    #' @param omit   string pattern to omit from the comparison
    #'
    vrf_summary_inner = function(config, omit) {
      stop("vrf_summary_inner must be implemented in a subclass.")
    },

    #' @description
    #' "Abstract" method for comparing the inner part for the detailsThis method
    #' has to be overwritten by more specialized comparator classes. This method
    #' is intended to be called only by the comparator classes in the processing
    #' and shouldn't be called directly by the user.
    #'
    #' @param config configuration values
    #' @param omit   string pattern to omit from the comparison
    #'
    vrf_details_inner = function(config, omit) {
      stop("vrf_details_inner must be implemented in a subclass.")
    },

    #' @description
    #' Inherited method for indicating whether detailed comparison is available
    #' with the current comparator. Returns an empty string if the comparator is
    #' is supported, otherwise a string that will be concatenated with the
    #' summary string.
    #'
    #' @param config configuration values
    #'
    vrf_details_supported = function(config) {
      return("No details comparison available.")
    },

    #' @description
    #' Method for getting specific value from the config In the initial
    #' version, returns 'NA' if null con is passed.
    #'
    #' @param config configuration values
    #' @param key    key to search from the parameters
    #'
    vrf_option_value = function(config, key) {
      if (is.null(config)) {
        return("NA")
      }
      value <- config$get(key)
      return(value)
    },

    #' @description
    #' Wrapper method for the opening a new debugging instance with Debugger
    #' class if debugging is enabled in config class. Creates the used
    #' debugger instance if needed.
    #'
    #' @param message message to debug to console
    #' @param config  configuration values
    #'
    vrf_open_debug = function(message, config) {
      if ("yes" != self$vrf_option_value(config, "generic.debug")) {
        return()
      }

      if (is.null(self$debugger)) {
        self$debugger <- Debugger$new()
      }

      self$debugger$open_debug(message)
    },

    #' @description
    #' Wrapper method for the adding a new debugging message with Debugger
    #' class.
    #'
    #' @param message message to debug to console
    #'
    vrf_add_debug = function(message) {
      if (is.null(self$debugger)) {
        return()
      }

      self$debugger$add_debug(message)
    },

    #' @description
    #' Special method for adding the compared files into debugger stack.
    #'
    vrf_add_debug_files = function() {
      if (is.null(self$debugger)) {
        return()
      }

      self$debugger$add_debug(paste("File 1:", self$file1))
      self$debugger$add_debug(paste("File 2:", self$file2))
    },

    #' @description
    #' Wrapper method for the stopping (closing) current debugging instance with
    #' Debugger class.
    #'
    vrf_close_debug = function() {
      if (is.null(self$debugger)) {
        return()
      }
      self$debugger$close_debug()
    }
  )
)
# nolint end: cyclocomp_linter

#' TxtWithImageFileComparator.R
#'
#' "Abstract"  comparator for txt based comparator classes that can additionally
#' contain embedded images. This abstraction level contains generic logic for
#' handling embedded images and storing the related data.
#'
#' @import stringr
#'
#' @include TxtFileComparator.R
#'
#' @field file1_images_raw local property for storing image1 raw data
#' @field file2_images_raw local property for storing image2 raw data
#'

# Disable cyclomatic complexity lint for the R6 class definition as lintr
# considers the whole class definition as a single function.
#
# nolint start: cyclocomp_linter
TxtWithImagesFileComparator <- R6::R6Class(
  "TxtWithImagesFileComparator",
  inherit = TxtFileComparator,
  public = list(
    file1_images_raw = NULL,
    file2_images_raw = NULL,

    #' @description
    #' Initialize a TxtWithImagesFileComparator instance
    #'
    #' @param file1 First file to compare.
    #' @param file2 Second file to compare.
    #'
    initialize = function(file1 = NULL, file2 = NULL) {
      super$initialize(file1, file2)
    },

    #' @description
    #' Method for comparing the inner part for the details query. This method
    #' can be overwritten by more specialized comparator classes. This method is
    #' intended to be called only by the comparator classes in the processing
    #' and shouldn't be called directly by the user.
    #'
    #' @param config configuration values
    #' @param omit   string pattern to omit from the comparison
    #'
    vrf_summary_inner = function(config, omit) {
      self$vrf_open_debug("TxtWithImages::vrf_summary_inner" , config)

      result <- super$vrf_summary_inner(config, omit)

      if ("no" != super$vrf_option_value(config, "generic.images")) {
        file1_contents_list <- self$file1_contents_list
        file2_contents_list <- self$file2_contents_list

        if (is.null(self$file1_images_raw)) {
          self$file1_images_raw <- self$vrf_images(self$file1, config)
        }

        if (is.null(self$file2_images_raw)) {
          self$file2_images_raw <- self$vrf_images(self$file2, config)
        }

        # Generate additional summary string based on embedded image differences
        # if applicable.
        if (0 != length(self$file1_images_raw) && 0 != length(self$file2_images_raw)) {
          result_images <- "No differences in embedded images."
  
          if (length(self$file1_images_raw) != length(self$file2_images_raw)) {
            # Number of found embedded images differs between the files.
            result_images <- "Different amount of embedded images."
          } else {
            # Number of found embedded images is the same; calculate how many of
            # the embedded images has changed (based on raw file data) compared to
            # total count.
            matches <- 0
            total <- length(self$file1_images_raw)

            for (index in seq_along(self$file1_images_raw)) {
              if (identical(self$file1_images_raw[[index]], self$file2_images_raw[[index]])) {
                matches <- matches + 1
              }
            }

            if (matches != length(self$file1_images_raw)) {
              result_images <- paste0(total - matches, "/", total, " embedded images have differences.")
            }
          }
          result <- paste0(result, " ", result_images)
        }
      }

      self$vrf_close_debug()
      return(result)
    },

    #' @description
    #' Method for comparing the inner part for the details query. This method
    #' can be overwritten by more specialized comparator classes. This method is
    #' intended to be called only by the comparator classes in the processing
    #' and shouldn't be called directly by the user.
    #'
    #' @param config configuration values
    #' @param omit   string pattern to omit from the comparison
    #'
    vrf_details_inner = function(config, omit) {
      self$vrf_open_debug("TxtWithImages::vrf_details_inner" , config)

      result <- super$vrf_details_inner(config, omit)

      if ("no" != super$vrf_option_value(config, "generic.images")) {
        file1_contents_list <- self$file1_contents_list
        file2_contents_list <- self$file2_contents_list

        if (is.null(self$file1_images_raw)) {
          self$file1_images_raw <- self$vrf_images(self$file1, config)
        }

        if (is.null(self$file2_images_raw)) {
          self$file2_images_raw <- self$vrf_images(self$file2, config)
        }

        # Append the possible extended images into the result list if applicable.
        # List of images is included in the fileX_contents_lists if found from
        # content getter.
        if (0 != length(self$file1_images_raw) && 0 != length(self$file2_images_raw)) {

          # Only display the differences if there is the same amount of images
          # found from the compared files. Otherwise it would require additional
          # logic to decide which files should be compared with each others (which
          # is something that could be developed further with size comparisons).
          if (length(self$file1_images_raw) == length(self$file2_images_raw)) {
            for (index in seq_along(self$file1_images_raw)) {
              # Manually create a ImgFileComparator instance for every embedded
              # image and call the details comparison based on existing bin data.
              comparator <- ImgFileComparator$new(
                NULL,
                NULL,
                self$file1_images_raw[[index]],
                self$file2_images_raw[[index]]
              )
              result <- append(result, comparator$vrf_details_inner(config, omit))
            }
          }
        }
      }

      self$vrf_close_debug()
      return(result)
    },

    #' @description
    #' "Abstract" method for getting the raw image hex vector array from the
    #' given source file.
    #'
    #' @param file file for which to get the embedded image details
    #'
    vrf_images = function(file) {
      stop("vrf_images must be implemented in a subclass.")
    },

    #' @description
    #' Internal helper method for converting a hex string to raw vector.
    #'
    #' @param hex_string hexadecimal string to be converted to raw vector
    #'
    hex2raw = function(hex_string) {
      # Remove non-hex characters
      hex_string <- gsub("[^0-9a-fA-F]", "", hex_string)

      # check that the input string is a hex string
      if (nchar(hex_string) %% 2 != 0 || nchar(hex_string) < 2) {
        stop("input string isn't a hex string")
      }

      # Generate start and end indices
      start_indices <- seq(1, nchar(hex_string), 2)
      end_indices <- seq(2, nchar(hex_string), 2)

      # Extract byte-sized chunks
      bytes <- substring(hex_string, start_indices, end_indices)

      as.raw(as.hexmode(bytes))
    }
  )
)
# nolint end: cyclocomp_linter


generic_level_desc <- paste0(
  "Option to define whether the comparison is processed and displayed on ",
  "word or row level. Word-level processing requires additional time for ",
  "comparison calculation, so it may be advisable to disable this option ",
  "when working with large files if row-level comparison is sufficient."
)

generic_images_desc <- paste0(
  "Option to define whether embedded images should be processed for all ",
  "supported file types. Processing embedded images requires additional ",
  "time to detect and extract images from documents, so it may be ",
  "advisable to disable this option when working with large files or a ",
  "high volume of files that do not contain images."
)

generic_spaces_desc <- paste0(
  "Option to define whether differences in whitespace should be ignored ",
  "during comparison. When enabled, differences caused solely by additional ",
  "spaces or tab characters are not reported."
)

generic_debug_desc <- paste0(
  "Option to enable debugging so that the application prints diagnostic ",
  "information to the output stream. This option is available to all users ",
  "and can be enabled to include debugging details when reporting issues."
)

rtf_images_desc <- paste0(
  "Option to define whether embedded images should be processed for RTF file ",
  "types. Processing embedded images requires additional time to detect and ",
  "extract images from documents, so it may be advisable to disable this ",
  "option when working with large files or a high volume of files that do ",
  "not contain images."
)

pdf_details_desc <- paste0(
  "Option to define whether detailed PDF comparison should be performed. ",
  "Disabling this option is generally not recommended for users. However, it ",
  "may be automatically disabled by the application if the required ",
  "'pdftools' package is not available."
)

details_mode_desc <- paste0(
  "Option to define the default display mode for the details summary view. ",
  "The available options are 'full,' which displays the complete compared ",
  "file, and 'summary,' which displays only the detected differences."
)

merge_values <- function(defaults, overrides) {
  result <- list()

  for (name in names(defaults)) {
    def <- defaults[[name]]
    over <- overrides[[name]]

    has_defaults <- "default" %in% names(def)
    has_options  <- "options" %in% names(def)

    if (is.list(def) && has_defaults && has_options) {
      if (!is.null(over) && over %in% def$options) {
        result[[name]] <- over
      } else {
        result[[name]] <- def$default
      }
    } else if (is.list(def)) {
      if (!is.list(over)) over <- list()
      result[[name]] <- merge_values(def, over)
    } else {
      result[[name]] <- if (!is.null(over)) over else def
    }
  }

  result
}

get_nested_value <- function(config, key) {
  parts <- strsplit(key, ".", fixed = TRUE)[[1]]

  for (p in parts) {
    config <- config[[p]]
  }
  config
}

set_nested_value <- function(config, key, value) {
  parts <- strsplit(key, ".", fixed = TRUE)[[1]]

  if (length(parts) == 1) {
    config[[parts[1]]] <- value
  } else {
    sub_key <- paste(parts[-1], collapse = ".")
    config[[parts[1]]] <- set_nested_value(config[[parts[1]]], sub_key, value)
  }
  config
}

check_magick_available <- function() {
  requireNamespace("magick", quietly = TRUE)
}

check_pdftools_available <- function() {
  requireNamespace("pdftools", quietly = TRUE)
}

#' Config.R
#'
#' Class for manging the library configuration options. Creates the default
#' configuration without any source file, populates partial or missing config
#' elements, stores the config file to local machine, and provides easy access
#' methods for setting and getting config values.
#'
#' @examples
#'
#' # Creates the configuration instance. Checks automatically if there is
#' # a previously stored configuration json file available for usage. Note
#' # that you don't need to explicitly define the config file path for the
#' # Config instance - by default the config file will be searched from and
#' # written in user-specific configuration directory for the package.
#'
#' path   <- tempfile(fileext = ".json")
#' config <- Config$new(config_path = path)
#'
#' # Getting and setting configuration values
#'
#' value <- config$get("defailts.mode")
#' config$set("details.mode", "full")
#'
#' # Saving the current configuration to local machine (to tmp folder with
#' # the given explicit file path in initialization).
#'
#' config$save()
#'
#' @import jsonlite
#' @import rappdirs
#' @importFrom R6 R6Class
#'
#' @field schema configuration schema
#' @field config current configuration data
#' @field path   configuration json file path
#'
#' @export
#'
Config <- R6::R6Class(
  "Config",
  public = list(
    schema = NULL,
    config = NULL,
    path   = NULL,

    #' @description
    #' Constructor for initializing the configuration. Checks the local machine
    #' for existing configuration file is load_config = TRUE. Ensures that all
    #' the project configuration values are included.
    #'
    #' @param load_config load configuration from local machine if available
    #' @param config_path location of the used/stored configuration json file
    #'
    initialize = function(load_config = TRUE, config_path = NULL) {
      self$schema <- self$get_default_schema()
      self$config <- self$get_default_config()

      if (is.null(config_path)) {
        config_dir <- rappdirs::user_config_dir("verifyr2")
        self$path  <- file.path(config_dir, "config.json")
      } else {
        self$path <- config_path
      }

      if (load_config && file.exists(self$path)) {
        file_config <- jsonlite::read_json(self$path, simplifyVector = TRUE)
        self$config <- merge_values(self$get_default_schema(), file_config)
        self$config <- self$get_default_config() |> merge_values(self$config)
      }
    },

    #' @description
    #' Method for getting schema item based on configuration key.
    #' Configuration item children are separated with a dot in the key notation.
    #'
    #' @param key configuration property key for which to get the schema item
    #'
    get_schema_item = function(key) {
      get_nested_value(self$schema, key)
    },

    #' @description
    #' Method for getting configuration value based on configuration key.
    #' Configuration item children are separated with a dot in the key notation.
    #'
    #' @param key configuration property key for which to get the value
    #'
    get = function(key) {
      get_nested_value(self$config, key)
    },

    #' @description
    #' Method for setting configuration value based on configuration key.
    #' Configuration item children are separated with a dot in the key notation.
    #'
    #' @param key   configuration property key for which to get the value
    #' @param value value to set for the specified configuration key
    #'
    set = function(key, value) {
      self$config <- set_nested_value(self$config, key, value)
    },

    #' @description
    #' Method for saving the current configuration data into local machine.
    #'
    save = function() {
      dir.create(dirname(self$path), showWarnings = FALSE, recursive = TRUE)
      jsonlite::write_json(self$config, self$path, pretty = TRUE)
    },

    #' @description
    #' Helper method for getting configuration default values. These default
    #' values will be used in the configuration in case the configuration
    #' properties are not present previously.
    #'
    get_default_config = function() {
      defaults <- list()

      for (group in names(self$schema)) {
        defaults[[group]] <- list()

        for (key in names(self$schema[[group]])) {
          if (key != "title") {
            defaults[[group]][[key]] <- self$schema[[group]][[key]]$default
          }
        }
      }
      defaults
    },

    #' @description
    #' Method for getting the full configuration schema. Apart from the
    #' configuration data, the schema contains property descriptions as well as
    #' all possible values for the configuration properties.
    #'
    get_default_schema = function() {
      schema <- list(
        generic = list(
          title = "Generic options",
          level = list(
            title   = "Comparison level",
            options = c("word", "row"),
            default = "word",
            reload  = TRUE,
            desc    = generic_level_desc
          ),
          spaces = list(
            titlei  = "Ignore empty space differences",
            options = c("yes", "no"),
            default = "no",
            reload  = TRUE,
            desc    = generic_spaces_desc
          ),
          images = list(
            title   = "Process embedded images",
            options = c("yes", "no"),
            default = "yes",
            reload  = TRUE,
            desc    = generic_images_desc
          ),
          debug = list(
            title   = "Debugging enabled",
            options = c("yes", "no"),
            default = "no",
            reload  = FALSE,
            desc    = generic_debug_desc
          )
        ),
        rtf = list(
          title = "RTF comparison (summary and details)",
          images = list(
            title   = "Process embedded images",
            options = c("yes", "no"),
            default = "yes",
            reload  = TRUE,
            desc    = rtf_images_desc
          )
        ),
        pdf = list(
          title = "PDF comparison (summary)",
          details = list(
            title = "Process PDF detailed comparison",
            options = c("yes", "no"),
            default = "yes",
            reload  = TRUE,
            desc    = pdf_details_desc
          )
        ),
        details = list(
          title = "Details comparison",
          mode = list(
            title = "Mode",
            options = c("full", "summary"),
            default = "summary",
            reload  = FALSE,
            desc    = details_mode_desc
          )
        )
      )

      if (!check_magick_available()) {
        schema[["generic"]][["images"]] <- list(
          title   = "Process embedded images (missing magick library)",
          options = c("no"),
          default = "no",
          reload  = TRUE,
          desc    = generic_images_desc
        )

        schema[["rtf"]][["images"]] <- list(
          title   = "Process embedded images (missing magick library)",
          options = c("no"),
          default = "no",
          reload  = TRUE,
          desc    = rtf_images_desc
        )
      }

      if (!check_pdftools_available()) {
        schema[["pdf"]][["details"]] <- list(
          title   = "Process PDF details (missing pdftools library)",
          options = c("no"),
          default = "no",
          reload  = TRUE,
          desc    = pdf_details_desc
        )
      }

      schema
    }
  )
)


#' Debugger.R
#'
#' Class for managing the library debugging. Tracks the debugged method
#' execution times and prints out the full debugging information only when
#' the main debugging instance is stopped.
#'
#' @examples
#'
#' # Creates a debugger instance.
#'
#' debugger <- Debugger$new()
#'
#' # Opening and closing debugs in multileveled function calls.
#'
#' function1 <- function() {
#'   debugger$open_debug("function1")
#'   function2()
#'   debuger$close_debug()
#' }
#'
#' function2 <- function() {
#'   debugger$open_debug("function2")
#'   Sys.sleep(1)
#'   debugger$close_debug()
#' }
#'
#' # This will produce the following printout to the console after the
#' # function1 finishes
#' #
#' # - 'function1' (execution time 7 ms)
#' #   - 'function2' (execution time 5 ms)
#'
#' @importFrom R6 R6Class
#'
#' @field stack local property for storing debugging labels and start times
#'
#' @export
#'
Debugger <- R6::R6Class("Debugger",
  public = list(
    stack = list(),

    #' @description
    #' Constructor for initializing the Debugger instance.
    #'
    initialize = function() {
      self$stack <- list()
    },

    #' @description
    #' Method for opening new debug instance to the current debugging stack.
    #' Stores also the start time for execution time calculation.
    #'
    #' @param label debugging message
    #'
    open_debug = function(label) {
      entry <- list(
        label      = label,
        start_time = Sys.time(),
        children   = list(),
        duration   = NULL,
        is_message = FALSE
      )
      self$stack[[length(self$stack) + 1]] <- entry
    },

    #' @description
    #' Method for adding a new debug string under the currently open
    #' debug instance.
    #'
    #' @param label debugging message
    #'
    add_debug = function(label) {
      msg <- list(
        label      = label,
        children   = list(),
        duration   = NULL,
        is_message = TRUE
      )

      parent <- self$stack[[length(self$stack)]]
      parent$children[[length(parent$children) + 1]] <- msg
      self$stack[[length(self$stack)]] <- parent
    },

    #' @description
    #' Method for closing a debug instance from the current debugging
    #' stack. If the stopped debug instance is the main level one, the
    #' whole debug data is printed out to console. If the stopped debug
    #' instance is not the main level one, calculates the execution time
    #' of current debug instance and updates the stack data.
    #'
    close_debug = function() {
      # Pop the last entry
      entry <- self$stack[[length(self$stack)]]
      self$stack <- self$stack[-length(self$stack)]

      time_diff      <- difftime(Sys.time(), entry$start_time, units = "secs")
      entry$duration <- round(as.numeric(time_diff) * 1000)

      if (length(self$stack) > 0) {
        parent <- self$stack[[length(self$stack)]]
        parent$children[[length(parent$children) + 1]] <- entry
        self$stack[[length(self$stack)]] <- parent
      } else {
        self$print_debug_tree(entry)
        cat("[DEBUG]'\n")
      }
    },

    #' @description
    #' Recursive method for printing out the current debug stack items and
    #' recursively all the item children. This method is called for the whole
    #' stack once the topmost debug instance is stopped.
    #'
    #' @param entry current debug level being processed for printing
    #' @param depth current processing depth for printing indentation
    #'
    print_debug_tree = function(entry, depth = 0) {
      indent <- paste("[DEBUG]", strrep("  ", depth))
      if (isTRUE(entry$is_message)) {
        cat(indent, "'", entry$label, "'\n", sep = "")
      } else {
        execution_time <- paste0("(execution time ", entry$duration, " ms)")
        cat(indent, "'", entry$label, "' ", execution_time, "\n", sep = "")

        for (child in entry$children) {
          self$print_debug_tree(child, depth + 1)
        }
      }
    }
  )
)

#' FileComparatorFactory.R
#'
#' Factory method for creating comparator instance based on the given two files.
#'
#' @param file1 first file to compare
#' @param file2 second file to compare
#'
#' @examples
#'
#' # instantiating the compared files
#' file1 <- "file1.rtf"
#' file2 <- "file2.rtf"
#'
#' # instantiating the configuration
#' config <- Config$new()
#'
#' # instantiating a new comparator instance for every comparison:
#' comparator <- verifyr2::create_comparator(file1, file2)
#'
#' # calling the summary and details comparison methods
#' comparator$vrf_summary(config = config)
#' comparator$vrf_details(config = config)
#'
#' @include BinaryFileComparator.R
#' @include TxtFileComparator.R
#'
#' @export
#'
create_comparator <- function(file1, file2) {
  if (!file.exists(file1) || !file.exists(file2)) {
    return(BinaryFileComparator$new(file1 = file1, file2 = file2))
  }

  file_extension  <- tools::toTitleCase(tools::file_ext(file1))

  if (file_extension %in% list("Jpg", "Jpeg", "Png")) {
    file_extension <- "Img"
  }

  # construct the comparator name
  comparator_name <- paste0(file_extension, "FileComparator")

  if (exists(comparator_name, envir = .GlobalEnv)) {
    class_def <- get(comparator_name, envir = .GlobalEnv)

    # return the specific class instance if the class exists
    if (inherits(class_def, "R6ClassGenerator")) {
      return(do.call(class_def$new, list(file1 = file1, file2 = file2)))
    }
  }

  # generic comparator class used based on the file contents (text/binary).
  mime_type <- mime::guess_type(file1)

  text_like <- c(
    "application/json",
    "application/xml",
    "application/javascript",
    "application/x-yaml",
    "application/sql",
    "application/x-httpd-php",
    "application/x-sh",
    "application/csv",
    "application/x-tex",
    "application/x-markdown"
  )

  # additional types that the mime::guess_type mapping doesn't handle correctly
  additional_text_types <- c(
    "Lst",
    "Sas"
  )

  txt_type <- startsWith(mime_type, "text/")
  fix_type <- mime_type %in% text_like
  add_type <- file_extension %in% additional_text_types

  if (txt_type || fix_type || add_type) {
    TxtFileComparator$new(file1 = file1, file2 = file2)
  } else {
    BinaryFileComparator$new(file1 = file1, file2 = file2)
  }
}

is_r6_class <- function(class_name) {
  obj <- try(get(class_name, envir = .GlobalEnv), silent = TRUE)
  inherits(obj, "R6ClassGenerator")
}

#' Call for shiny example where the user can test verifyr2 package functions
#'
#' \code{verifyr2::run_example} returns simple Shiny App where user can see how
#' the verifyr2 functions work
#'
#' @export
#'
#' @param debug option to override debug configuration (TRUE only)
#'
run_example <- function(debug = FALSE) {
  appDir <- system.file("shiny_examples", "app", package = "verifyr2")

  if (appDir == "") {
    stop("Could not find example directory. Try re-installing `verifyr2`.",
         call. = FALSE)
  }

  options(verifyr2.debug = debug)
  shiny::runApp(appDir, display.mode = "normal")
}

#' List files that exist in two folders
#'
#' \code{list_folder_files} List files that exist in two folders with a specific
#' name pattern
#'
#' @param folder1 character, giving the the full file path and name of the
#'                folder where first files are stored (required)
#' @param folder2 character, giving the the full file path and name of the
#'                folder where second new files are stored (required)
#' @param pattern character, limit the files to be listed to contain a
#'                specific pattern (optional)
#'
#' @return Returns a tibble, \code{selected_files} with 2 columns \code{file1},
#'                 \code{file2}
#'
#' @examples
#'
#' folder1 <- paste0(fs::path_package("/extdata/base_files/",
#'                                    package = "verifyr2"))
#'
#' folder2 <- paste0(fs::path_package("/extdata/compare_files/",
#'                                    package = "verifyr2"))
#'
#' verifyr2::list_folder_files(folder1, folder2, "base")
#'
#' @export

list_folder_files <- function(folder1, folder2, pattern = NULL) {

  ## do the comparison only if both of the folders exist
  if (file.exists(folder1) && file.exists(folder2)) {

    folder1_info <- folder_info(folder1, "file1", pattern)
    folder2_info <- folder_info(folder2, "file2", pattern)

    selected_files <- dplyr::full_join(folder1_info,
                                       folder2_info,
                                       by = "file") |>
      dplyr::arrange(file) |>
      dplyr::select("file1", "file2")

    return(selected_files)
  }

  NULL
}

folder_info <- function(folder, column_name, pattern) {
  files  <- list.files(path = folder, pattern = pattern)
  paths  <- list.files(path = folder, pattern = pattern, full.names = TRUE)
  data   <- tibble::tibble(file = files)
  data[[column_name]] <- paths

  data
}

#' One row list for two distinct files
#'
#' \code{list_files} List single file row based on the explicit parameter
#' files. This is a conveniency function for building same structure list for
#' direct two file comparison case.
#'
#' @param file1 character, giving the the full file path of the first file
#' @param file2 character, giving the the full file path of the second file
#'
#' @return Returns a tibble, \code{selected_files} with 2 columns \code{file1},
#'                 \code{file2}
#'
#' @examples
#'
#' path1 <- "/extdata/base_files/file2_additional_rows.rtf"
#' file1 <- paste0(fs::path_package(path1, package = "verifyr2"))
#'
#' path2 <- "/extdata/compare_files/file3_changed_rows.rtf"
#' file2 <- paste0(fs::path_package(path2, package = "verifyr2"))
#'
#' verifyr2::list_files(file1, file2)
#'
#' @export

list_files <- function(file1, file2) {

  ## do the comparison only if both of the files exist
  if (file.exists(file1) && file.exists(file2)) {

    data <- tibble::tibble(
      "file1" = file1,
      "file2" = file2
    )

    return(data)
  }

  NULL
}

1		#' RtfFileComparator.R
2		#'
3		#' Specialiced comparator for RTF file comparison.
4		#' This comparator contains the custom handling for handling only RTF content
5		#' part for the comparison.
6		#'
7		#' @import striprtf
8		#'
9		#' @include TxtWithImagesComparator.R
10		#'
11		#' @examples
12		#'
13		#' # The normal way for creating a comparator would be to call the generic
14		#' # factory method verifyr2::create_comparator that will automatically create
15		#' # the correct comparator instance based on the file types.
16		#'
17		#' file1 <- 'my_file1.rtf'
18		#' file2 <- 'my_file2.rtf'
19		#' comparator <- verifyr2::create_comparator(file1, file2)
20		#'
21		#' # If needed, an explicit comparator can be created as well.
22		#'
23		#' file1 <- 'my_file1.rtf'
24		#' file2 <- 'my_file2.rft'
25		#' comparator <- RtfFileComparator$new(file1, file2)
26		#'
27		#' @export
28		#'
29		RtfFileComparator <- R6::R6Class(
30		"RtfFileComparator",
31		inherit = TxtWithImagesFileComparator,
32		public = list(
33
34		#' @description
35		#' Method for getting the single file contents for the comparison. The
36		#' method returns the file contents in two separate vectors inside a list.
37		#' The first vector is the file contents and the second one is the file
38		#' contents with the rows matching the omit string excluded. This method
39		#' can be overwritten by more specialized comparator classes. This method
40		#' is intended to be called only by the comparator classes in the processing
41		#' and shouldn't be called directly by the user.
42		#'
43		#' For RtfComparator, only the RTF file content part is returned for
44		#' comparison.
45		#'
46		#' @param file file for which to get the contents
47		#' @param config configuration values
48		#' @param omit string pattern to omit from the comparison
49		#'
50		vrf_contents = function(file, config, omit) {
51	50x	self$vrf_open_debug("Rtf::vrf_contents", config)
52
53		# Get the RTF text content
54	50x	contents <- striprtf::read_rtf(file = file)
55	50x	result <- self$vrf_contents_inner(contents, config, omit)
56
57	50x	self$vrf_close_debug()
58	50x	result
59		},
60
61		#' @description
62		#' "Abstract" method for getting the raw image hex vector array from the
63		#' given source file.
64		#'
65		#' @param file file for which to get the embedded image details
66		#' @param config configuration values
67		#'
68		vrf_images = function(file, config) {
69	48x	self$vrf_open_debug("Rtf::vrf_images", config)
70
71		# return empty list if embedded image processing is disabled
72	48x	if ("no" == super$vrf_option_value(config, "rtf.images")) {
73	6x	self$vrf_close_debug()
74	6x	return(list())
75		}
76
77		# return empty list if image processing is disabled
78	42x	if ("no" == super$vrf_option_value(config, "generic.images")) {
79	!	self$vrf_close_debug()
80	!	return(list())
81		}
82
83	42x	result <- list()
84
85		# Read the RTF file embedded images
86	42x	rtf_content <- readLines(file, warn = FALSE)
87	42x	rtf_content <- paste(rtf_content, collapse = "\n")
88
89		# regexp for finding the png pictures from the raw RTF content.
90	42x	pattern <- "\\\\pict\\\\pngblip[^{]+([A-Za-z0-9+/=]+)"
91	42x	matches <- stringr::str_extract_all(rtf_content, pattern)[[1]]
92
93	42x	if (length(matches) > 0) {
94	8x	for (index in seq_along(matches)) {
95	8x	split_parts <- strsplit(matches[index], " ")[[1]]
96	8x	base64_data_with_braces <- split_parts[2]
97	8x	base64_data <- strsplit(base64_data_with_braces, "}")[[1]][1]
98
99	8x	if (!is.na(base64_data) && nchar(base64_data) > 0) {
100	8x	raw_data <- self$hex2raw(base64_data)
101	8x	result <- c(result, list(raw_data))
102		}
103		}
104		}
105
106	42x	self$vrf_close_debug()
107	42x	result
108		}
109		)
110		)

1		#' ImgFileComparator.R
2		#'
3		#' Specialiced comparator for image file (jpg, jpef, png) comparison.
4		#' This comparator contains the custom handling for handling only img content
5		#' part for the comparison.
6		#'
7		#' @import base64enc
8		#'
9		#' @include BinaryFileComparator.R
10		#'
11		#' @field image1_raw extracted raw data for image1.
12		#' @field image2_raw extracted raw data for image2.
13		#'
14		#' @examples
15		#'
16		#' # The normal way for creating a comparator would be to call the generic
17		#' # factory method verifyr2::create_comparator that will automatically create
18		#' # the correct comparator instance based on the file types.
19		#'
20		#' file1 <- 'my_file1.jpg'
21		#' file2 <- 'my_file2.jpg'
22		#' comparator <- verifyr2::create_comparator(file1, file2)
23		#'
24		#' # If needed, an explicit comparator can be created as well.
25		#'
26		#' file1 <- 'my_file1.png'
27		#' file2 <- 'my_file2.png'
28		#' comparator <- ImgFileComparator$new(file1, file2)
29		#'
30		#' # This comparator has also second explicit creation method that is used
31		#' # by the library for processing embedded image contents.
32		#'
33		#' image1_raw <- 'raw hex vector data'
34		#' image2_raw <- 'raw hex vector data'
35		#' comparator <- ImgFileComparator$new(NULL, NULL, image1_raw, image2_raw)
36		#'
37		#' @export
38		#'
39		ImgFileComparator <- R6::R6Class(
40		"ImgFileComparator",
41		inherit = BinaryFileComparator,
42		public = list(
43		image1_raw = NULL,
44		image2_raw = NULL,
45
46		#' @description
47		#' Initialize a ImgFileComparator instance
48		#'
49		#' @param file1 First file to compare.
50		#' @param file2 Second file to compare.
51		#' @param raw1 First image in raw format to compare.
52		#' @param raw2 Second image in raw format to compare.
53		#'
54		initialize = function(
55		file1 = NULL,
56		file2 = NULL,
57		raw1 = NULL,
58		raw2 = NULL
59		) {
60	7x	self$image1_raw <- raw1
61	7x	self$image2_raw <- raw2
62	7x	super$initialize(file1, file2)
63		},
64
65		#' @description
66		#' Method for comparing the inner part for the details query. This method
67		#' can be overwritten by more specialized comparator classes. This method is
68		#' intended to be called only by the comparator classes in the processing
69		#' and shouldn't be called directly by the user.
70		#'
71		#' @param config configuration values
72		#' @param omit string pattern to omit from the comparison
73		#'
74		vrf_details_inner = function(config, omit) {
75	4x	self$vrf_open_debug("Img::vrf_details_inner", config)
76
77	4x	if ("no" == super$vrf_option_value(config, "generic.images")) {
78	!	result <- list(
79	!	list(
80	!	type = "text",
81	!	contents = "Image comparison disabled; no comparison done."
82		)
83		)
84
85	!	self$vrf_close_debug()
86	!	return(result)
87		}
88
89	4x	if (is.null(self$image1_raw) \|\| is.null(self$image2_raw)) {
90	2x	result <- self$vrf_details_inner_from_files(config)
91
92	2x	self$vrf_close_debug()
93	2x	return(result)
94		}
95
96	2x	result <- self$vrf_details_inner_from_raw(config)
97
98	2x	self$vrf_close_debug()
99	2x	result
100		},
101
102		#' @description
103		#' Internal method for comparing the earlier populated raw image contents in
104		#' details and generating the difference highlight image in case differences
105		#' are found.
106		#'
107		#' @param config configuration values
108		#*
109		vrf_details_inner_from_raw = function(config) {
110	4x	self$vrf_open_debug("Img::vrf_details_inner_from_raw", config)
111
112	4x	png_prefix <- "data:image/png;base64,"
113	4x	image1_raw <- self$image1_raw
114	4x	image2_raw <- self$image2_raw
115	4x	image3_base64 <- NULL
116
117	4x	if (!identical(image1_raw, image2_raw)) {
118	3x	image1 <- magick::image_read(image1_raw)
119	3x	image2 <- magick::image_read(image2_raw)
120
121	3x	diff <- magick::image_compare(image1, image2, metric = "AE")
122	3x	highlight <- magick::image_composite(image1, diff, operator = "atop")
123
124	3x	image3_raw <- magick::image_write(highlight, format = "png")
125	3x	image3_base64 <- paste0(png_prefix, base64enc::base64encode(image3_raw))
126		}
127
128	4x	image1_base64 <- paste0(png_prefix, base64enc::base64encode(image1_raw))
129	4x	image2_base64 <- paste0(png_prefix, base64enc::base64encode(image2_raw))
130
131	4x	result <- list(
132	4x	type = "image",
133	4x	contents = list(
134	4x	image1 = image1_base64,
135	4x	image2 = image2_base64,
136	4x	image3 = image3_base64
137		)
138		)
139
140	4x	self$vrf_close_debug()
141	4x	list(result)
142		},
143
144		#' @description
145		#' Method for comparing the inner part for the details query with the file
146		#' names as the base arguments. This is a part of a group of image
147		#' processing functions that work with different image abstractions (file,
148		#' image, raw image). These methods are intended to improve the performance
149		#' so that best suiting method version can be used depending on what data is
150		#' available from the earlier method calls to the same comparator instance.
151		#'
152		#' @param config configuration values
153		#'
154		vrf_details_inner_from_files = function(config) {
155	2x	self$vrf_open_debug("Img::vrf_details_inner_from_files", config)
156
157	2x	file1_size <- file.info(self$file1)$size
158	2x	self$image1_raw <- readBin(self$file1, what = "raw", n = file1_size)
159
160	2x	file2_size <- file.info(self$file2)$size
161	2x	self$image2_raw <- readBin(self$file2, what = "raw", n = file2_size)
162
163	2x	result <- self$vrf_details_inner_from_raw(config)
164
165	2x	self$vrf_close_debug()
166	2x	result
167		},
168
169		#' @description
170		#' Inherited method for indicating whether detailed comparison is available
171		#' with the current comparator. Returns an empty string if the comparator is
172		#' is supported, otherwise a string that will be concatenated with the
173		#' summary string.
174		#'
175		#' @param config configuration values
176		#'
177		vrf_details_supported = function(config) {
178	5x	if ("no" == super$vrf_option_value(config, "generic.images")) {
179	1x	return("Image details comparison disabled.")
180		}
181		""
182		}
183		)
184		)

1		#' PdfFileComparator.R
2		#'
3		#' Specialiced comparator for PDF file comparison.
4		#' This comparator contains the custom handling for handling only PDF content
5		#' part for the comparison.
6		#'
7		#' @include BinaryFileComparator.R
8		#' @include TxtFileComparator.R
9		#'
10		#' @examples
11		#'
12		#' # The normal way for creating a comparator would be to call the generic
13		#' # factory method verifyr2::create_comparator that will automatically create
14		#' # the correct comparator instance based on the file types.
15		#'
16		#' file1 <- 'my_file1.pdf'
17		#' file2 <- 'my_file2.pdf'
18		#' comparator <- verifyr2::create_comparator(file1, file2)
19		#'
20		#' # If needed, an explicit comparator can be created as well.
21		#'
22		#' file1 <- 'my_file1.pdf'
23		#' file2 <- 'my_file2.pdf'
24		#' comparator <- PdfFileComparator$new(file1, file2)
25		#'
26		#' @export
27		#'
28		PdfFileComparator <- R6::R6Class(
29		"PdfFileComparator",
30		inherit = TxtFileComparator,
31		public = list(
32
33		#' @description
34		#' Method for getting the single file contents for the comparison. The
35		#' method returns the file contents in two separate vectors inside a list.
36		#' The first vector is the file contents and the second one is the file
37		#' contents with the rows matching the omit string excluded. This method
38		#' can be overwritten by more specialized comparator classes. This method
39		#' is intended to be called only by the comparator classes in the processing
40		#' and shouldn't be called directly by the user.
41		#'
42		#' @param file file for which to get the contents
43		#' @param config configuration values
44		#' @param omit string pattern to omit from the comparison
45		#'
46		vrf_contents = function(file, config, omit) {
47	40x	self$vrf_open_debug("Pdf::vrf_contents", config)
48
49	40x	if ("no" == super$vrf_option_value(config, "pdf.details")) {
50	2x	result <- super$vrf_contents(file, config, omit)
51
52	2x	self$vrf_close_debug()
53	2x	return(result)
54		}
55
56	38x	content <- pdftools::pdf_text(file)
57	38x	content <- paste(content, collapse = "")
58	38x	content <- strsplit(content, "\n")[[1]]
59
60	38x	result <- self$vrf_contents_inner(content, config, omit)
61
62	38x	self$vrf_close_debug()
63	38x	result
64		},
65
66		#' @description
67		#' Inherited method for indicating whether detailed comparison is available
68		#' with the current comparator. Returns an empty string if the comparator is
69		#' is supported, otherwise a string that will be concatenated with the
70		#' summary string.
71		#'
72		#' @param config configuration values
73		#'
74		vrf_details_supported = function(config) {
75	20x	if ("no" == super$vrf_option_value(config, "pdf.details")) {
76	1x	return("Pdf details comparison disabled.")
77		}
78	19x	super$vrf_details_supported(config)
79		}
80		)
81		)

1		#' BinaryFileComparator.R
2		#'
3		#' Fallback comparator for binary files without any specific definied
4		#' comparator.
5		#'
6		#' @include FileComparator.R
7		#'
8		#' @examples
9		#'
10		#' # The normal way for creating a comparator would be to call the generic
11		#' # factory method verifyr2::create_comparator that will automatically create
12		#' # the correct comparator instance based on the file types.
13		#'
14		#' file1 <- 'my_file1.bin'
15		#' file2 <- 'my_file2.bin'
16		#' comparator <- verifyr2::create_comparator(file1, file2)
17		#'
18		#' # If needed, an explicit comparator can be created as well.
19		#'
20		#' file1 <- 'my_file1.bin'
21		#' file2 <- 'my_file2.bin'
22		#' comparator <- BinaryFileComparator$new(file1, file2)
23		#'
24		#' @export
25		#'
26		BinaryFileComparator <- R6::R6Class(
27		"BinaryFileComparator",
28		inherit = FileComparator,
29		public = list(
30
31		#' @description
32		#' Method for getting the single file contents for the comparison. This
33		#' method returns the file contents in two separate vectors inside a list.
34		#' The first vector is the file contents and the second one is the file
35		#' contents with the rows matching the omit string excluded. This method
36		#' can be overwritten by more specialized comparator classes. This method
37		#' is intended to be called only by the comparator classes in the processing
38		#' and shouldn not be called directly by the user.
39		#'
40		#' @param file file for which to get the contents
41		#' @param config configuration values
42		#' @param omit string pattern to omit from the comparison
43		#'
44		vrf_contents = function(file, config, omit) {
45	56x	self$vrf_open_debug("Binary::vrf_contents", config)
46
47	56x	contents <- readLines(file, warn = FALSE)
48	56x	result <- self$vrf_contents_inner(contents, config, omit)
49
50	56x	self$vrf_close_debug()
51	56x	result
52		},
53
54		#' @description
55		#' Method for getting the inner part for the file contents query. The method
56		#' returns the file contents in two separate vectors inside a list. The
57		#' first vector is the file contents and the second one is the file contents
58		#' with the rows matching the omit string excluded. This method can be
59		#' overwritten by more specialized comparator classes. This method is
60		#' intended to be called only by the comparator classes in the processing
61		#' and shouldn not be called directly by the user.
62		#'
63		#' @param contents file contents
64		#' @param config configuration values
65		#' @param omit string pattern to omit from the comparison
66		#'
67		vrf_contents_inner = function(contents, config, omit) {
68	6x	self$vrf_add_debug("Binary::vrf_contents_inner")
69	6x	list(contents, contents)
70		},
71
72		#' @description
73		#' Method for comparing the inner part for the details query. The method
74		#' returns the file contents in two separate vectors inside a list. The
75		#' first vector is the file contents and the second one is the file contents
76		#' processed for empty spaces and omit terms if applicable. This method can
77		#' be overwritten by more specialized comparator classes. This method is
78		#' intended to be called only by the comparator classes in the processing
79		#' and shouldn not be called directly by the user.
80		#'
81		#' @param config configuration values
82		#' @param omit string pattern to omit from the comparison
83		#'
84		vrf_summary_inner = function(config, omit) {
85	6x	self$vrf_open_debug("Binary::vrf_summary_inner", config)
86
87	6x	file_info1 <- file.info(self$file1)
88	6x	file_info2 <- file.info(self$file2)
89
90	6x	if (file_info1$size != file_info2$size) {
91	3x	self$vrf_close_debug()
92	3x	return("Different file sizes for compared files.")
93		}
94
95	3x	file1_contents_list <- self$file1_contents_list
96	3x	file2_contents_list <- self$file2_contents_list
97
98	3x	if (is.null(file1_contents_list)) {
99	3x	file1_contents_list <- self$vrf_contents(self$file1, config, omit)
100	3x	self$file1_contents_list <- file1_contents_list
101		}
102
103	3x	if (is.null(file2_contents_list)) {
104	3x	file2_contents_list <- self$vrf_contents(self$file2, config, omit)
105	3x	self$file2_contents_list <- file2_contents_list
106		}
107
108	3x	file1_contents_processed <- file1_contents_list[[2]]
109	3x	file2_contents_processed <- file2_contents_list[[2]]
110
111	3x	if (!identical(file1_contents_processed, file2_contents_processed)) {
112	1x	self$vrf_close_debug()
113	1x	return("Different content in compared files.")
114		}
115
116	2x	self$vrf_close_debug()
117	2x	"No differences."
118		},
119
120		#' @description
121		#' Method for comparing the inner part for the details query. This method
122		#' can be overwritten by more specialized comparator classes. This method is
123		#' intended to be called only by the comparator classes in the processing
124		#' and shouldn't be called directly by the user.
125		#'
126		#' @param config configuration values
127		#' @param omit string pattern to omit from the comparison
128		#'
129		vrf_details_inner = function(config, omit) {
130	!	self$vrf_add_debug("Binary::vrf_details_inner")
131	!	result <- list(
132	!	type = "text",
133	!	contents = "Binary file without applicable comparator."
134		)
135	!	list(result)
136		}
137		)
138		)

1		#' TxtWithImageFileComparator.R
2		#'
3		#' "Abstract" comparator for txt based comparator classes that can additionally
4		#' contain embedded images. This abstraction level contains generic logic for
5		#' handling embedded images and storing the related data.
6		#'
7		#' @import stringr
8		#'
9		#' @include TxtFileComparator.R
10		#'
11		#' @field file1_images_raw local property for storing image1 raw data
12		#' @field file2_images_raw local property for storing image2 raw data
13		#'
14
15		# Disable cyclomatic complexity lint for the R6 class definition as lintr
16		# considers the whole class definition as a single function.
17		#
18		# nolint start: cyclocomp_linter
19		TxtWithImagesFileComparator <- R6::R6Class(
20		"TxtWithImagesFileComparator",
21		inherit = TxtFileComparator,
22		public = list(
23		file1_images_raw = NULL,
24		file2_images_raw = NULL,
25
26		#' @description
27		#' Initialize a TxtWithImagesFileComparator instance
28		#'
29		#' @param file1 First file to compare.
30		#' @param file2 Second file to compare.
31		#'
32		initialize = function(file1 = NULL, file2 = NULL) {
33	25x	super$initialize(file1, file2)
34		},
35
36		#' @description
37		#' Method for comparing the inner part for the details query. This method
38		#' can be overwritten by more specialized comparator classes. This method is
39		#' intended to be called only by the comparator classes in the processing
40		#' and shouldn't be called directly by the user.
41		#'
42		#' @param config configuration values
43		#' @param omit string pattern to omit from the comparison
44		#'
45		vrf_summary_inner = function(config, omit) {
46	20x	self$vrf_open_debug("TxtWithImages::vrf_summary_inner" , config)
47
48	20x	result <- super$vrf_summary_inner(config, omit)
49
50	20x	if ("no" != super$vrf_option_value(config, "generic.images")) {
51	19x	file1_contents_list <- self$file1_contents_list
52	19x	file2_contents_list <- self$file2_contents_list
53
54	19x	if (is.null(self$file1_images_raw)) {
55	19x	self$file1_images_raw <- self$vrf_images(self$file1, config)
56		}
57
58	19x	if (is.null(self$file2_images_raw)) {
59	19x	self$file2_images_raw <- self$vrf_images(self$file2, config)
60		}
61
62		# Generate additional summary string based on embedded image differences
63		# if applicable.
64	19x	if (0 != length(self$file1_images_raw) && 0 != length(self$file2_images_raw)) {
65	2x	result_images <- "No differences in embedded images."
66
67	2x	if (length(self$file1_images_raw) != length(self$file2_images_raw)) {
68		# Number of found embedded images differs between the files.
69	!	result_images <- "Different amount of embedded images."
70		} else {
71		# Number of found embedded images is the same; calculate how many of
72		# the embedded images has changed (based on raw file data) compared to
73		# total count.
74	2x	matches <- 0
75	2x	total <- length(self$file1_images_raw)
76
77	2x	for (index in seq_along(self$file1_images_raw)) {
78	2x	if (identical(self$file1_images_raw[[index]], self$file2_images_raw[[index]])) {
79	1x	matches <- matches + 1
80		}
81		}
82
83	2x	if (matches != length(self$file1_images_raw)) {
84	1x	result_images <- paste0(total - matches, "/", total, " embedded images have differences.")
85		}
86		}
87	2x	result <- paste0(result, " ", result_images)
88		}
89		}
90
91	20x	self$vrf_close_debug()
92	20x	return(result)
93		},
94
95		#' @description
96		#' Method for comparing the inner part for the details query. This method
97		#' can be overwritten by more specialized comparator classes. This method is
98		#' intended to be called only by the comparator classes in the processing
99		#' and shouldn't be called directly by the user.
100		#'
101		#' @param config configuration values
102		#' @param omit string pattern to omit from the comparison
103		#'
104		vrf_details_inner = function(config, omit) {
105	5x	self$vrf_open_debug("TxtWithImages::vrf_details_inner" , config)
106
107	5x	result <- super$vrf_details_inner(config, omit)
108
109	5x	if ("no" != super$vrf_option_value(config, "generic.images")) {
110	5x	file1_contents_list <- self$file1_contents_list
111	5x	file2_contents_list <- self$file2_contents_list
112
113	5x	if (is.null(self$file1_images_raw)) {
114	5x	self$file1_images_raw <- self$vrf_images(self$file1, config)
115		}
116
117	5x	if (is.null(self$file2_images_raw)) {
118	5x	self$file2_images_raw <- self$vrf_images(self$file2, config)
119		}
120
121		# Append the possible extended images into the result list if applicable.
122		# List of images is included in the fileX_contents_lists if found from
123		# content getter.
124	5x	if (0 != length(self$file1_images_raw) && 0 != length(self$file2_images_raw)) {
125
126		# Only display the differences if there is the same amount of images
127		# found from the compared files. Otherwise it would require additional
128		# logic to decide which files should be compared with each others (which
129		# is something that could be developed further with size comparisons).
130	2x	if (length(self$file1_images_raw) == length(self$file2_images_raw)) {
131	2x	for (index in seq_along(self$file1_images_raw)) {
132		# Manually create a ImgFileComparator instance for every embedded
133		# image and call the details comparison based on existing bin data.
134	2x	comparator <- ImgFileComparator$new(
135	2x	NULL,
136	2x	NULL,
137	2x	self$file1_images_raw[[index]],
138	2x	self$file2_images_raw[[index]]
139		)
140	2x	result <- append(result, comparator$vrf_details_inner(config, omit))
141		}
142		}
143		}
144		}
145
146	5x	self$vrf_close_debug()
147	5x	return(result)
148		},
149
150		#' @description
151		#' "Abstract" method for getting the raw image hex vector array from the
152		#' given source file.
153		#'
154		#' @param file file for which to get the embedded image details
155		#'
156		vrf_images = function(file) {
157	!	stop("vrf_images must be implemented in a subclass.")
158		},
159
160		#' @description
161		#' Internal helper method for converting a hex string to raw vector.
162		#'
163		#' @param hex_string hexadecimal string to be converted to raw vector
164		#'
165		hex2raw = function(hex_string) {
166		# Remove non-hex characters
167	8x	hex_string <- gsub("[^0-9a-fA-F]", "", hex_string)
168
169		# check that the input string is a hex string
170	8x	if (nchar(hex_string) %% 2 != 0 \|\| nchar(hex_string) < 2) {
171	!	stop("input string isn't a hex string")
172		}
173
174		# Generate start and end indices
175	8x	start_indices <- seq(1, nchar(hex_string), 2)
176	8x	end_indices <- seq(2, nchar(hex_string), 2)
177
178		# Extract byte-sized chunks
179	8x	bytes <- substring(hex_string, start_indices, end_indices)
180
181	8x	as.raw(as.hexmode(bytes))
182		}
183		)
184		)
185		# nolint end: cyclocomp_linter

1		#' TextFileComparator.R
2		#'
3		#' Fallback comparator for text files without any specific definied comparator.
4		#' This comparator contains the methods for doing basic comparisons on raw text
5		#' contents.
6		#'
7		#' @import stringr
8		#'
9		#' @include BinaryFileComparator.R
10		#'
11		#' @examples
12		#'
13		#' # The normal way for creating a comparator would be to call the generic
14		#' # factory method verifyr2::create_comparator that will automatically create
15		#' # the correct comparator instance based on the file types.
16		#'
17		#' file1 <- 'my_file1.txt'
18		#' file2 <- 'my_file2.txt'
19		#' comparator <- verifyr2::create_comparator(file1, file2)
20		#'
21		#' # If needed, an explicit comparator can be created as well.
22		#'
23		#' file1 <- 'my_file1.lst'
24		#' file2 <- 'my_file2.lst'
25		#' comparator <- TxtFileComparator$new(file1, file2)
26		#'
27		#' @export
28		#'
29
30		# Disable cyclomatic complexity lint for the R6 class definition as lintr
31		# considers the whole class definition as a single function.
32		#
33		# nolint start: cyclocomp_linter
34		TxtFileComparator <- R6::R6Class(
35		"TxtFileComparator",
36		inherit = BinaryFileComparator,
37		public = list(
38
39		#' @description
40		#' Method for comparing the inner part for the details query. This method
41		#' can be overwritten by more specialized comparator classes. This method is
42		#' intended to be called only by the comparator classes in the processing
43		#' and shouldn't be called directly by the user.
44		#'
45		#' @param config configuration values
46		#' @param omit string pattern to omit from the comparison
47		#'
48		vrf_summary_inner = function(config, omit) {
49	55x	self$vrf_open_debug("Txt::vrf_summary_inner" , config)
50
51	55x	file1_contents_list <- self$file1_contents_list
52	55x	file2_contents_list <- self$file2_contents_list
53
54	55x	if (is.null(file1_contents_list)) {
55	55x	file1_contents_list <- self$vrf_contents(self$file1, config, omit)
56	55x	self$file1_contents_list <- file1_contents_list
57		}
58
59	55x	if (is.null(file2_contents_list)) {
60	55x	file2_contents_list <- self$vrf_contents(self$file2, config, omit)
61	55x	self$file2_contents_list <- file2_contents_list
62		}
63
64	55x	file1_contents_processed <- file1_contents_list[[2]]
65	55x	file2_contents_processed <- file2_contents_list[[2]]
66
67	55x	difference <- all.equal(file1_contents_processed, file2_contents_processed)
68	55x	result <- "File content comparison failed!"
69	55x	result_images <- ""
70	55x	pattern <- "Lengths \\((\\d+), (\\d+)\\) differ \\(string compare on first"
71
72	55x	if (typeof(difference) == "logical") {
73		# all.equal returns logical vector if there are no differences
74	28x	result <- "No differences."
75	27x	} else if (length(difference) >= 1 && grepl(pattern, difference[1])) {
76		# all.equal returns length 1/2 vector with first element comtaining text
77		# matching the pattern
78	12x	result <- "Different number of lines in compared content."
79	15x	} else if (length(difference) == 1) {
80		# all.equal returns length 1 vector if the number of rows are the same but
81		# there are differences
82	15x	count <- as.numeric(gsub("[^[:digit:].]", "", difference))
83	15x	result <- paste0("File content has changes in ", count, " place(s).")
84		}
85
86	55x	self$vrf_close_debug()
87	55x	return(result)
88		},
89
90		#' @description
91		#' Method for comparing the inner part for the details query. This method
92		#' can be overwritten by more specialized comparator classes. This method is
93		#' intended to be called only by the comparator classes in the processing
94		#' and shouldn't be called directly by the user.
95		#'
96		#' @param config configuration values
97		#' @param omit string pattern to omit from the comparison
98		#'
99		vrf_details_inner = function(config, omit) {
100	14x	self$vrf_open_debug("Txt::vrf_details_inner" , config)
101
102	14x	file1_contents_list <- self$file1_contents_list
103	14x	file2_contents_list <- self$file2_contents_list
104
105	14x	if (is.null(file1_contents_list)) {
106	14x	file1_contents_list <- self$vrf_contents(self$file1, config, omit)
107	14x	self$file1_contents_list <- file1_contents_list
108		}
109
110	14x	if (is.null(file2_contents_list)) {
111	14x	file2_contents_list <- self$vrf_contents(self$file2, config, omit)
112	14x	self$file2_contents_list <- file2_contents_list
113		}
114
115	14x	file1_contents_whole <- file1_contents_list[[1]]
116	14x	file2_contents_whole <- file2_contents_list[[1]]
117
118	14x	context <- 2
119	14x	if ("full" == super$vrf_option_value(config, "details.mode")) {
120	3x	context <- -1
121		}
122
123	14x	my_equalizer_with_omit <- function(x, x.chr) {
124	6x	my_finalizer(x, x.chr, omit)
125		}
126
127	14x	style <- diffobj::StyleHtmlLightRgb(
128	14x	html.output = "diff.w.style",
129	14x	finalizer = my_equalizer_with_omit
130		)
131
132	14x	self$vrf_open_debug("Txt::vrf_details_inner::diffPrint" , config)
133	14x	diff_print <- diffobj::diffChr(
134	14x	file1_contents_whole,
135	14x	file2_contents_whole,
136	14x	context = context,
137	14x	style = style,
138	14x	ignore.white.space = ("yes" == super$vrf_option_value(config, "generic.spaces")),
139	14x	mode = "sidebyside",
140	14x	word.diff = ("word" == super$vrf_option_value(config, "generic.level"))
141		)
142	14x	self$vrf_close_debug()
143
144	14x	result <- list(
145	14x	list(
146	14x	type = "text",
147	14x	contents = diff_print
148		)
149		)
150
151	14x	self$vrf_close_debug()
152	14x	return(result)
153		},
154
155		#' @description
156		#' Method for getting the inner part for the file contents query. The method
157		#' returns the file contents in two separate vectors inside a list. The
158		#' first vector is the file contents and the second one is the file contents
159		#' processed for empty spaces and omit terms if applicable. This method can
160		#' be overwritten by more specialized comparator classes. This method is
161		#' intended to be called only by the comparator classes in the processing
162		#' and shouldn't be called directly by the user.
163		#'
164		#' @param contents file contents
165		#' @param config configuration values
166		#' @param omit string pattern to omit from the comparison
167		#'
168		vrf_contents_inner = function(contents, config, omit) {
169	138x	self$vrf_open_debug("Txt::vrf_contents_inner" , config)
170
171	138x	contents_processed <- contents
172
173	138x	if (!is.null(omit) && "" != paste0(omit)) {
174	54x	contents_processed <- stringr::str_subset(
175	54x	string = contents,
176	54x	pattern = paste0(omit),
177	54x	negate = TRUE
178		)
179		}
180
181	138x	if ("yes" == super$vrf_option_value(config, "generic.spaces")) {
182	4x	contents_processed <- stringr::str_replace_all(contents_processed, "[ \t]+", " ")
183	4x	contents_processed <- stringr::str_trim(contents_processed, side = "both")
184		}
185
186	138x	self$vrf_close_debug()
187	138x	return(list(contents, contents_processed))
188		},
189
190		#' @description
191		#' Inherited method for indicating whether detailed comparison is available
192		#' with the current comparator. Returns an empty string if the comparator is
193		#' is supported, otherwise a string that will be concatenated with the
194		#' summary string.
195		#'
196		#' @param config configuration values
197		#'
198		vrf_details_supported = function(config) {
199	68x	return("")
200		}
201		)
202		)
203		# nolint end: cyclocomp_linter
204
205		#' Custom finalizer method for diffobj html content finalizing. This method is
206		#' used to modify the diff html output so that omitted rows have their own
207		#' special styling and gutters.
208		#'
209		#' @param x comparator instance used for the comparison that is meant to
210		#' be created with the factory method vrf_comparator.
211		#' @param x.chr character text representation of x, typically generated with
212		#' the as character
213		#' @param omit all lines containing the omit string will be excluded from the
214		#' comparison (detaulf = NULL)
215		#'
216		#' @keywords internal
217
218		my_finalizer <- function(x, x.chr, omit) {
219
220	6x	split <- strsplit(x.chr, "<div class='diffobj-row'>")[[1]]
221	6x	width <- nchar(length(split))
222	6x	index <- 0
223
224		# add row numbers to compare results manually for diffChr. diffobj-header
225		# values need to be processed to identify the actual line numbers in summary
226		# results.
227	6x	for (i in seq_along(split)) {
228	389x	row <- split[[i]]
229
230		# remove the special note regarding whitespace ignoring as it is not
231		# relevant with the custom whitespace ignoring supported.
232	389x	if (1 == i) {
233	6x	old <- paste0(
234	6x	"<div class='diffobj-container light rgb'>",
235	6x	"<pre class='diffobj-content'>",
236	6x	"No visible differences between objects, but there are some ",
237	6x	"differencessuppressed by `ignore.white.space`, ",
238	6x	"`convert.hz.white.space`, `strip.sgr`,and/or `trim`. Set all ",
239	6x	"those arguments to FALSE to highlight the differences."
240		)
241
242	6x	if (old == row) {
243	1x	split[[i]] <- paste0(
244	1x	"<div class='diffobj-container light rgb'>",
245	1x	"<pre class='diffobj-content'>",
246	1x	"No visible differences between objects."
247		)
248		}
249		}
250
251	389x	if (grepl("<div class='diffobj-header'>@@ .*@@</div>", row)) {
252	6x	index <- as.integer(sub(".@@\\s([0-9]+),.@@.", "\\1", row)) - 1
253		}
254
255	389x	if (i > 3) {
256	371x	if (grepl("<div class='diffobj-header'>@@ .*@@</div>", row)) {
257	!	index <- as.integer(sub(".@@\\s([0-9]+),.@@.", "\\1", row)) - 1
258		} else {
259	371x	index <- index + 1
260		}
261	371x	row_str <- sprintf("%*s", width + 3, sprintf("[%d] ", index))
262
263	371x	row <- gsub(
264	371x	"<div class='diffobj-text'><div class='diffobj-match'>",
265	371x	paste0(
266	371x	"<div class='diffobj-text'><div class='diffobj-match'>",
267	371x	"<span class='diffobj-trim'>",
268	371x	row_str,
269	371x	"</span>"
270		),
271	371x	row
272		)
273
274	371x	row <- gsub(
275	371x	"<div class='diffobj-text'><div class='delete'>",
276	371x	paste0(
277	371x	"<div class='diffobj-text'><div class='delete'>",
278	371x	"<span class='diffobj-trim'>",
279	371x	row_str,
280	371x	"</span>"
281		),
282	371x	row
283		)
284
285	371x	row <- gsub(
286	371x	"<div class='diffobj-text'><div class='insert'>",
287	371x	paste0(
288	371x	"<div class='diffobj-text'><div class='insert'>",
289	371x	"<span class='diffobj-trim'>",
290	371x	row_str,
291	371x	"</span>"
292		),
293	371x	row
294		)
295
296	371x	split[[i]] <- row
297		}
298		}
299
300		# custom processing for omit row styles
301	6x	if (!is.null(omit) && "" != paste0(omit)) {
302	1x	for (i in seq_along(split)) {
303	9x	if (grepl(omit, split[[i]])) {
304	1x	row <- split[[i]]
305
306		# modifying maching row markup
307	1x	row <- gsub(
308	1x	"class='diffobj-match'",
309	1x	"class='ignore'",
310	1x	row
311		)
312
313	1x	row <- gsub(
314	1x	"<div class='diffobj-gutter'><div class='ignore'> ",
315	1x	"<div class='diffobj-gutter'><div class='ignore'>x",
316	1x	row
317		)
318
319		# modifying inserted row markup
320	1x	row <- gsub(
321	1x	"class='insert'",
322	1x	"class='ignore'",
323	1x	row
324		)
325
326	1x	row <- gsub(
327	1x	"class='diffobj-word insert'",
328	1x	"class='diffobj-word ignore'",
329	1x	row
330		)
331
332	1x	row <- gsub(
333	1x	"<div class='diffobj-gutter'><div class='ignore'>>",
334	1x	"<div class='diffobj-gutter'><div class='ignore'>X",
335	1x	row
336		)
337
338		# modifying deleted row markup
339	1x	row <- gsub(
340	1x	"class='delete'",
341	1x	"class='ignore'",
342	1x	row
343		)
344
345	1x	row <- gsub(
346	1x	"class='diffobj-word delete'",
347	1x	"class='diffobj-word ignore'",
348	1x	row
349		)
350
351	1x	row <- gsub(
352	1x	"<div class='diffobj-gutter'><div class='ignore'><",
353	1x	"<div class='diffobj-gutter'><div class='ignore'>X",
354	1x	row
355		)
356
357		# highlight the ommitted part
358	1x	row <- gsub(
359	1x	omit,
360	1x	paste0(
361	1x	"<span class='diffobj-word-highlight ignore'>",
362	1x	omit,
363	1x	"</span>"
364		),
365	1x	row
366		)
367
368	1x	split[[i]] <- row
369		}
370		}
371		}
372
373	6x	html_string <- paste(split, collapse = "<div class='diffobj-row'>")
374
375	6x	diffobj::finalizeHtml(x, html_string)
376		}

1		#' FileComparator.R
2		#'
3		#' Comparator 'abstract' class containing the generic comparison methods and
4		#' handling for high level checks (like file existence). This class should never
5		#' be instantiated - doing that and calling the comparison methods will lead to
6		#' error.
7		#'
8		#' @importFrom R6 R6Class
9		#'
10		#' @field file1 file1
11		#' @field file2 file2
12		#' @field file1_contents_list file1 contents
13		#' @field file2_contents_list file2 contents
14		#' @field summary_comparison summary comparison result
15		#' @field details_comparison details comparison result
16		#' @field debugger debugger instance
17		#'
18		#' @export
19		#'
20
21		# Disable cyclomatic complexity lint for the R6 class definition as lintr
22		# considers the whole class definition as a single function.
23		#
24		# nolint start: cyclocomp_linter
25		FileComparator <- R6::R6Class(
26		"FileComparator",
27		public <- list(
28		file1 = NULL,
29		file2 = NULL,
30		file1_contents_list = NULL,
31		file2_contents_list = NULL,
32		summary_comparison = NULL,
33		details_comparison = NULL,
34		debugger = NULL,
35
36		#' @description
37		#' Initialize a FileComparator instance
38		#'
39		#' @param file1 First file to compare.
40		#' @param file2 Second file to compare.
41		#'
42		initialize = function(file1 = NULL, file2 = NULL) {
43	100x	self$file1 <- file1
44	100x	self$file2 <- file2
45	100x	self$details_comparison <- list("summary" = NULL, "full" = NULL)
46		},
47
48		#' @description
49		#' Method for comparing the file summary information. This method is
50		#' intended to be implemented only this class level. For comparator
51		#' specific rules, the internal method vrf_summary_inner should be
52		#' customized on lower levels instead.
53		#'
54		#' @param config configuration values
55		#' @param omit string pattern to omit from the comparison
56		#'
57		vrf_summary = function(config, omit = NULL) {
58	70x	self$vrf_open_debug("File::vrf_summary", config)
59	70x	self$vrf_add_debug_files()
60
61	70x	if (!is.null(self$summary_comparison)) {
62	!	self$vrf_add_debug("Returning previously calculated comparison results")
63	!	return(self$summary_comparison)
64		}
65
66	70x	if (!file.exists(self$file1) \|\| !file.exists(self$file2)) {
67	9x	self$vrf_add_debug("One of both of the files not available, unable perform comparison")
68	9x	result <- "File(s) not available; unable to compare."
69		} else {
70	61x	tryCatch({
71	61x	result <- self$vrf_summary_inner(config, omit)
72	61x	addition <- self$vrf_details_supported(config)
73
74	61x	if ('' != addition) {
75	5x	result <- paste(result, addition)
76		}
77	61x	}, error = function(e) {
78	!	self$vrf_add_debug(paste("Processing failed with exception: ", conditionMessage(e)))
79	!	result <- paste0("Error reading file contents: ", conditionMessage(e))
80		})
81
82		}
83
84	70x	self$summary_comparison <- result
85	70x	self$vrf_close_debug()
86
87	70x	return(result)
88		},
89
90		#' @description
91		#' Method for comparing the file details information. This method is
92		#' intended to be implemented only this class level. For comparator
93		#' specific rules, the internal method vrf_summary_inner should be
94		#' customized on lower levels instead.
95		#'
96		#' @param config configuration values
97		#' @param omit string pattern to omit from the comparison
98		#'
99		vrf_details = function(config, omit = NULL) {
100	28x	mode <- self$vrf_option_value(config, "details.mode")
101	28x	if ("NA" == mode) {
102	!	mode <- "summary"
103		}
104
105	28x	self$vrf_open_debug(paste("File::vrf_details, mode:", mode), config)
106	28x	self$vrf_add_debug_files()
107
108	28x	if (!is.null(self$details_comparison[[mode]])) {
109	!	self$vrf_add_debug("Returning previously calculated comparison results")
110	!	return(self$details_comparison[[mode]])
111		}
112
113	28x	if (!file.exists(self$file1) \|\| !file.exists(self$file2)) {
114	11x	self$vrf_add_debug("One of both of the files not available, unable perform comparison")
115	11x	result <- list(
116	11x	list(
117	11x	type = "text",
118	11x	contents = "File(s) not available; unable to compare."
119		)
120		)
121	17x	} else if ('' != self$vrf_details_supported(config)) {
122	1x	self$vrf_add_debug("Details comparison not supported/enabled, unable perform comparison")
123	1x	result <- list(
124	1x	list(
125	1x	type = "text",
126	1x	contents = self$vrf_details_supported(config)
127		)
128		)
129		} else {
130	16x	tryCatch({
131	16x	result <- self$vrf_details_inner(config, omit)
132	16x	}, error = function(e) {
133	!	self$vrf_add_debug(paste("Processing failed with exception: ", conditionMessage(e)))
134	!	result <- list(
135	!	list(
136	!	type = "text",
137	!	contents = paste0("Error reading file contents: ", conditionMessage(e))
138		)
139		)
140		})
141		}
142
143	28x	self$details_comparison[[mode]] <- result
144	28x	self$vrf_close_debug()
145
146	28x	return(result)
147		},
148
149		#' @description
150		#' "Abstract" method for comparing the inner part for the summary. This
151		#' method has to be overwritten by more specialized comparator classes. This
152		#' method is intended to be called only by the comparator classes in the
153		#' processing and shouldn't be called directly by the user.
154		#'
155		#' @param config configuration values
156		#' @param omit string pattern to omit from the comparison
157		#'
158		vrf_summary_inner = function(config, omit) {
159	!	stop("vrf_summary_inner must be implemented in a subclass.")
160		},
161
162		#' @description
163		#' "Abstract" method for comparing the inner part for the detailsThis method
164		#' has to be overwritten by more specialized comparator classes. This method
165		#' is intended to be called only by the comparator classes in the processing
166		#' and shouldn't be called directly by the user.
167		#'
168		#' @param config configuration values
169		#' @param omit string pattern to omit from the comparison
170		#'
171		vrf_details_inner = function(config, omit) {
172	!	stop("vrf_details_inner must be implemented in a subclass.")
173		},
174
175		#' @description
176		#' Inherited method for indicating whether detailed comparison is available
177		#' with the current comparator. Returns an empty string if the comparator is
178		#' is supported, otherwise a string that will be concatenated with the
179		#' summary string.
180		#'
181		#' @param config configuration values
182		#'
183		vrf_details_supported = function(config) {
184	5x	return("No details comparison available.")
185		},
186
187		#' @description
188		#' Method for getting specific value from the config In the initial
189		#' version, returns 'NA' if null con is passed.
190		#'
191		#' @param config configuration values
192		#' @param key key to search from the parameters
193		#'
194		vrf_option_value = function(config, key) {
195	946x	if (is.null(config)) {
196	!	return("NA")
197		}
198	946x	value <- config$get(key)
199	946x	return(value)
200		},
201
202		#' @description
203		#' Wrapper method for the opening a new debugging instance with Debugger
204		#' class if debugging is enabled in config class. Creates the used
205		#' debugger instance if needed.
206		#'
207		#' @param message message to debug to console
208		#' @param config configuration values
209		#'
210		vrf_open_debug = function(message, config) {
211	554x	if ("yes" != self$vrf_option_value(config, "generic.debug")) {
212	542x	return()
213		}
214
215	12x	if (is.null(self$debugger)) {
216	2x	self$debugger <- Debugger$new()
217		}
218
219	12x	self$debugger$open_debug(message)
220		},
221
222		#' @description
223		#' Wrapper method for the adding a new debugging message with Debugger
224		#' class.
225		#'
226		#' @param message message to debug to console
227		#'
228		vrf_add_debug = function(message) {
229	27x	if (is.null(self$debugger)) {
230	27x	return()
231		}
232
233	!	self$debugger$add_debug(message)
234		},
235
236		#' @description
237		#' Special method for adding the compared files into debugger stack.
238		#'
239		vrf_add_debug_files = function() {
240	98x	if (is.null(self$debugger)) {
241	97x	return()
242		}
243
244	1x	self$debugger$add_debug(paste("File 1:", self$file1))
245	1x	self$debugger$add_debug(paste("File 2:", self$file2))
246		},
247
248		#' @description
249		#' Wrapper method for the stopping (closing) current debugging instance with
250		#' Debugger class.
251		#'
252		vrf_close_debug = function() {
253	554x	if (is.null(self$debugger)) {
254	542x	return()
255		}
256	12x	self$debugger$close_debug()
257		}
258		)
259		)
260		# nolint end: cyclocomp_linter

1
2		generic_level_desc <- paste0(
3		"Option to define whether the comparison is processed and displayed on ",
4		"word or row level. Word-level processing requires additional time for ",
5		"comparison calculation, so it may be advisable to disable this option ",
6		"when working with large files if row-level comparison is sufficient."
7		)
8
9		generic_images_desc <- paste0(
10		"Option to define whether embedded images should be processed for all ",
11		"supported file types. Processing embedded images requires additional ",
12		"time to detect and extract images from documents, so it may be ",
13		"advisable to disable this option when working with large files or a ",
14		"high volume of files that do not contain images."
15		)
16
17		generic_spaces_desc <- paste0(
18		"Option to define whether differences in whitespace should be ignored ",
19		"during comparison. When enabled, differences caused solely by additional ",
20		"spaces or tab characters are not reported."
21		)
22
23		generic_debug_desc <- paste0(
24		"Option to enable debugging so that the application prints diagnostic ",
25		"information to the output stream. This option is available to all users ",
26		"and can be enabled to include debugging details when reporting issues."
27		)
28
29		rtf_images_desc <- paste0(
30		"Option to define whether embedded images should be processed for RTF file ",
31		"types. Processing embedded images requires additional time to detect and ",
32		"extract images from documents, so it may be advisable to disable this ",
33		"option when working with large files or a high volume of files that do ",
34		"not contain images."
35		)
36
37		pdf_details_desc <- paste0(
38		"Option to define whether detailed PDF comparison should be performed. ",
39		"Disabling this option is generally not recommended for users. However, it ",
40		"may be automatically disabled by the application if the required ",
41		"'pdftools' package is not available."
42		)
43
44		details_mode_desc <- paste0(
45		"Option to define the default display mode for the details summary view. ",
46		"The available options are 'full,' which displays the complete compared ",
47		"file, and 'summary,' which displays only the detected differences."
48		)
49
50		merge_values <- function(defaults, overrides) {
51	30x	result <- list()
52
53	30x	for (name in names(defaults)) {
54	78x	def <- defaults[[name]]
55	78x	over <- overrides[[name]]
56
57	78x	has_defaults <- "default" %in% names(def)
58	78x	has_options <- "options" %in% names(def)
59
60	78x	if (is.list(def) && has_defaults && has_options) {
61	21x	if (!is.null(over) && over %in% def$options) {
62	12x	result[[name]] <- over
63		} else {
64	9x	result[[name]] <- def$default
65		}
66	57x	} else if (is.list(def)) {
67	5x	if (!is.list(over)) over <- list()
68	24x	result[[name]] <- merge_values(def, over)
69		} else {
70	33x	result[[name]] <- if (!is.null(over)) over else def
71		}
72		}
73
74	30x	result
75		}
76
77		get_nested_value <- function(config, key) {
78	963x	parts <- strsplit(key, ".", fixed = TRUE)[[1]]
79
80	963x	for (p in parts) {
81	1926x	config <- config[[p]]
82		}
83	963x	config
84		}
85
86		set_nested_value <- function(config, key, value) {
87	28x	parts <- strsplit(key, ".", fixed = TRUE)[[1]]
88
89	28x	if (length(parts) == 1) {
90	14x	config[[parts[1]]] <- value
91		} else {
92	14x	sub_key <- paste(parts[-1], collapse = ".")
93	14x	config[[parts[1]]] <- set_nested_value(config[[parts[1]]], sub_key, value)
94		}
95	28x	config
96		}
97
98		check_magick_available <- function() {
99	31x	requireNamespace("magick", quietly = TRUE)
100		}
101
102		check_pdftools_available <- function() {
103	34x	requireNamespace("pdftools", quietly = TRUE)
104		}
105
106		#' Config.R
107		#'
108		#' Class for manging the library configuration options. Creates the default
109		#' configuration without any source file, populates partial or missing config
110		#' elements, stores the config file to local machine, and provides easy access
111		#' methods for setting and getting config values.
112		#'
113		#' @examples
114		#'
115		#' # Creates the configuration instance. Checks automatically if there is
116		#' # a previously stored configuration json file available for usage. Note
117		#' # that you don't need to explicitly define the config file path for the
118		#' # Config instance - by default the config file will be searched from and
119		#' # written in user-specific configuration directory for the package.
120		#'
121		#' path <- tempfile(fileext = ".json")
122		#' config <- Config$new(config_path = path)
123		#'
124		#' # Getting and setting configuration values
125		#'
126		#' value <- config$get("defailts.mode")
127		#' config$set("details.mode", "full")
128		#'
129		#' # Saving the current configuration to local machine (to tmp folder with
130		#' # the given explicit file path in initialization).
131		#'
132		#' config$save()
133		#'
134		#' @import jsonlite
135		#' @import rappdirs
136		#' @importFrom R6 R6Class
137		#'
138		#' @field schema configuration schema
139		#' @field config current configuration data
140		#' @field path configuration json file path
141		#'
142		#' @export
143		#'
144		Config <- R6::R6Class(
145		"Config",
146		public = list(
147		schema = NULL,
148		config = NULL,
149		path = NULL,
150
151		#' @description
152		#' Constructor for initializing the configuration. Checks the local machine
153		#' for existing configuration file is load_config = TRUE. Ensures that all
154		#' the project configuration values are included.
155		#'
156		#' @param load_config load configuration from local machine if available
157		#' @param config_path location of the used/stored configuration json file
158		#'
159		initialize = function(load_config = TRUE, config_path = NULL) {
160	32x	self$schema <- self$get_default_schema()
161	32x	self$config <- self$get_default_config()
162
163	32x	if (is.null(config_path)) {
164	28x	config_dir <- rappdirs::user_config_dir("verifyr2")
165	28x	self$path <- file.path(config_dir, "config.json")
166		} else {
167	4x	self$path <- config_path
168		}
169
170	32x	if (load_config && file.exists(self$path)) {
171	3x	file_config <- jsonlite::read_json(self$path, simplifyVector = TRUE)
172	3x	self$config <- merge_values(self$get_default_schema(), file_config)
173	3x	self$config <- self$get_default_config() \|> merge_values(self$config)
174		}
175		},
176
177		#' @description
178		#' Method for getting schema item based on configuration key.
179		#' Configuration item children are separated with a dot in the key notation.
180		#'
181		#' @param key configuration property key for which to get the schema item
182		#'
183		get_schema_item = function(key) {
184	!	get_nested_value(self$schema, key)
185		},
186
187		#' @description
188		#' Method for getting configuration value based on configuration key.
189		#' Configuration item children are separated with a dot in the key notation.
190		#'
191		#' @param key configuration property key for which to get the value
192		#'
193		get = function(key) {
194	963x	get_nested_value(self$config, key)
195		},
196
197		#' @description
198		#' Method for setting configuration value based on configuration key.
199		#' Configuration item children are separated with a dot in the key notation.
200		#'
201		#' @param key configuration property key for which to get the value
202		#' @param value value to set for the specified configuration key
203		#'
204		set = function(key, value) {
205	14x	self$config <- set_nested_value(self$config, key, value)
206		},
207
208		#' @description
209		#' Method for saving the current configuration data into local machine.
210		#'
211		save = function() {
212	1x	dir.create(dirname(self$path), showWarnings = FALSE, recursive = TRUE)
213	1x	jsonlite::write_json(self$config, self$path, pretty = TRUE)
214		},
215
216		#' @description
217		#' Helper method for getting configuration default values. These default
218		#' values will be used in the configuration in case the configuration
219		#' properties are not present previously.
220		#'
221		get_default_config = function() {
222	35x	defaults <- list()
223
224	35x	for (group in names(self$schema)) {
225	140x	defaults[[group]] <- list()
226
227	140x	for (key in names(self$schema[[group]])) {
228	385x	if (key != "title") {
229	245x	defaults[[group]][[key]] <- self$schema[[group]][[key]]$default
230		}
231		}
232		}
233	35x	defaults
234		},
235
236		#' @description
237		#' Method for getting the full configuration schema. Apart from the
238		#' configuration data, the schema contains property descriptions as well as
239		#' all possible values for the configuration properties.
240		#'
241		get_default_schema = function() {
242	35x	schema <- list(
243	35x	generic = list(
244	35x	title = "Generic options",
245	35x	level = list(
246	35x	title = "Comparison level",
247	35x	options = c("word", "row"),
248	35x	default = "word",
249	35x	reload = TRUE,
250	35x	desc = generic_level_desc
251		),
252	35x	spaces = list(
253	35x	titlei = "Ignore empty space differences",
254	35x	options = c("yes", "no"),
255	35x	default = "no",
256	35x	reload = TRUE,
257	35x	desc = generic_spaces_desc
258		),
259	35x	images = list(
260	35x	title = "Process embedded images",
261	35x	options = c("yes", "no"),
262	35x	default = "yes",
263	35x	reload = TRUE,
264	35x	desc = generic_images_desc
265		),
266	35x	debug = list(
267	35x	title = "Debugging enabled",
268	35x	options = c("yes", "no"),
269	35x	default = "no",
270	35x	reload = FALSE,
271	35x	desc = generic_debug_desc
272		)
273		),
274	35x	rtf = list(
275	35x	title = "RTF comparison (summary and details)",
276	35x	images = list(
277	35x	title = "Process embedded images",
278	35x	options = c("yes", "no"),
279	35x	default = "yes",
280	35x	reload = TRUE,
281	35x	desc = rtf_images_desc
282		)
283		),
284	35x	pdf = list(
285	35x	title = "PDF comparison (summary)",
286	35x	details = list(
287	35x	title = "Process PDF detailed comparison",
288	35x	options = c("yes", "no"),
289	35x	default = "yes",
290	35x	reload = TRUE,
291	35x	desc = pdf_details_desc
292		)
293		),
294	35x	details = list(
295	35x	title = "Details comparison",
296	35x	mode = list(
297	35x	title = "Mode",
298	35x	options = c("full", "summary"),
299	35x	default = "summary",
300	35x	reload = FALSE,
301	35x	desc = details_mode_desc
302		)
303		)
304		)
305
306	35x	if (!check_magick_available()) {
307	4x	schema[["generic"]][["images"]] <- list(
308	4x	title = "Process embedded images (missing magick library)",
309	4x	options = c("no"),
310	4x	default = "no",
311	4x	reload = TRUE,
312	4x	desc = generic_images_desc
313		)
314
315	4x	schema[["rtf"]][["images"]] <- list(
316	4x	title = "Process embedded images (missing magick library)",
317	4x	options = c("no"),
318	4x	default = "no",
319	4x	reload = TRUE,
320	4x	desc = rtf_images_desc
321		)
322		}
323
324	35x	if (!check_pdftools_available()) {
325	1x	schema[["pdf"]][["details"]] <- list(
326	1x	title = "Process PDF details (missing pdftools library)",
327	1x	options = c("no"),
328	1x	default = "no",
329	1x	reload = TRUE,
330	1x	desc = pdf_details_desc
331		)
332		}
333
334	35x	schema
335		}
336		)
337		)

1
2		#' Debugger.R
3		#'
4		#' Class for managing the library debugging. Tracks the debugged method
5		#' execution times and prints out the full debugging information only when
6		#' the main debugging instance is stopped.
7		#'
8		#' @examples
9		#'
10		#' # Creates a debugger instance.
11		#'
12		#' debugger <- Debugger$new()
13		#'
14		#' # Opening and closing debugs in multileveled function calls.
15		#'
16		#' function1 <- function() {
17		#' debugger$open_debug("function1")
18		#' function2()
19		#' debuger$close_debug()
20		#' }
21		#'
22		#' function2 <- function() {
23		#' debugger$open_debug("function2")
24		#' Sys.sleep(1)
25		#' debugger$close_debug()
26		#' }
27		#'
28		#' # This will produce the following printout to the console after the
29		#' # function1 finishes
30		#' #
31		#' # - 'function1' (execution time 7 ms)
32		#' # - 'function2' (execution time 5 ms)
33		#'
34		#' @importFrom R6 R6Class
35		#'
36		#' @field stack local property for storing debugging labels and start times
37		#'
38		#' @export
39		#'
40		Debugger <- R6::R6Class("Debugger",
41		public = list(
42		stack = list(),
43
44		#' @description
45		#' Constructor for initializing the Debugger instance.
46		#'
47		initialize = function() {
48	5x	self$stack <- list()
49		},
50
51		#' @description
52		#' Method for opening new debug instance to the current debugging stack.
53		#' Stores also the start time for execution time calculation.
54		#'
55		#' @param label debugging message
56		#'
57		open_debug = function(label) {
58	17x	entry <- list(
59	17x	label = label,
60	17x	start_time = Sys.time(),
61	17x	children = list(),
62	17x	duration = NULL,
63	17x	is_message = FALSE
64		)
65	17x	self$stack[[length(self$stack) + 1]] <- entry
66		},
67
68		#' @description
69		#' Method for adding a new debug string under the currently open
70		#' debug instance.
71		#'
72		#' @param label debugging message
73		#'
74		add_debug = function(label) {
75	4x	msg <- list(
76	4x	label = label,
77	4x	children = list(),
78	4x	duration = NULL,
79	4x	is_message = TRUE
80		)
81
82	4x	parent <- self$stack[[length(self$stack)]]
83	4x	parent$children[[length(parent$children) + 1]] <- msg
84	4x	self$stack[[length(self$stack)]] <- parent
85		},
86
87		#' @description
88		#' Method for closing a debug instance from the current debugging
89		#' stack. If the stopped debug instance is the main level one, the
90		#' whole debug data is printed out to console. If the stopped debug
91		#' instance is not the main level one, calculates the execution time
92		#' of current debug instance and updates the stack data.
93		#'
94		close_debug = function() {
95		# Pop the last entry
96	17x	entry <- self$stack[[length(self$stack)]]
97	17x	self$stack <- self$stack[-length(self$stack)]
98
99	17x	time_diff <- difftime(Sys.time(), entry$start_time, units = "secs")
100	17x	entry$duration <- round(as.numeric(time_diff) * 1000)
101
102	17x	if (length(self$stack) > 0) {
103	12x	parent <- self$stack[[length(self$stack)]]
104	12x	parent$children[[length(parent$children) + 1]] <- entry
105	12x	self$stack[[length(self$stack)]] <- parent
106		} else {
107	5x	self$print_debug_tree(entry)
108	5x	cat("[DEBUG]'\n")
109		}
110		},
111
112		#' @description
113		#' Recursive method for printing out the current debug stack items and
114		#' recursively all the item children. This method is called for the whole
115		#' stack once the topmost debug instance is stopped.
116		#'
117		#' @param entry current debug level being processed for printing
118		#' @param depth current processing depth for printing indentation
119		#'
120		print_debug_tree = function(entry, depth = 0) {
121	21x	indent <- paste("[DEBUG]", strrep(" ", depth))
122	21x	if (isTRUE(entry$is_message)) {
123	4x	cat(indent, "'", entry$label, "'\n", sep = "")
124		} else {
125	17x	execution_time <- paste0("(execution time ", entry$duration, " ms)")
126	17x	cat(indent, "'", entry$label, "' ", execution_time, "\n", sep = "")
127
128	17x	for (child in entry$children) {
129	16x	self$print_debug_tree(child, depth + 1)
130		}
131		}
132		}
133		)
134		)

1		#' FileComparatorFactory.R
2		#'
3		#' Factory method for creating comparator instance based on the given two files.
4		#'
5		#' @param file1 first file to compare
6		#' @param file2 second file to compare
7		#'
8		#' @examples
9		#'
10		#' # instantiating the compared files
11		#' file1 <- "file1.rtf"
12		#' file2 <- "file2.rtf"
13		#'
14		#' # instantiating the configuration
15		#' config <- Config$new()
16		#'
17		#' # instantiating a new comparator instance for every comparison:
18		#' comparator <- verifyr2::create_comparator(file1, file2)
19		#'
20		#' # calling the summary and details comparison methods
21		#' comparator$vrf_summary(config = config)
22		#' comparator$vrf_details(config = config)
23		#'
24		#' @include BinaryFileComparator.R
25		#' @include TxtFileComparator.R
26		#'
27		#' @export
28		#'
29		create_comparator <- function(file1, file2) {
30	98x	if (!file.exists(file1) \|\| !file.exists(file2)) {
31	20x	return(BinaryFileComparator$new(file1 = file1, file2 = file2))
32		}
33
34	78x	file_extension <- tools::toTitleCase(tools::file_ext(file1))
35
36	78x	if (file_extension %in% list("Jpg", "Jpeg", "Png")) {
37	5x	file_extension <- "Img"
38		}
39
40		# construct the comparator name
41	78x	comparator_name <- paste0(file_extension, "FileComparator")
42
43	78x	if (exists(comparator_name, envir = .GlobalEnv)) {
44	67x	class_def <- get(comparator_name, envir = .GlobalEnv)
45
46		# return the specific class instance if the class exists
47	67x	if (inherits(class_def, "R6ClassGenerator")) {
48	67x	return(do.call(class_def$new, list(file1 = file1, file2 = file2)))
49		}
50		}
51
52		# generic comparator class used based on the file contents (text/binary).
53	11x	mime_type <- mime::guess_type(file1)
54
55	11x	text_like <- c(
56	11x	"application/json",
57	11x	"application/xml",
58	11x	"application/javascript",
59	11x	"application/x-yaml",
60	11x	"application/sql",
61	11x	"application/x-httpd-php",
62	11x	"application/x-sh",
63	11x	"application/csv",
64	11x	"application/x-tex",
65	11x	"application/x-markdown"
66		)
67
68		# additional types that the mime::guess_type mapping doesn't handle correctly
69	11x	additional_text_types <- c(
70	11x	"Lst",
71	11x	"Sas"
72		)
73
74	11x	txt_type <- startsWith(mime_type, "text/")
75	11x	fix_type <- mime_type %in% text_like
76	11x	add_type <- file_extension %in% additional_text_types
77
78	11x	if (txt_type \|\| fix_type \|\| add_type) {
79	7x	TxtFileComparator$new(file1 = file1, file2 = file2)
80		} else {
81	4x	BinaryFileComparator$new(file1 = file1, file2 = file2)
82		}
83		}
84
85		is_r6_class <- function(class_name) {
86	!	obj <- try(get(class_name, envir = .GlobalEnv), silent = TRUE)
87	!	inherits(obj, "R6ClassGenerator")
88		}

1		#' Call for shiny example where the user can test verifyr2 package functions
2		#'
3		#' \code{verifyr2::run_example} returns simple Shiny App where user can see how
4		#' the verifyr2 functions work
5		#'
6		#' @export
7		#'
8		#' @param debug option to override debug configuration (TRUE only)
9		#'
10		run_example <- function(debug = FALSE) {
11	!	appDir <- system.file("shiny_examples", "app", package = "verifyr2")
12
13	!	if (appDir == "") {
14	!	stop("Could not find example directory. Try re-installing `verifyr2`.",
15	!	call. = FALSE)
16		}
17
18	!	options(verifyr2.debug = debug)
19	!	shiny::runApp(appDir, display.mode = "normal")
20		}

1		#' List files that exist in two folders
2		#'
3		#' \code{list_folder_files} List files that exist in two folders with a specific
4		#' name pattern
5		#'
6		#' @param folder1 character, giving the the full file path and name of the
7		#' folder where first files are stored (required)
8		#' @param folder2 character, giving the the full file path and name of the
9		#' folder where second new files are stored (required)
10		#' @param pattern character, limit the files to be listed to contain a
11		#' specific pattern (optional)
12		#'
13		#' @return Returns a tibble, \code{selected_files} with 2 columns \code{file1},
14		#' \code{file2}
15		#'
16		#' @examples
17		#'
18		#' folder1 <- paste0(fs::path_package("/extdata/base_files/",
19		#' package = "verifyr2"))
20		#'
21		#' folder2 <- paste0(fs::path_package("/extdata/compare_files/",
22		#' package = "verifyr2"))
23		#'
24		#' verifyr2::list_folder_files(folder1, folder2, "base")
25		#'
26		#' @export
27
28		list_folder_files <- function(folder1, folder2, pattern = NULL) {
29
30		## do the comparison only if both of the folders exist
31	3x	if (file.exists(folder1) && file.exists(folder2)) {
32
33	1x	folder1_info <- folder_info(folder1, "file1", pattern)
34	1x	folder2_info <- folder_info(folder2, "file2", pattern)
35
36	1x	selected_files <- dplyr::full_join(folder1_info,
37	1x	folder2_info,
38	1x	by = "file") \|>
39	1x	dplyr::arrange(file) \|>
40	1x	dplyr::select("file1", "file2")
41
42	1x	return(selected_files)
43		}
44
45	2x	NULL
46		}
47
48		folder_info <- function(folder, column_name, pattern) {
49	2x	files <- list.files(path = folder, pattern = pattern)
50	2x	paths <- list.files(path = folder, pattern = pattern, full.names = TRUE)
51	2x	data <- tibble::tibble(file = files)
52	2x	data[[column_name]] <- paths
53
54	2x	data
55		}

1		#' One row list for two distinct files
2		#'
3		#' \code{list_files} List single file row based on the explicit parameter
4		#' files. This is a conveniency function for building same structure list for
5		#' direct two file comparison case.
6		#'
7		#' @param file1 character, giving the the full file path of the first file
8		#' @param file2 character, giving the the full file path of the second file
9		#'
10		#' @return Returns a tibble, \code{selected_files} with 2 columns \code{file1},
11		#' \code{file2}
12		#'
13		#' @examples
14		#'
15		#' path1 <- "/extdata/base_files/file2_additional_rows.rtf"
16		#' file1 <- paste0(fs::path_package(path1, package = "verifyr2"))
17		#'
18		#' path2 <- "/extdata/compare_files/file3_changed_rows.rtf"
19		#' file2 <- paste0(fs::path_package(path2, package = "verifyr2"))
20		#'
21		#' verifyr2::list_files(file1, file2)
22		#'
23		#' @export
24
25		list_files <- function(file1, file2) {
26
27		## do the comparison only if both of the files exist
28	3x	if (file.exists(file1) && file.exists(file2)) {
29
30	1x	data <- tibble::tibble(
31	1x	"file1" = file1,
32	1x	"file2" = file2
33		)
34
35	1x	return(data)
36		}
37
38	2x	NULL
39		}