R/method-delete_.R

In greenplum-db/GreenplumR: A Fast, Easy-to-Use Tool for Manipulating Tables in Databases

## -----------------------------------------------------------------------
## delete db.data.frame objects
## -----------------------------------------------------------------------

setGeneric (
    "delete",
    def = function (x, ...) {
        rst <- standardGeneric("delete")
        res <- rst$res
        conn.id <- rst$conn.id
        if (res && (!is.character(x) ||
                    is.character(x) &&
                    .strip(deparse(substitute(x)), "\"") != x)) {
            envir <- parent.env(parent.env(parent.env(parent.env(
                parent.env(as.environment(-1))))))

            warn.r <- getOption("warn")
            options(warn = -1)
            rm(list=deparse(substitute(x)), envir=envir)
            options(warn = warn.r)
        }
        res
    },
    signature = "x")

## -----------------------------------------------------------------------

setMethod (
    "delete",
    signature (x = "db.data.frame"),
    def = function (x, cascade = FALSE) {
        ## .db.removeTable(content(x), conn.id(x))
        if (x@.table.type == "LOCAL TEMPORARY")
            tbl <- gsub("^\\\"[^\"]*\\\"\\.", "", content(x))
        else
            tbl <- content(x)
        s <- delete(tbl, conn.id(x), x@.table.type == "LOCAL TEMPORARY",
                    cascade)
        list(res=s, conn.id=conn.id(x))
    })

## -----------------------------------------------------------------------

setMethod (
    "delete",
    signature (x = "db.Rquery"),
    def = function (x) {
        list(res=TRUE, conn.id=conn.id(x))
    })

## -----------------------------------------------------------------------

setMethod (
    "delete",
    signature (x = "character"),
    def = function (x, conn.id = 1, is.temp = FALSE, cascade = FALSE) {
        x <- paste("\"", .strip(strsplit(x, "\\.")[[1]], "\""), "\"",
                   collapse = ".", sep = "")
        if (is.temp)
            x <- gsub("^\\\"[^\"]*\\\"\\.", "", x)
        origin.x <- x
        warn.r <- getOption("warn")
        options(warn = -1)

        exists <- db.existsObject(x, conn.id, is.temp)
        if (length(exists) == 2)
            if (! exists[[1]]) {
                options(warn = warn.r) # reset R warning level
                return (list(res=FALSE, conn.id=conn.id))
            } else
                x <- exists[[2]]
        else
            if (! exists) {
                options(warn = warn.r) # reset R warning level
                return (list(res=FALSE, conn.id=conn.id))
            } else {
                if (length(x) == 1) x <- strsplit(x, "\\.")[[1]]
                if (length(x) != 2) {
                    schemas <- arraydb.to.arrayr(
                        .db.getQuery("select current_schemas(True)", conn.id),
                        type = "character")
                    table_schema <- character(0)
                    for (schema in schemas)
                        if (.db.existsTable(c(schema, x), conn.id))
                            table_schema <- c(table_schema, schema)
                    if (identical(table_schema, character(0))) {
                        options(warn = warn.r) # reset R warning level
                        return (list(res=FALSE, conn.id=conn.id))
                    }
                    schema.str <- strsplit(table_schema, "_")
                    for (i in seq_len(length(schema.str))) {
                        str <- schema.str[[i]]
                        if (str[1] != "pg" || str[2] != "temp") {
                            x <- c(table_schema[i], x)
                            break
                        }
                    }
                }
                if (length(x) == 1) {
                    options(warn = warn.r) # reset R warning level
                    return (list(res=FALSE, conn.id=conn.id))
                }
            }
        ## .db.removeTable(x, conn.id)
        table <- paste("\"", .strip(x[1], "\""),
                       "\".\"", .strip(x[2], "\""), "\"", sep = "")
        if (cascade) cascade.str <- " cascade"
        else cascade.str <- ""

        if (.is.view(x, conn.id))
            type.str <- "view "
        else
            type.str <- "table "
        sql <- paste("drop ", type.str, table, cascade.str, sep = "")
        success  <- NULL   # we add this solely to appease R CMD check
        res <- tryCatch(.db.getQuery(sql, conn.id),
                        error = function(e) { success <<- FALSE })
        exists <- db.existsObject(origin.x, conn.id, is.temp)

        options(warn = warn.r) # reset R warning level
        if (length(exists) == 2)
            if (! exists[[1]])
                return (list(res=TRUE, conn.id=conn.id))
            else
                return (list(res=FALSE, conn.id=conn.id))
        else
            if (! exists)
                return (list(res=TRUE, conn.id=conn.id))
            else
                return (list(res=FALSE, conn.id=conn.id))
    })