-
Notifications
You must be signed in to change notification settings - Fork 0
/
resmush_url.R
255 lines (213 loc) · 6.42 KB
/
resmush_url.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
#' Optimize an online file
#'
#' @description
#' Optimize and download an online image using the
#' [reSmush.it API](https://resmush.it/).
#'
#' @param url url or a vector of urls pointing to hosted image files.
#' **reSmush** can optimize the following image files:
#' * `png`
#' * `jpg/jpeg`
#' * `gif`
#' * `bmp`
#' * `tiff`
#' * `webp`
#' @param outfile Path or paths where the optimized files would be store in
#' your disk. By default, temporary files (see [tempfile()]) with the same
#' [basename()] than the file provided in `url` would be created. It should be
#' of the same length than `url` parameter.
#'
#' @param overwrite Logical. Should `outfile` be overwritten (if already
#' exists)? If `FALSE` and `outfile` exists it would create a copy with
#' a numerical suffix (i.e. `<outfile>.png`, `<outfile>_01.png`, etc.).
#'
#' @inheritParams resmush_file
#'
#' @return
#' Writes on disk the optimized file if the API call is successful.
#' In all cases, a (invisible) data frame with a summary of the process is
#' returned as well.
#'
#' If any value of the vector `outfile` is duplicated, `resmush_url()` would
#' rename the output with a suffix `_01. _02`, etc.
#'
#'
#' @seealso
#' [reSmush.it API](https://resmush.it/api/) docs.
#'
#' @family optimize
#'
#' @export
#'
#' @examplesIf curl::has_internet()
#'
#' \donttest{
#'
#' # Base url
#' base_url <- "https://raw.githubusercontent.com/dieghernan/resmush/main/inst/"
#'
#' png_url <- paste0(base_url, "/extimg/example.png")
#' resmush_url(png_url)
#'
#' # Several urls
#' jpg_url <- paste0(base_url, "/extimg/example.jpg")
#'
#'
#' summary <- resmush_url(c(png_url, jpg_url))
#'
#' # Returns an (invisible) data frame with a summary of the process
#' summary
#'
#' # Display with png
#' if (require("png", quietly = TRUE)) {
#' my_png <- png::readPNG(summary$dest_img[1])
#' grid::grid.raster(my_png)
#' }
#'
#' # Use with jpg and parameters
#' resmush_url(jpg_url)
#' resmush_url(jpg_url, qlty = 10)
#' }
resmush_url <- function(url, outfile = file.path(tempdir(), basename(url)),
overwrite = FALSE, progress = TRUE, report = TRUE,
qlty = 92, exif_preserve = FALSE) {
# High level function for vectors
# Check lengths
l1 <- length(url)
l2 <- length(outfile)
if (l1 != l2) {
cli::cli_abort(paste0(
"Lengths of {.arg url} and {.arg outfile}",
"should be the same ({l1} vs. {l2})"
))
}
# Prepare progress bar
n_urls <- l1
n_seq <- seq_len(n_urls)
if (progress) {
opts <- options()
options(
cli.progress_bar_style = "fillsquares",
cli.progress_show_after = 0,
cli.spinner = "clock"
)
cli::cli_progress_bar(
format = paste0(
"{cli::pb_spin} Go! | {cli::pb_bar} ",
"{cli::pb_percent} [{cli::pb_elapsed}] | ETA: {cli::pb_eta} ",
"({cli::pb_current}/{cli::pb_total} urls)"
),
total = n_urls, clear = FALSE
)
}
# Call single with loop, cli::cli_progress_bar does not work on applys yet
res_df <- NULL
for (i in n_seq) {
if (progress) cli::cli_progress_update()
df <- resmush_url_single(
url = url[i], outfile = outfile[i],
overwrite = overwrite, qlty = qlty,
exif_preserve = exif_preserve
)
if (is.null(res_df)) {
res_df <- df
} else {
res_df <- rbind(res_df, df)
}
}
# restore options
if (progress) {
options(
cli.progress_bar_style = opts$cli.progress_bar_style,
cli.progress_show_after = opts$cli.progress_show_after,
cli.spinner = opts$cli.spinner
)
}
# report
if (report) {
show_report(res_df = res_df, summary_type = "url")
}
# output
return(invisible(res_df))
}
resmush_url_single <- function(url,
outfile = file.path(tempdir(), basename(url)),
overwrite = FALSE,
qlty = 92, exif_preserve = FALSE) {
# Avoid duplicates if requested
outfile <- make_unique_paths(outfile, overwrite)
# Create dir if it doesn't exists
the_dir <- dirname(outfile)
if (!dir.exists(the_dir)) dir.create(the_dir, recursive = TRUE)
# Master table with results
res <- data.frame(
src_img = url, dest_img = NA, src_size = NA,
dest_size = NA, compress_ratio = NA, notes = NA,
src_bytes = NA, dest_bytes = NA
)
# Check access
# Internal option, for checking purposes only
test <- getOption("resmush_test_offline", FALSE)
if (any(isFALSE(curl::has_internet()), test)) {
res$notes <- "Offline"
return(invisible(res))
}
# API Calls -----
res_get <- smush_from_url(url, qlty, exif_preserve, n_rep = 3)
if ("error" %in% names(res_get)) {
res$notes <- paste0(res_get$error, ": ", res_get$error_long)
return(invisible(res))
}
# nocov start
if (!"dest" %in% names(res_get)) {
res$notes <- "API Not responding, check https://resmush.it/status}"
return(invisible(res))
}
# nocov end
## 2. Download from dest ----
dwn_opt <- httr2::request(res_get$dest)
# Finally
dwn_opt <- httr2::req_perform(dwn_opt, path = outfile)
# Corner case
# Internal option, for checking purposes only
test_corner <- getOption("resmush_test_corner", FALSE)
if (any(httr2::resp_status(dwn_opt) != 200, test_corner)) {
res$notes <- "API Not responding, check https://resmush.it/status}"
return(invisible(res))
}
# Finally
res$dest_img <- outfile
src_size <- res_get$src_size
src_size_pretty <- make_pretty_size(src_size)
res$src_size <- src_size_pretty
res$src_bytes <- src_size
out_size <- file.size(outfile)
out_size_pretty <- make_pretty_size(out_size)
res$dest_size <- out_size_pretty
res$dest_bytes <- out_size
# Reduction ratio
red_ratio <- 1 - out_size / src_size
res$compress_ratio <- sprintf("%0.2f%%", red_ratio * 100)
res$notes <- "OK"
return(invisible(res))
}
# Helper function for retrying the call
# Useful for some cases e.g imgur
smush_from_url <- function(url, qlty, exif_preserve = TRUE, n_rep = 3) {
# Make logical
exif_preserve <- isTRUE(exif_preserve)
api_url <- httr2::url_parse("http://api.resmush.it/ws.php")
api_url$query <- list(
qlty = qlty, exif = exif_preserve,
img = url
)
api_url <- httr2::url_build(api_url)
the_req <- httr2::request(api_url)
for (i in seq(1, n_rep)) {
api_get <- httr2::req_perform(the_req)
res_get <- httr2::resp_body_json(api_get)
if (!"error" %in% names(res_get)) break
Sys.sleep(0.5)
}
return(res_get)
}