Schreibt jetzt DOIs zu URLs um

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)) {
+  #Es wird nur dann versucht aus der DOI-Angabe eine URL zu erstellen, falls es keine URL gibt
-    df$downloadLink[element] <- url
+  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=""))