Add function to remove unused media files

R/openxml_document.R

@@ -54,8 +54,30 @@ openxml_document <- R6Class(
  },
  relationship = function(){
  private$rels_doc
- }
+ },
+ clean_media = function() {
+ # get package directory
+ package_dir <- dirname(dirname(dirname(private$rels_filename)))
+ # find .xml.rels files
+ rel_files <- list.files(package_dir, pattern = "\\.xml.rels$", recursive = TRUE, full.names = TRUE)
+
+ # collect media files that are referenced in .xml.rels files
+ media_file_rels <- lapply(rel_files, function(xml){
+ zz <- xml2::read_xml(xml)
+ rels <- xml2::xml_children(zz)
+ targets <- xml2::xml_attr(rels, "Target")
+ grep("^\\.\\./media/", targets, value = TRUE)
+ })
+ media_file_rels <- file.path(dirname(dirname(private$rels_filename)), sub("\\.\\./", "", unique(unlist(media_file_rels))))
 
+ # get files in media folder
+ media_folder <- grep("/media$", list.dirs(package_dir), value = TRUE)
+ media_files <- list.files(media_folder, recursive = TRUE, full.names = TRUE)
+
+ # delete unused files
+ files_to_delete <- media_files[!(media_files %in% media_file_rels)]
+ unlink(files_to_delete, force = TRUE)
+ }
  ),
  private = list(
 

R/ppt_classes.R

@@ -79,6 +79,7 @@ presentation <- R6Class(
  private$slide_rid <- private$slide_rid[-dropid]
 
  private$update_xml()
+ self$clean_media()
 
  self
  }

R/pptx_slide_manip.R

@@ -88,16 +88,14 @@ on_slide <- function(x, index) {
 #' @description Remove a slide from a pptx presentation.
 #' @param x an rpptx object
 #' @param index slide index, default to current slide position.
-#' @param rm_images if TRUE (defaults to FALSE), images presented in
-#' the slide to remove are also removed from the file.
 #' @note cursor is set on the last slide.
 #' @examples
 #' my_pres <- read_pptx()
 #' my_pres <- add_slide(my_pres)
 #' my_pres <- remove_slide(my_pres)
 #' @family functions slide manipulation
 #' @seealso [read_pptx()], [ph_with()], [ph_remove()]
-remove_slide <- function(x, index = NULL, rm_images = FALSE) {
+remove_slide <- function(x, index = NULL) {
  l_ <- length(x)
  if (l_ < 1) {
  stop("presentation contains no slide to delete", call. = FALSE)
@@ -113,13 +111,6 @@ remove_slide <- function(x, index = NULL, rm_images = FALSE) {
  filename <- basename(x$presentation$slide_data()$target[index])
  location <- which(x$slide$get_metadata()$name %in% filename)
 
- if (rm_images) {
- media_files <- pptx_summary(x)$media_file
- if (length(media_files)) {
- unlink(file.path(x$package_dir, media_files), force = TRUE)
- }
- }
-
  del_file <- x$slide$remove_slide(location)
 
  # update presentation elements