pdfimager
pdfimager copied to clipboard
Alternative?
I can't use pdfimager on shinyapps.io (and it was a bit slow, although worked well!), so I've sought alternatives, but nothing is really great.
Here's a mostly-R painful hack at parsing PDFs for images. It only works sometimes, but it would be great if someone could improve this. Posting here in case anyone cares!
library(stringr)
library(hexView)
.PROBLEM <- function(type, aMessage) {
newMessage <- paste0("problem",
type,
" in ",
as.list(sys.call(-1))[[1]],
"(): ",
aMessage,
".")
if(type == "error") stop(newMessage, call. = FALSE)
message(newMessage)
}
isPDF <- function(aFileName,
verbose = TRUE) {
fileContents <- suppressWarnings(try(
readLines(aFileName, n = 5, ok = TRUE, warn = FALSE),
silent = TRUE))
# error catch when downloading PDFs online
if(inherits(fileContents, "try-error")) {
if(verbose == TRUE) {
message(paste0("Failed validation, with error: ", fileContents[1]))
} else {
if(verbose == "quiet") return(FALSE)
# when verbose = FALSE, secret message intended for PDF_downloader success
message(" poor internet connection,", appendLF = FALSE)
}
return(FALSE)
}
return(any(!is.na(str_extract(fileContents, ".*%PDF-1.*"))))
}
#' Attempts to extract all images from a PDF
#'
#' Tries to extract images within a PDF file. Currently does not support
#' decoding of images in CCITT compression formats. However, will still save
#' these images to file; as a record of the number of images detected in the PDF.
#'
#' @param file The file name and location of a PDF file. Prompts
#' for file name if none is explicitly called.
#'
#' @return A vector of file names saved as images.
#'
#' @export PDF_extractImages
PDF_extractImages <- function(file = file.choose()) {
# check if file is a PDF
if(isPDF(file, verbose = "quiet") != TRUE) {
.PROBLEM("error",
"file not PDF format")
}
# read file in HEX also ASCII
rawFile <- hexView::readRaw(file, human = "char")
# test if read file characters is same as file size
if (length(hexView::blockValue(rawFile)) != file.info(file)$size) {
.PROBLEM("error",
"possible size reading error of PDF")
}
# extract images embeded as PDF objects
createdFiles_bin <- scanPDFobjects(rawFile, file)
#if(quiet != TRUE) message(paste0(createdFiles_bin), " ")
# extract images embeded in XML
createdFiles_XML <- scanPDFXML(rawFile, file)
#if(quiet != TRUE) message(paste0(createdFiles_XML), " ")
theSavedFileNames <- c(createdFiles_bin, createdFiles_XML)
#print(round(7/3) + 7 %% 3)
#if(ignore != TRUE) {
#
# par(mfrow = c(2,3), las = 1)
# for(i in 1:6) {
# figure_display(theSavedFileNames[i])
# mtext(theSavedFileNames[i], col = "red", cex = 1.2)
# }
#}
return(theSavedFileNames)
}
scanPDFobjects <- function (rawFile, file) {
# collapse ASCII to a single string
theStringFile <- paste(hexView::blockValue(rawFile), collapse = '')
# split string by PDF objects and keep delimiter
theObjects <- paste(unlist(strsplit(theStringFile, "endobj")), "endobj", sep="")
# identify and screen candidate objects with images
candidateObjects <- c(which(str_extract(theObjects, "XObject/Width") == "XObject/Width"),
which(str_extract(theObjects, "Image") == "Image"))
removeObjects <- c(which(str_extract(theObjects, "PDF/Text") == "PDF/Text"),
which(str_extract(theObjects, "PDF /Text") == "PDF /Text"))
candidateObjects <- unique(candidateObjects[! candidateObjects %in% removeObjects])
if(length(candidateObjects) == 0) {
return("No PDF image objects detected.")
}
# generate file names for candidate images
fileNames <- paste(rep(tools::file_path_sans_ext(file), length(candidateObjects)),
"_bin_", 1:length(candidateObjects), ".jpg", sep="")
# extract and save all image binaries found in PDF
theNewFiles <- sapply(1:length(candidateObjects),
function(x, y, z) PDFobjectToImageFile(y[x],
theObjects,
file,
z[x]),
y = candidateObjects, z = fileNames)
return(theNewFiles)
}
PDFobjectToImageFile <- function (objectLocation,
theObjects,
theFile,
imageFileName) {
# parse object by stream & endstream
parsedImageObject <- unlist(strsplit(theObjects[objectLocation], "stream"))
# extract key char locations of image in PDF with trailingChars as a correction
# for "stream" being followed by 2 return characters
trailingChars <- " "
startImageLocation <- nchar(paste(parsedImageObject[1],
"stream", trailingChars, sep = ""))
endImageLocation <- startImageLocation +
nchar(substr(parsedImageObject[2],
1,
nchar(parsedImageObject[2]) - nchar("end")))
PDFLocation <- nchar(paste(theObjects[1:(objectLocation - 1)], collapse = ''))
# extract binary of image from PDF
PDFImageBlock <- hexView::readRaw(theFile,
offset = PDFLocation + startImageLocation,
nbytes = endImageLocation, machine = "binary")
# sometimes some of the orginal file format unicode is missing, this helps clean
# this issue for jpgs at least
if((PDFImageBlock$fileRaw[1] == "d8") && (PDFImageBlock$fileRaw[2] == "ff"))
PDFImageBlock$fileRaw <- c(as.raw('0xff'), PDFImageBlock$fileRaw)
# save binary of image to new file
detectedImageFile <- file(imageFileName, "wb")
writeBin(PDFImageBlock$fileRaw, detectedImageFile)
close(detectedImageFile)
# TO DO RETURN INFO ABOUT SUCCESSFUL FILE SAVE
return(imageFileName)
}
scanPDFXML <- function (rawFile, file) {
# collapse ASCII to a single string
theStringFile <- paste(hexView::blockValue(rawFile), collapse = '')
# split by XML tags with images and keep delimiter
theObjects <- paste(unlist(strsplit(theStringFile, "xmpGImg:image>")),
"xmpGImg:image>", sep="")
# identify objects with images
candidateObjects <- which(str_extract(theObjects, "</xmpGImg:image>") == "</xmpGImg:image>")
if(length(candidateObjects) == 0) {
return("No XML image objects detected.")
}
# generate file names for candidate images
fileNames <- paste(rep(tools::file_path_sans_ext(file), length(candidateObjects)),
"_XML_", 1:length(candidateObjects), ".jpg", sep="")
# extract and save all image binaries found in PDF
theNewFiles <- sapply(1:length(candidateObjects),
function(x, y, z) PDFXMLToImageFile(y[x],
theObjects,
file,
z[x]),
y = candidateObjects, z = fileNames)
return(theNewFiles)
}
PDFXMLToImageFile <- function (objectLocation,
theObjects,
theFile,
imageFileName) {
# parse encoded XML image and clean
parsedImage <- unlist(strsplit(theObjects[objectLocation], "</xmpGImg:image>"))
parsedImage <- gsub("
", "", parsedImage[1])
# decode image to base64
decodedImage <- RCurl::base64Decode(parsedImage, "raw")
# save binary of image to new file
detectedImageFile <- file(imageFileName, "wb")
writeBin(decodedImage, detectedImageFile)
close(detectedImageFile)
# TO DO RETURN INFO ABOUT SUCCESSFUL FILE SAVE
return(imageFileName)
}
PDF_extractImages()
@dcaud thanks for this. a few questions and a comment
- why couldn't you use it on shinyapp.io?
- so this package is slower than your script above? do you know what step is slow?
- i'm unlikely to do anything with your code above as I don't use this pkg and don't have time to work on it
- pdfimages is not installed on the servers that run apps on shinyapp.io (and the request process for them to change it is always uncertain), so you can't shell out to it.
- I'm not sure what is slower... put the overhead of launching pdfimages is surely part of it.
- No worries! Thanks for your package
- that makes sense
- ok, no worries
- 😸
closing, thanks for dropping in