https://github.com/cran/stringi
Tip revision: 4c8c30c0910f190462e421ea6f153b1f2681197c authored by Marek Gagolewski on 17 May 2021, 06:30:03 UTC
version 1.6.2
version 1.6.2
Tip revision: 4c8c30c
install.R
# kate: default-dictionary en_US
## This file is part of the 'stringi' package for R.
## Copyright (c) 2013-2021, Marek Gagolewski <https://www.gagolewski.com>
## All rights reserved.
##
## Redistribution and use in source and binary forms, with or without
## modification, are permitted provided that the following conditions are met:
##
## 1. Redistributions of source code must retain the above copyright notice,
## this list of conditions and the following disclaimer.
##
## 2. Redistributions in binary form must reproduce the above copyright notice,
## this list of conditions and the following disclaimer in the documentation
## and/or other materials provided with the distribution.
##
## 3. Neither the name of the copyright holder nor the names of its
## contributors may be used to endorse or promote products derived from
## this software without specific prior written permission.
##
## THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
## 'AS IS' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING,
## BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
## FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
## HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
## PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
## OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
## WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
## OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
## EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
# internal functions used whilst installing stringi
icudt_fname <- c(
little55 = "icudt55l.zip",
big55 = "icudt55b.zip",
little61 = "icudt61l.zip",
big61 = "icudt61b.zip",
little69 = "icu4c-69_1-data-bin-l.zip",
big69 = "icu4c-69_1-data-bin-b.zip"
)
icudt_md5ex <- c(
little55 = "ff345529f230cc39bb8d450af0607708",
big55 = "1194f0dd879d3c1c1f189cde5fd90efe",
little61 = "6d14e059b26606f08bad3b41eb3b5c93",
big61 = "45719f3208b2d67132efa620cecccb56",
little69 = "58ecd3e72e9d96ea2876dd89627afeb8",
big69 = "e86eba75d1f39be63713569dc0dc9524"
)
# icudt_mirrors <- c(
# # "https://github.com/unicode-org/icu/releases/download/release-69-1/",
# "https://raw.githubusercontent.com/gagolews/stringi/master/src/icu69/data/",
# "https://raw.githubusercontent.com/gagolews/stringi/master/src/icu61/data/",
# "https://raw.githubusercontent.com/gagolews/stringi/master/src/icu55/data/",
# "http://raw.githubusercontent.com/gagolews/stringi/master/src/icu69/data/",
# "http://raw.githubusercontent.com/gagolews/stringi/master/src/icu61/data/",
# "http://raw.githubusercontent.com/gagolews/stringi/master/src/icu55/data/"
# )
# @rdname stri_install
stri_install_check <- function(silent = FALSE)
{
# As of v1.1.3, this function is no longer exported.
# It was deprecated in 0.5-5.
stopifnot(is.logical(silent), length(silent) == 1)
allok <- tryCatch({
if (!silent)
message(stri_info(TRUE)) # this may also throw an error
if (length(stri_enc_list()) <= 0)
stop("no encodings are supported")
if (length(stri_locale_list()) <= 0)
stop("no locales are supported")
if (length(stri_trans_list()) <= 0)
stop("no transliterators are supported")
TRUE
}, error = function(e) {
FALSE
})
if (!silent) {
if (allok)
message("All tests completed successfully.") else {
message("It seems that the ICU data library has not been installed properly.")
message("Call stri_install_icudt() to fix this problem.")
}
}
invisible(allok)
}
# @rdname stri_install
stri_download_icudt <- function(inpath, icu_bundle_version)
{
fname <- icudt_fname[paste0(.Platform$endian, icu_bundle_version)]
md5ex <- icudt_md5ex[paste0(.Platform$endian, icu_bundle_version)]
# mirrors <- icudt_mirrors
mirrors <- sprintf(
"%s://raw.githubusercontent.com/gagolews/stringi/master/src/icu%d/data/",
c("https", "http"),
icu_bundle_version
)
icudtzipfname <- file.path(inpath, fname) #tempfile(fileext='.zip')
if (file.exists(icudtzipfname)) {
md5ob <- tools::md5sum(icudtzipfname)
if (is.na(md5ob)) {
message(
sprintf("error checking md5sum for %s", icudtzipfname)
)
return(invisible(FALSE))
}
if (md5ob != md5ex) {
message(sprintf(
"md5sum mismatch for %s (%s vs. %s)",
icudtzipfname,
as.character(md5ob),
as.character(md5ex)
))
return(invisible(FALSE))
}
message("icudt already downloaded")
return(icudtzipfname)
}
# if (!is.null(inpath)) {
# stopifnot(is.character(inpath), length(inpath) > 0, !is.na(inpath))
# mirrors <- c(inpath, mirrors)
# }
download_from_mirror <- function(href, fname, icudtzipfname) {
tryCatch({
suppressWarnings(file.remove(icudtzipfname))
# download icudt
if (
download.file(
paste(href, fname, sep = ""), icudtzipfname, mode = "wb"
) != 0
) {
return("download error")
}
if (!file.exists(icudtzipfname)) {
return("download error")
}
md5ob <- tools::md5sum(icudtzipfname)
if (is.na(md5ob)) {
return(sprintf("error checking md5sum for %s", icudtzipfname))
}
if (md5ob != md5ex) {
return(sprintf(
"md5sum mismatch for %s (%s vs. %s)",
icudtzipfname,
as.character(md5ob),
as.character(md5ex)
))
}
TRUE
}, error = function(e) as.character(e))
}
message("downloading the ICU data library (icudt)")
message("output path: ", icudtzipfname)
if (!exists("dir.exists") || !dir.exists(inpath)) {
# dir.exists is R >= 3.2.0
suppressWarnings(dir.create(inpath))
}
allok <- FALSE
for (m in mirrors) {
if (identical(status <- download_from_mirror(m, fname, icudtzipfname), TRUE)) {
allok <- TRUE
break
} else message(status)
}
if (!allok || !file.exists(icudtzipfname)) {
suppressWarnings(file.remove(icudtzipfname))
message("icudt download failed")
return(invisible(FALSE))
}
message("icudt has been downloaded successfully")
return(icudtzipfname)
}
# @rdname stri_install
stri_install_icudt <- function(check = TRUE, outpath = NULL, inpath = NULL, icu_bundle_version = NULL)
{
# As of v1.1.3, this function is no longer exported.
# It was deprecated in v0.5-5.
stopifnot(is.logical(check), length(check) == 1, !is.na(check))
if (check && stri_install_check(TRUE)) {
message("icudt has already been installed")
return(invisible(TRUE))
}
# remember about importFrom tools md5sum -> stringi-package.R
# use this very code in install.libs.R directly
icudtzipfname <- stri_download_icudt(inpath, icu_bundle_version)
if (identical(icudtzipfname, FALSE) || !file.exists(icudtzipfname)) {
return(invisible(FALSE))
}
if (is.null(outpath))
outpath <- file.path(path.package("stringi"), "libs")
stopifnot(is.character(outpath), length(outpath) == 1, file.exists(outpath))
message("decompressing icudt ", icudtzipfname, " to: ", outpath)
res <- unzip(icudtzipfname, exdir = outpath, overwrite = TRUE)
if (!is.character(res) || length(res) <= 0) {
message("error decompressing icudt")
return(invisible(FALSE))
}
message("icudt has been installed successfully")
invisible(TRUE)
}