Added fallback for nonbabelusers in case Cactus is down

R/createMassBank.R

@@ -330,6 +330,13 @@ createMolfile <- function(id_or_smiles, fileName = FALSE)
 	if(is.na(babeldir))
 	{
 		res <- getCactus(smiles, "sdf")
+		
+		if(is.na(res)){
+			res <- getPcSDF(smiles)
+		}
+		if(is.na(res)){
+			stop("Pubchem and Cactus both seem to be down.")
+		}
 		if(is.character(fileName))
 			writeLines(res, fileName)
 	}
@@ -492,8 +499,12 @@ gatherData <- function(id)
 		inchikey_split <- system(cmdinchikey, intern=TRUE, input=smiles, ignore.stderr=TRUE)
 	} else{
 		inchikey <- getCactus(smiles, 'stdinchikey')
-		##Split the "InChiKey=" part off the key
-		inchikey_split <- strsplit(inchikey, "=", fixed=TRUE)[[1]][[2]]
+		if(!is.na(inchikey)){
+			##Split the "InChiKey=" part off the key
+			inchikey_split <- strsplit(inchikey, "=", fixed=TRUE)[[1]][[2]]
+		} else{
+		    inchikey <- getPcInchiKey(smiles)
+		}
 	}
 	
 	##Use Pubchem to retrieve information

R/webAccess.R

@@ -313,6 +313,8 @@ CTS.externalIdTypes <- function(data)
   }
 }
 
+
+
 getPcCHEBI <- function(query, from = "inchikey")
 {
 	# Get the JSON-Data from Pubchem
@@ -466,3 +468,59 @@ getPcIUPAC <- function (query, from = "inchikey")
 		return(IUPACEntries[[1]]$value$sval)
 	}
 } 
+
+getPcInchiKey <- function(query, from = "smiles"){
+	# Get the JSON-Data from Pubchem
+	baseURL <- "http://pubchem.ncbi.nlm.nih.gov/rest/pug/compound"
+	url <- paste(baseURL, from, query, "record", "json", sep="/")
+	errorvar <- 0
+	currEnvir <- environment()
+	
+	tryCatch(
+		data <- getURL(URLencode(url),timeout=5),
+		error=function(e){
+		currEnvir$errorvar <- 1
+	})
+	
+	if(errorvar){
+		return(NA)
+	}
+	
+	r <- fromJSON(data)
+	
+	# This happens if the InChI key is not found:
+	if(!is.null(r$Fault))
+	return(NA)
+	
+	# Find the entries which contain Chebi-links
+	if(!is.null(r$PC_Compounds[[1]]$props)){
+		INKEYindex <- which(sapply(r$PC_Compounds[[1]]$props, function(x) x$urn$label) == "InChIKey")
+		if(length(INKEYindex) > 0){
+			return(r$PC_Compounds[[1]]$props[[INKEYindex]]$value$sval)
+		}	else{return(NA)}
+	}	else{return(NA)}
+
+	
+}
+
+getPcSDF <- function(query, from = "smiles"){
+	baseURL <- "http://pubchem.ncbi.nlm.nih.gov/rest/pug/compound"
+	url <- paste(baseURL, from, query, "sdf", sep="/")
+	
+	errorvar <- 0
+	currEnvir <- environment()
+	
+	tryCatch(
+		data <- getURL(URLencode(url),timeout=5),
+		error=function(e){
+		currEnvir$errorvar <- 1
+	})
+	
+	if(errorvar){
+		return(NA)
+	}
+	
+	molEnd <- regexpr(data,pattern="M  END",fixed=TRUE)+5
+	data <- c(strsplit(substring(data,1,molEnd),"\n")[[1]],"$$$$")
+	return(data)
+}