R/query.r

In seqinr: Biological Sequences Retrieval and Analysis

###############################################################################
#                                                                               #
#                                         query                                 #
#                                                                               #
###############################################################################

query <- function(listname, query, socket = autosocket(), invisible = TRUE, verbose = FALSE, virtual = FALSE) 
{
    #
    # Use list1 as listname if the argument is missing:
    #
    if(missing(query)){
        query <- listname
        listname <- "list1"
    }
    #
    # Check arguments:
    #
    if(verbose) cat("I'm checking the arguments...\n")
    
    if( !inherits(socket, "sockconn") ) stop(paste("argument socket = ", socket, "is not a socket connection."))
    if( !is.character(listname) ) stop(paste("argument listname = ", listname, "is not a character string."))
    if( !is.character(query) ) stop(paste("argument query = ", query, "is not a character string."))
    if( !is.logical(invisible) ) stop(paste("argument invisible = ", invisible, "should be TRUE or FALSE."))
    if( is.na(invisible) ) stop(paste("argument invisible = ", invisible, "should be TRUE or FALSE."))
    if(verbose) cat("... and everything is OK up to now.\n")
    
    #
    # Check the status of the socket connection:
    #
    if(verbose) cat("I'm checking the status of the socket connection...\n")
    #
    # Ca marche pas: summary.connection leve une exception et on ne va pas plus loin
    #
    if(!isOpen(socket)) stop(paste("socket:", socket, "is not opened."))
    if(!isOpen(socket, rw = "read")) stop(paste("socket:", socket, "can not read."))
    if(!isOpen(socket, rw = "write")) stop(paste("socket:", socket, "can not write."))
    if(verbose) cat("... and everything is OK up to now.\n")
    
    #
    # Send request to server:
    #
    if(verbose) cat("I'm sending query to server...\n")
    request <- paste("proc_requete&query=\"", query, "\"&name=\"", listname, "\"", sep = "")
    writeLines(request, socket, sep = "\n")
    res <- readLines(socket, n = 1)
    #
    # C'est ici qu'il y a un probleme de timeout. Suit un patch pas beau
    #
    
    if(verbose) cat(paste("... answer from server is:", res, "\n"))
    if(length(res) == 0){
        if(verbose) cat("... answer from server is empty!\n")    
        # Modif de Simon suite au mail de Augusto Ribas
        maxIter <- 10
        attemptNumber <- 0
        while((length(res) == 0) & (attemptNumber < maxIter)) {
            if(verbose) cat("... reading again (",attemptNumber,").\n")
            res <- readLines(socket, n = 1) 
            attemptNumber <- attemptNumber+1
        }    
        if(length(res) == 0){
            stop(paste("Unable to get any answer from socket after ",attemptNumber , " trials."))
        }
    }
    #
    # Analysing answer from server:
    #
    if(verbose) cat("I'm trying to analyse answer from server...\n")
    p <- parser.socket(res)
    if(p[1] != "0"){
        if(verbose) cat("... and I was able to detect an error.\n") 
        stop(paste("invalid request:", p[2], sep = ""))
    }
    
    if(verbose) cat("... and everything is OK up to now.\n")
    lrank <- p[2]
    if(verbose) cat(paste("... and the rank of the resulting list is:", lrank, ".\n"))
    nelem <- as.integer(p[3])
    if(verbose) cat(paste("... and there are", nelem, "elements in the list.\n"))
    typelist <- p[4]
    if(verbose) cat(paste("... and the elements in the list are of type", typelist, ".\n"))
    if(typelist == "SQ"){
        if(p[5] == "T"){
            if(verbose) cat("... and there are only parent sequences in the list.\n")
        } else {
            if(verbose) cat("... and there are *not* only parent sequences in the list.\n")
        }
    }
    
    #
    # Get full list informations: 
    #
    if( !virtual ){
        if(verbose) cat("I'm trying to get the infos about the elements of the list...\n")
        writeLines(paste("nexteltinlist&lrank=", lrank, "&first=1&count=", nelem, sep = ""), socket, sep = "\n")
        res <- readLines(socket, n = nelem, ok = FALSE)
        if( length(res) != nelem )
        {
            if(verbose) cat("... and I was able to detect an error...\n")
            stop(paste("only", length(res), "list elements were send by server out of", nelem, "expected.\n")) 
        } else {
            if(verbose) cat(paste("... and I have received", nelem, "lines as expected.\n"))
        }
        #
        # Extracting info
        #
        req <- vector(mode = "list", length = nelem)
        for(i in seq_len(nelem)){
            x <- parser.socket(res[i])
            req[[i]] <- as.SeqAcnucWeb(substr(x[2], 2, nchar(x[2]) - 1), x[3], x[6], x[7])
        }
        #
        # Virtual list case:
        #
    } else {
        if(verbose) cat("I'am *not* trying the infos about the elements of the list since virtual is TRUE.\n")
        req <- NA
    }
    #
    # Assign results in user workspace:
    #
    result <- list(call = match.call(), name = listname, nelem = nelem, typelist = typelist, 
                   req = req, socket = socket)
    class(result) <- c("qaw")
    assign(listname, result, envir = .seqinrEnv)
}

#
# Print method:
#

print.qaw <- function(x, ...)
{
    if(is.null(x$call$query)) x$call$query <- x$call$listname
    cat(x$nelem, x$type, "for", x$call$query)
}