verifyr2 coverage - 92.46%

Files
Source

#' 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

#' 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_omit <- file1_contents_list[[2]]
      file2_contents_omit <- file2_contents_list[[2]]

      difference    <- all.equal(file1_contents_omit, file2_contents_omit)
      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
      )

      diff_print <- diffobj::diffPrint(
        file1_contents_whole,
        file2_contents_whole,
        context = context,
        style = style
      )

      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
    #' 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 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_omit <- contents

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

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

    #' @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]]

  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)
}


#' 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)
        }
      }
    }
  )
)

#' 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
    }
  )
)

#' 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
    #' 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 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_omit <- file1_contents_list[[2]]
      file2_contents_omit <- file2_contents_list[[2]]

      if (!identical(file1_contents_omit, file2_contents_omit)) {
        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)
    }
  )
)

#' 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

#' 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
}

#' 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")
}

#' 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)
    }
  )
)


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
    #' Mehod for getting configuration value based on configuration key.
    #' Configuratio 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
    #' Mehod 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 != "description") {
            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(
          description = "Generic options",
          debug = list(
            description = "Debugging enabled",
            options = c("yes", "no"),
            default = "no"
          ),
          images = list(
            description = "Process embedded images",
            options = c("yes", "no"),
            default = "yes"
          )
        ),
        rtf = list(
          description = "RTF comparison (summary and details)",
          images = list(
            description = "Process embedded images",
            options = c("yes", "no"),
            default = "yes"
          )
        ),
        pdf = list(
          description = "PDF comparison (summary)",
          details = list(
            description = "Process PDF detailed comparison",
            options = c("yes", "no"),
            default = "yes"
          )
        ),
        details = list(
          description = "Details comparison",
          mode = list(
            description = "Mode",
            options = c("full", "summary"),
            default = "summary"
          )
        )
      )

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

        schema[["rtf"]][["images"]] <- list(
          description = "Process embedded images (missing magick library)",
          options = c("no"),
          default = "no"
        )
      }

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

      schema
    }
  )
)

