R/modifylist.R

In seqinr: Biological Sequences Retrieval and Analysis

# ==>  modifylist&lrank=..&type=[length|date|scan]&operation=".."
# <== code=0&lrank=..&name=".."&count=..{&processed=..}
# code=3   if impossible to create a new list
# code=2   if incorrect syntax, possibly in operation
# lrank:   (input) rank of bitlist to be modified
#         (output) rank of created bitlist containing result of modify operation
# type:    indicates what kind of modification is to be performed.
# operation: for length, as in  "> 10000"    or    "< 500"
#         for date, as in   "> 1/jul/2001"   or   "< 30/AUG/98"
#         for scan, specify the string to be searched for
#                   prep_getannots must be used before using modifylist&type=scan
#                   the client can interrupt the scan operation by sending the escape character on the socket
# name: name of created bitlist
# count: number of elements in created bitlist
# processed: only for scan operation, number of list elements scanned until completion or interruption


modifylist <- function(listname, modlistname = listname,
                       operation, type = c("length", "date", "scan"),
                       socket = autosocket(), virtual = FALSE,
                       verbose = FALSE){
    #
    # Default is by length:
    #
    type <- type[1]
    if(!(type %in% c("length", "date", "scan"))) stop("Wrong type agument")
    #
    # Build request:
    #
    request <- paste("modifylist&lrank=", glr(listname, verbose = verbose), "&type=", type, "&operation=\"", operation, "\"", sep = "")
    if(verbose) cat("-->", request, "<--\n")
    writeLines(request, socket, sep = "\n")
    answerFromServer <- readLines(socket, n = 1)
    #
    # Check that there is an answer from server:
    #
    if(length(answerFromServer) == 0){
        warning("Empty answer from server")
        return(NA)
    }
    #
    # Build result:
    #
    if(verbose) cat("Answer from server:", answerFromServer, "\n")
    resitem <- parser.socket(answerFromServer)
    if(resitem[1] != "0"){
        stop(paste("error code returned by server :", resitem[1]))
    }
    mlrank <- as.numeric(resitem[2])
    mlcount <- as.numeric(resitem[4])
    #
    # Set list name on server:
    #
    suppressWarnings(ressetlistname <- setlistname(lrank = mlrank, name = modlistname, socket = socket))
    if(is.na(ressetlistname)) stop("Empty answer from server in setlistname")
    if(ressetlistname == "4") stop("No list of rank mlrank exists")
    #
    # Get full list informations:
    #
    if( !virtual ){
        writeLines(paste("nexteltinlist&lrank=", mlrank, "&first=1&count=", mlcount, sep = ""), socket, sep = "\n")
        res <- readLines(socket, n = mlcount, ok = FALSE)
        if( length(res) != mlcount )
        {
            stop(paste("only", length(res), "list elements were send by server out of", mlcount, "expected.\n")) 
        }
        #
        # Extracting info
        #
        req <- vector(mode = "list", length = mlcount)
        for(i in seq_len(mlcount)){
            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 {
        req <- NA
    }
    #
    # Assign results in workspace:
    #    use getliststate for typelist when avail
    #
    result <- list(call = match.call(), name = modlistname, nelem = mlcount, typelist = NA, 
                   req = req, socket = socket)
    class(result) <- c("qaw")
    assign(modlistname, result, envir = .seqinrEnv)
}