diff --git a/find_URLs.R b/find_URLs.R index 1f19cdd..19d2df2 100644 --- a/find_URLs.R +++ b/find_URLs.R @@ -5,24 +5,68 @@ library("writexl") #Konfiguration einbinden source("config/config.R") +## nicht meine Funktion - eingebunden von https://rdrr.io/cran/retractcheck/src/R/utils.R +find_doi <- function (strings) { + regex <- '10\\.\\d{4,9}/[-._;()/:A-Z0-9]+' + doiLoc <- gregexpr(text = strings, pattern = regex, perl = TRUE, ignore.case = TRUE) + + i <- 1 + res <- NULL + + # for each in the doiLoc list check whether match (!-1) + for ( i in 1:length(doiLoc) ) { + if ( doiLoc[[i]][1] != -1 ) { + for ( j in 1:length(doiLoc[[i]]) ) { + res <- c(res, + substring(strings[i], doiLoc[[i]][j], doiLoc[[i]][j] + attr(doiLoc[[i]], 'match.length')[j] - 1)) + } + } + } + + return(res) +} + + +## nicht meine Funktion - eingebunden von https://stackoverflow.com/questions/52911812/check-if-url-exists-in-r +valid_url <- function(url_in,t=2){ + con <- url(url_in) + check <- suppressWarnings(try(open.connection(con,open="rt",timeout=t),silent=T)[1]) + suppressWarnings(try(close.connection(con),silent=T)) + ifelse(is.null(check),TRUE,FALSE) +} + + url_pattern <- "http[s]?://(?:[a-zA-Z]|[0-9]|[$-_@.&+]|[!*\\(\\),]|(?:%[0-9a-fA-F][0-9a-fA-F]))+" #Excel mit den Zitaten die hinzugefügt werden sollen einlesen -df <- data.frame(read_excel(paste(PFAD_EXCEL, "distincts_kontrolliert.xlsx", sep=""))) +df <- data.frame(read_excel(paste(PFAD_EXCEL, "distincts_automated_gc3d.xlsx", sep=""))) df <- data.frame(lapply(df, stri_enc_toutf8)) #Neue Spalte für die DownloadLinks erstellen df['downloadLink'] <- NA #Schleife um nach Links zu suchen -for (element in 1:length(df$bibliographicCitation)){ +for (element in 1:length(df$bibliographicCitation)) { + #Extrahiert eventuell URLs oder DOI Angaben url <- str_extract(df$bibliographicCitation[element], url_pattern) + doi <- find_doi(df$bibliographicCitation[element]) - if (!is.na(url)) { - df$downloadLink[element] <- url + #Es wird nur dann versucht aus der DOI-Angabe eine URL zu erstellen, falls es keine URL gibt + if (is.na(url) && !is.null(doi)) { + #Entfernt das letzte Zeichen falls es ein Punkt ist (kommt öfter vor, deshalb so spezifisch) + if(substring(doi, nchar(doi)) == "."){ + doi <- substring(doi, 1, nchar(doi) - 1) + } + + #Generiert aus der DOI eine URL + url <- paste("https://doi.org/", doi, sep="") } + #Falls es eine URL gibt, wird überprüft ob diese auflösbar ist + if (!is.na(url) && valid_url(url)) { + df$downloadLink[element] <- url + } } write_xlsx(df, paste(PFAD_OUT, "distincts_automatisch_mit_URL",format(Sys.time(), "%Y_%m_%d") ,".xlsx", sep="")) \ No newline at end of file