#' 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
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	16x	entry <- list(
59	16x	label = label,
60	16x	start_time = Sys.time(),
61	16x	children = list(),
62	16x	duration = NULL,
63	16x	is_message = FALSE
64		)
65	16x	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	16x	entry <- self$stack[[length(self$stack)]]
97	16x	self$stack <- self$stack[-length(self$stack)]
98
99	16x	time_diff <- difftime(Sys.time(), entry$start_time, units = "secs")
100	16x	entry$duration <- round(as.numeric(time_diff) * 1000)
101
102	16x	if (length(self$stack) > 0) {
103	11x	parent <- self$stack[[length(self$stack)]]
104	11x	parent$children[[length(parent$children) + 1]] <- entry
105	11x	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	20x	indent <- paste("[DEBUG]", strrep(" ", depth))
122	20x	if (isTRUE(entry$is_message)) {
123	4x	cat(indent, "'", entry$label, "'\n", sep = "")
124		} else {
125	16x	execution_time <- paste0("(execution time ", entry$duration, " ms)")
126	16x	cat(indent, "'", entry$label, "' ", execution_time, "\n", sep = "")
127
128	16x	for (child in entry$children) {
129	15x	self$print_debug_tree(child, depth + 1)
130		}
131		}
132		}
133		)
134		)

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		#' 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	48x	self$vrf_open_debug("Binary::vrf_contents", config)
46
47	48x	contents <- readLines(file, warn = FALSE)
48	48x	result <- self$vrf_contents_inner(contents, config, omit)
49
50	48x	self$vrf_close_debug()
51	48x	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		#' with the rows matching the omit string excluded. This method can be
77		#' 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_omit <- file1_contents_list[[2]]
109	3x	file2_contents_omit <- file2_contents_list[[2]]
110
111	3x	if (!identical(file1_contents_omit, file2_contents_omit)) {
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		#' 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		#' 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	96x	self$file1 <- file1
44	96x	self$file2 <- file2
45	96x	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	68x	self$vrf_open_debug("File::vrf_summary", config)
59	68x	self$vrf_add_debug_files()
60
61	68x	if (!is.null(self$summary_comparison)) {
62	!	self$vrf_add_debug("Returning previously calculated comparison results")
63	!	return(self$summary_comparison)
64		}
65
66	68x	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	59x	tryCatch({
71	59x	result <- self$vrf_summary_inner(config, omit)
72	59x	addition <- self$vrf_details_supported(config)
73
74	59x	if ('' != addition) {
75	5x	result <- paste(result, addition)
76		}
77	59x	}, 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	68x	self$summary_comparison <- result
85	68x	self$vrf_close_debug()
86
87	68x	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	26x	mode <- self$vrf_option_value(config, "details.mode")
101	26x	if ("NA" == mode) {
102	!	mode <- "summary"
103		}
104
105	26x	self$vrf_open_debug(paste("File::vrf_details, mode:", mode), config)
106	26x	self$vrf_add_debug_files()
107
108	26x	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	26x	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	15x	} 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	14x	tryCatch({
131	14x	result <- self$vrf_details_inner(config, omit)
132	14x	}, 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	26x	self$details_comparison[[mode]] <- result
144	26x	self$vrf_close_debug()
145
146	26x	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	738x	if (is.null(config)) {
196	!	return("NA")
197		}
198	738x	value <- config$get(key)
199	738x	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	516x	if ("yes" != self$vrf_option_value(config, "generic.debug")) {
212	505x	return()
213		}
214
215	11x	if (is.null(self$debugger)) {
216	2x	self$debugger <- Debugger$new()
217		}
218
219	11x	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	94x	if (is.null(self$debugger)) {
241	93x	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	516x	if (is.null(self$debugger)) {
254	505x	return()
255		}
256	11x	self$debugger$close_debug()
257		}
258		)
259		)
260		# 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	53x	self$vrf_open_debug("Txt::vrf_summary_inner" , config)
50
51	53x	file1_contents_list <- self$file1_contents_list
52	53x	file2_contents_list <- self$file2_contents_list
53
54	53x	if (is.null(file1_contents_list)) {
55	53x	file1_contents_list <- self$vrf_contents(self$file1, config, omit)
56	53x	self$file1_contents_list <- file1_contents_list
57		}
58
59	53x	if (is.null(file2_contents_list)) {
60	53x	file2_contents_list <- self$vrf_contents(self$file2, config, omit)
61	53x	self$file2_contents_list <- file2_contents_list
62		}
63
64	53x	file1_contents_omit <- file1_contents_list[[2]]
65	53x	file2_contents_omit <- file2_contents_list[[2]]
66
67	53x	difference <- all.equal(file1_contents_omit, file2_contents_omit)
68	53x	result <- "File content comparison failed!"
69	53x	result_images <- ""
70	53x	pattern <- "Lengths \\((\\d+), (\\d+)\\) differ \\(string compare on first"
71
72	53x	if (typeof(difference) == "logical") {
73		# all.equal returns logical vector if there are no differences
74	27x	result <- "No differences."
75	26x	} 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	14x	} 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	14x	count <- as.numeric(gsub("[^[:digit:].]", "", difference))
83	14x	result <- paste0("File content has changes in ", count, " place(s).")
84		}
85
86	53x	self$vrf_close_debug()
87	53x	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	12x	self$vrf_open_debug("Txt::vrf_details_inner" , config)
101
102	12x	file1_contents_list <- self$file1_contents_list
103	12x	file2_contents_list <- self$file2_contents_list
104
105	12x	if (is.null(file1_contents_list)) {
106	12x	file1_contents_list <- self$vrf_contents(self$file1, config, omit)
107	12x	self$file1_contents_list <- file1_contents_list
108		}
109
110	12x	if (is.null(file2_contents_list)) {
111	12x	file2_contents_list <- self$vrf_contents(self$file2, config, omit)
112	12x	self$file2_contents_list <- file2_contents_list
113		}
114
115	12x	file1_contents_whole <- file1_contents_list[[1]]
116	12x	file2_contents_whole <- file2_contents_list[[1]]
117
118	12x	context <- 2
119	12x	if ("full" == super$vrf_option_value(config, "details.mode")) {
120	3x	context <- -1
121		}
122
123	12x	my_equalizer_with_omit <- function(x, x.chr) {
124	3x	my_finalizer(x, x.chr, omit)
125		}
126
127	12x	style <- diffobj::StyleHtmlLightRgb(
128	12x	html.output = "diff.w.style",
129	12x	finalizer = my_equalizer_with_omit
130		)
131
132	12x	diff_print <- diffobj::diffPrint(
133	12x	file1_contents_whole,
134	12x	file2_contents_whole,
135	12x	context = context,
136	12x	style = style
137		)
138
139	12x	result <- list(
140	12x	list(
141	12x	type = "text",
142	12x	contents = diff_print
143		)
144		)
145
146	12x	self$vrf_close_debug()
147	12x	return(result)
148		},
149
150		#' @description
151		#' Method for getting the inner part for the file contents query. The method
152		#' returns the file contents in two separate vectors inside a list. The
153		#' first vector is the file contents and the second one is the file contents
154		#' with the rows matching the omit string excluded. This method can be
155		#' overwritten by more specialized comparator classes. This method is
156		#' intended to be called only by the comparator classes in the processing
157		#' and shouldn't be called directly by the user.
158		#'
159		#' @param contents file contents
160		#' @param config configuration values
161		#' @param omit string pattern to omit from the comparison
162		#'
163		vrf_contents_inner = function(contents, config, omit) {
164	130x	self$vrf_open_debug("Txt::vrf_contents_inner" , config)
165
166	130x	contents_omit <- contents
167
168	130x	if (!is.null(omit) && "" != paste0(omit)) {
169	54x	contents_omit <- stringr::str_subset(
170	54x	string = contents,
171	54x	pattern = paste0(omit),
172	54x	negate = TRUE
173		)
174		}
175
176	130x	self$vrf_close_debug()
177	130x	return(list(contents, contents_omit))
178		},
179
180		#' @description
181		#' Inherited method for indicating whether detailed comparison is available
182		#' with the current comparator. Returns an empty string if the comparator is
183		#' is supported, otherwise a string that will be concatenated with the
184		#' summary string.
185		#'
186		#' @param config configuration values
187		#'
188		vrf_details_supported = function(config) {
189	64x	return("")
190		}
191		)
192		)
193		# nolint end: cyclocomp_linter
194
195		#' Custom finalizer method for diffobj html content finalizing. This method is
196		#' used to modify the diff html output so that omitted rows have their own
197		#' special styling and gutters.
198		#'
199		#' @param x comparator instance used for the comparison that is meant to
200		#' be created with the factory method vrf_comparator.
201		#' @param x.chr character text representation of x, typically generated with
202		#' the as character
203		#' @param omit all lines containing the omit string will be excluded from the
204		#' comparison (detaulf = NULL)
205		#'
206		#' @keywords internal
207
208		my_finalizer <- function(x, x.chr, omit) {
209
210	3x	split <- strsplit(x.chr, "<div class='diffobj-row'>")[[1]]
211
212	3x	if (!is.null(omit) && "" != paste0(omit)) {
213	1x	for (i in seq_along(split)) {
214	9x	if (grepl(omit, split[[i]])) {
215	1x	row <- split[[i]]
216
217		# modifying maching row markup
218	1x	row <- gsub(
219	1x	"class='diffobj-match'",
220	1x	"class='ignore'",
221	1x	row
222		)
223
224	1x	row <- gsub(
225	1x	"<div class='diffobj-gutter'><div class='ignore'> ",
226	1x	"<div class='diffobj-gutter'><div class='ignore'>x",
227	1x	row
228		)
229
230		# modifying inserted row markup
231	1x	row <- gsub(
232	1x	"class='insert'",
233	1x	"class='ignore'",
234	1x	row
235		)
236
237	1x	row <- gsub(
238	1x	"class='diffobj-word insert'",
239	1x	"class='diffobj-word ignore'",
240	1x	row
241		)
242
243	1x	row <- gsub(
244	1x	"<div class='diffobj-gutter'><div class='ignore'>>",
245	1x	"<div class='diffobj-gutter'><div class='ignore'>X",
246	1x	row
247		)
248
249		# modifying deleted row markup
250	1x	row <- gsub(
251	1x	"class='delete'",
252	1x	"class='ignore'",
253	1x	row
254		)
255
256	1x	row <- gsub(
257	1x	"class='diffobj-word delete'",
258	1x	"class='diffobj-word ignore'",
259	1x	row
260		)
261
262	1x	row <- gsub(
263	1x	"<div class='diffobj-gutter'><div class='ignore'><",
264	1x	"<div class='diffobj-gutter'><div class='ignore'>X",
265	1x	row
266		)
267
268		# highlight the ommitted part
269	1x	row <- gsub(
270	1x	omit,
271	1x	paste0(
272	1x	"<span class='diffobj-word-highlight ignore'>",
273	1x	omit,
274	1x	"</span>"
275		),
276	1x	row
277		)
278
279	1x	split[[i]] <- row
280		}
281		}
282		}
283
284	3x	html_string <- paste(split, collapse = "<div class='diffobj-row'>")
285
286	3x	diffobj::finalizeHtml(x, html_string)
287		}

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	94x	if (!file.exists(file1) \|\| !file.exists(file2)) {
31	20x	return(BinaryFileComparator$new(file1 = file1, file2 = file2))
32		}
33
34	74x	file_extension <- tools::toTitleCase(tools::file_ext(file1))
35
36	74x	if (file_extension %in% list("Jpg", "Jpeg", "Png")) {
37	5x	file_extension <- "Img"
38		}
39
40		# construct the comparator name
41	74x	comparator_name <- paste0(file_extension, "FileComparator")
42
43	74x	if (exists(comparator_name, envir = .GlobalEnv)) {
44	63x	class_def <- get(comparator_name, envir = .GlobalEnv)
45
46		# return the specific class instance if the class exists
47	63x	if (inherits(class_def, "R6ClassGenerator")) {
48	63x	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		#' 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
2		merge_values <- function(defaults, overrides) {
3	30x	result <- list()
4
5	30x	for (name in names(defaults)) {
6	66x	def <- defaults[[name]]
7	66x	over <- overrides[[name]]
8
9	66x	has_defaults <- "default" %in% names(def)
10	66x	has_options <- "options" %in% names(def)
11
12	66x	if (is.list(def) && has_defaults && has_options) {
13	15x	if (!is.null(over) && over %in% def$options) {
14	8x	result[[name]] <- over
15		} else {
16	7x	result[[name]] <- def$default
17		}
18	51x	} else if (is.list(def)) {
19	5x	if (!is.list(over)) over <- list()
20	24x	result[[name]] <- merge_values(def, over)
21		} else {
22	27x	result[[name]] <- if (!is.null(over)) over else def
23		}
24		}
25
26	30x	result
27		}
28
29		get_nested_value <- function(config, key) {
30	751x	parts <- strsplit(key, ".", fixed = TRUE)[[1]]
31
32	751x	for (p in parts) {
33	1502x	config <- config[[p]]
34		}
35	751x	config
36		}
37
38		set_nested_value <- function(config, key, value) {
39	18x	parts <- strsplit(key, ".", fixed = TRUE)[[1]]
40
41	18x	if (length(parts) == 1) {
42	9x	config[[parts[1]]] <- value
43		} else {
44	9x	sub_key <- paste(parts[-1], collapse = ".")
45	9x	config[[parts[1]]] <- set_nested_value(config[[parts[1]]], sub_key, value)
46		}
47	18x	config
48		}
49
50		check_magick_available <- function() {
51	27x	requireNamespace("magick", quietly = TRUE)
52		}
53
54		check_pdftools_available <- function() {
55	30x	requireNamespace("pdftools", quietly = TRUE)
56		}
57
58		#' Config.R
59		#'
60		#' Class for manging the library configuration options. Creates the default
61		#' configuration without any source file, populates partial or missing config
62		#' elements, stores the config file to local machine, and provides easy access
63		#' methods for setting and getting config values.
64		#'
65		#' @examples
66		#'
67		#' # Creates the configuration instance. Checks automatically if there is
68		#' # a previously stored configuration json file available for usage. Note
69		#' # that you don't need to explicitly define the config file path for the
70		#' # Config instance - by default the config file will be searched from and
71		#' # written in user-specific configuration directory for the package.
72		#'
73		#' path <- tempfile(fileext = ".json")
74		#' config <- Config$new(config_path = path)
75		#'
76		#' # Getting and setting configuration values
77		#'
78		#' value <- config$get("defailts.mode")
79		#' config$set("details.mode", "full")
80		#'
81		#' # Saving the current configuration to local machine (to tmp folder with
82		#' # the given explicit file path in initialization).
83		#'
84		#' config$save()
85		#'
86		#' @import jsonlite
87		#' @import rappdirs
88		#' @importFrom R6 R6Class
89		#'
90		#' @field schema configuration schema
91		#' @field config current configuration data
92		#' @field path configuration json file path
93		#'
94		#' @export
95		#'
96		Config <- R6::R6Class(
97		"Config",
98		public = list(
99		schema = NULL,
100		config = NULL,
101		path = NULL,
102
103		#' @description
104		#' Constructor for initializing the configuration. Checks the local machine
105		#' for existing configuration file is load_config = TRUE. Ensures that all
106		#' the project configuration values are included.
107		#'
108		#' @param load_config load configuration from local machine if available
109		#' @param config_path location of the used/stored configuration json file
110		#'
111		initialize = function(load_config = TRUE, config_path = NULL) {
112	28x	self$schema <- self$get_default_schema()
113	28x	self$config <- self$get_default_config()
114
115	28x	if (is.null(config_path)) {
116	24x	config_dir <- rappdirs::user_config_dir("verifyr2")
117	24x	self$path <- file.path(config_dir, "config.json")
118		} else {
119	4x	self$path <- config_path
120		}
121
122	28x	if (load_config && file.exists(self$path)) {
123	3x	file_config <- jsonlite::read_json(self$path, simplifyVector = TRUE)
124	3x	self$config <- merge_values(self$get_default_schema(), file_config)
125	3x	self$config <- self$get_default_config() \|> merge_values(self$config)
126		}
127		},
128
129		#' @description
130		#' Mehod for getting configuration value based on configuration key.
131		#' Configuratio item children are separated with a dot in the key notation.
132		#'
133		#' @param key configuration property key for which to get the value
134		#'
135		get = function(key) {
136	751x	get_nested_value(self$config, key)
137		},
138
139		#' @description
140		#' Mehod for setting configuration value based on configuration key.
141		#' Configuration item children are separated with a dot in the key notation.
142		#'
143		#' @param key configuration property key for which to get the value
144		#' @param value value to set for the specified configuration key
145		#'
146		set = function(key, value) {
147	9x	self$config <- set_nested_value(self$config, key, value)
148		},
149
150		#' @description
151		#' Method for saving the current configuration data into local machine.
152		#'
153		save = function() {
154	1x	dir.create(dirname(self$path), showWarnings = FALSE, recursive = TRUE)
155	1x	jsonlite::write_json(self$config, self$path, pretty = TRUE)
156		},
157
158		#' @description
159		#' Helper method for getting configuration default values. These default
160		#' values will be used in the configuration in case the configuration
161		#' properties are not present previously.
162		#'
163		get_default_config = function() {
164	31x	defaults <- list()
165
166	31x	for (group in names(self$schema)) {
167	124x	defaults[[group]] <- list()
168
169	124x	for (key in names(self$schema[[group]])) {
170	279x	if (key != "description") {
171	155x	defaults[[group]][[key]] <- self$schema[[group]][[key]]$default
172		}
173		}
174		}
175	31x	defaults
176		},
177
178		#' @description
179		#' Method for getting the full configuration schema. Apart from the
180		#' configuration data, the schema contains property descriptions as well as
181		#' all possible values for the configuration properties.
182		#'
183		get_default_schema = function() {
184	31x	schema <- list(
185	31x	generic = list(
186	31x	description = "Generic options",
187	31x	debug = list(
188	31x	description = "Debugging enabled",
189	31x	options = c("yes", "no"),
190	31x	default = "no"
191		),
192	31x	images = list(
193	31x	description = "Process embedded images",
194	31x	options = c("yes", "no"),
195	31x	default = "yes"
196		)
197		),
198	31x	rtf = list(
199	31x	description = "RTF comparison (summary and details)",
200	31x	images = list(
201	31x	description = "Process embedded images",
202	31x	options = c("yes", "no"),
203	31x	default = "yes"
204		)
205		),
206	31x	pdf = list(
207	31x	description = "PDF comparison (summary)",
208	31x	details = list(
209	31x	description = "Process PDF detailed comparison",
210	31x	options = c("yes", "no"),
211	31x	default = "yes"
212		)
213		),
214	31x	details = list(
215	31x	description = "Details comparison",
216	31x	mode = list(
217	31x	description = "Mode",
218	31x	options = c("full", "summary"),
219	31x	default = "summary"
220		)
221		)
222		)
223
224	31x	if (!check_magick_available()) {
225	4x	schema[["generic"]][["images"]] <- list(
226	4x	description = "Process embedded images (missing magick library)",
227	4x	options = c("no"),
228	4x	default = "no"
229		)
230
231	4x	schema[["rtf"]][["images"]] <- list(
232	4x	description = "Process embedded images (missing magick library)",
233	4x	options = c("no"),
234	4x	default = "no"
235		)
236		}
237
238	31x	if (!check_pdftools_available()) {
239	1x	schema[["pdf"]][["details"]] <- list(
240	1x	description = "Process PDF details (missing pdftools library)",
241	1x	options = c("no"),
242	1x	default = "no"
243		)
244		}
245
246	31x	schema
247		}
248		)
249		)

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		}