# ------------------------------------------------------------------------------------------------------------------------- # # ----------------------------------------------------------------------------------------------------------------------- # # # # File Name : makeQry and runQry.r # # Last Updated Funclist : 06 Apr 2015, 3:02 PM (Monday) # # # # Author Name : Rick Saporta # # Author Email : RickSaporta@gmail.com # # Author URL : www.github.com/rsaporta # # # # Packages Called : NA # # Packages Used via NS : NA # # # # ----------------------------------------------------------------------------------------------------------------------- # # # # setQuery ( qry ) # # setQry ( qry ) # # makeQry ( tbl, colsToPull="*", colsToAgg=NULL, colsWithaggFunc=NULL, aggFunc=AggFunc # # , AggFunc=if (identical(colsToPull, "*")) "COUNT" else "SUM", whereIn=NULL # # , dateCol=NULL, minDate=NULL, maxDate=NULL, limit=NULL # # , schema={if (grepl("^fact_", tbl, ignore.case=TRUE)) "production"} # # , useProduction=FALSE, distinct=FALSE, prependCols.with.tbl=FALSE # # , lte.maxDate=c("<=", "<"), gte.minDate=c(">=", ">"), expandStar=(toupper(aggFunc) != "COUNT") # # , debug=FALSE, colsToSum="deprecated", autoMinDate=FALSE, key=NULL # # , nogroupby=toupper(aggFunc) %in% c("TRIM"), ... ) # # quoteOrWrapDate ( date ) # # runQry ( qry, connex=giveMeACon(verbose=FALSE), cluster=NULL, check.table.perms=FALSE # # , verbose.key=verbose, allow.large.groupby=FALSE, all.pfm=FALSE ) # # , to.dt=exists("as.data.table") # # , verbose.max.width=getOption("width", 80) * 0.8, verbose.max.lines=22L # # , verbose.shortCircuit=TRUE # # , verbose.indentAnd=grepl("\\bOR\\b", qry), verbose.indentOr=FALSE, emailWhenDone=FALSE # # , email.work.addr=emailWhenDone, emailStatus="Qry Complete", notifyWhenDone=FALSE # # , notifyStatus=emailStatus, dont.drop.anything=FALSE # # , dont.setkey=getOption("qry.dont.setkey", FALSE), key=".auto." # # , results.not.expected=FALSE, proceed.past.erros=FALSE, verbose=TRUE # # verboseQry ( qry, max.width=72L, max.lines=20L, spaces=3L, add.dots=TRUE # # , shortCircuit.ifendl.detected=nchar(qry) < 20000, indentAnd=FALSE, indentOr=FALSE # # , all=FALSE ) # # patOf ( word ) # # verboseQry_chop_line_1 ( qry, max.width ) # # # # # # # # ----------------------------------------------------------------------------------------------------------------------- # # ------------------------------------------------------------------------------------------------------------------------- # ## THESE SHOULD ALL YIELD THE SAME PAIR OF QUERIES ## Testing different combinations of aggFunc / colsToAgg / colsToPull being present if (FALSE) { whereList <- "transac_type_abbr = '' OR transac_type_abbr is NULL or transac_typeid IS NULL" colsToPull <- c("label_sc_group", "from_errors_table") makeQry("analytics", schema="bi", where=whereList, limit=NULL) makeQry("analytics", schema="bi", where=whereList, limit=NULL, aggFunc="count") makeQry("analytics", schema="bi", where=whereList, limit=NULL, colsToAgg=".rowcount") makeQry("analytics", schema="bi", where=whereList, limit=NULL, aggFunc="count", colsToAgg=".rowcount") makeQry("analytics", schema="bi", where=whereList, limit=NULL, aggFunc="count", colsToPull=colsToPull) makeQry("analytics", schema="bi", where=whereList, limit=NULL, colsToAgg=".rowcount", colsToPull=colsToPull) makeQry("analytics", schema="bi", where=whereList, limit=NULL, aggFunc="count", colsToAgg=".rowcount", colsToPull=colsToPull) ## THIS IS DIFFERENT (ie, with no aggFunc specified) makeQry("analytics", schema="bi", where=whereList, limit=NULL, colsToPull=colsToPull) makeQry(tbl="analytics", colsToAgg=NULL, colsToPull="*", aggFunc="Count", schema="bi", limit=NULL) ## ERROR makeQry(tbl="analytics", colsToAgg="*", aggFunc="Count", schema="bi", limit=NULL) makeQry(tbl="analytics", aggFunc=NULL, schema="bi", limit=10e6) ## ERROR makeQry(tbl="analytics", schema="bi", limit=10e6) } ### -=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~ ### unionQrys <- function(..., attributes.to.collect=c("key", "dateCol", "qryinfo")) { qrys <- list(...) if (length(qrys) == 1) return(qrys[[1]]) ## set names for lapply functions setattr(qrys, "names", sprintf("qry_%02i", seq_along(qrys))) selfname_(attributes.to.collect) attributes.new <- lapply(attributes.to.collect, function(a) { uniqueIfOne(lapply(qrys, attr, a, exact=TRUE)) }) sapply(attributes.new, length) attributes.new[["qryinfo"]]$knownunion <- TRUE ret <- pasteC(qrys, C="\n UNION \n") for (nm.a in names(attributes.new)) { setattr(ret, name=nm.a, value=attributes.new[[nm.a]]) } setQry(ret) return(ret) } ### -=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~ ### setQuery <- function(qry) { warning ("setQuery has been deprecated. use setQry() -- shortened versino to match runQry and makeQry") setQry(qry) } setQry <- function(qry) { if (any(!sapply(qry, is.character))) stop ("qry (or an element of it) is not a character") if (is.list(qry)) { for (i in qry) classAppend_(qry[[i]], "query") } else classAppend_(qry, "query") } ### -=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~ ### { makeQry <- function(tbl , colsToPull , colsToAgg , colsWithaggFunc=NULL , colsDontPull = NULL ## only used when colsToPull="*" && isTRUE(expandStar) , aggFunc , whereIn=NULL , dateCol=NULL , minDate=NULL , maxDate=NULL , groupby=NULL , orderby=NULL , limit=NULL , schema={if (grepl("^fact_", tbl, ignore.case=TRUE)) "production"} , wh=NULL , dbname=NULL , useProduction=FALSE , distinct=FALSE , prependCols.with.tbl=!is.null(names(tbl)) , lte.maxDate=c("<=", "<"), gte.minDate=c(">=", ">") , expandStar=TRUE ## Do NOT expandStar if counting , debug=FALSE , autoMinDate=FALSE , key=NULL , nogroupby=toupper(aggFunc) %in% c("TRIM") , conjunction=if ("conjunction" %in% names(whereIn)) whereIn[["conjunction"]] else "AND" , safety_all=FALSE , showWarnings=TRUE , join="Needs a full Join Sentence With 'ON'" , hyphenate_dates=TRUE , with=NULL , having="Needs a full clause, after HAVING keyword" , ... , AggFunc="DEPRECATED" , colsToSum="DEPRECATED" # , snowflake_inuse = getOption("snowflake_inuse", default=FALSE) , hint = ".RU in colsToAgg" ) { ### =========================================================== ### ### ----------------------------------------------------------- ### ### 2015-06-01 -- New Default Behavior ### ----------------------------------------------------------- ### ' The three key SELECT pieces are: (1) colsToPull (2) colsToAgg (3) aggFunc --- (2b) colsWithaggFunc ctp | cta | agg [ ] [ ] [ ] :: SELECT COUNT(*) AS ROWS FROM ... [x] [ ] [ ] :: SELECT ctp FROM ... [x] [ ] [x] :: ERROR if aggFunc is other than COUNT or NULL. If aggFunc is COUNT colsToAgg will be "*" [x] [x] [ ] :: SELECT ctp, aggFunc(cta) FROM ...; aggFunc <- if(isTRUE(colsToAgg == "*")) "COUNT" else "SUM" if cta == "*" In other words: ----------------- If all three are missing, the default query is SELECT COUNT(*) AS ROWS FROM ... If just aggFunc is missing, it will default to SUM, unless colsToAgg is "*" in which case, aggFunc will be COUNT aggFunc given without colsToAgg will now be an error If colsToPull is "*" this will simply be "SELECT * FROM ..." adding a new safety_all just to be safe this is intentional ' ### ----------------------------------------------------------- ### ### =========================================================== ### ## colsWithaggFunc :: columns that will not be Agg'd (like colsToPull) but will also be not-included in the GORUP BY clause. ## This is useful for situations where more than one aggFunc is needed. ## Example: ## colsWithaggFunc <- c(first_activity="min(activityperiodid)", last_activity="max(activityperiodid)") ## colsToAgg <- c(paidunits = "sales", revenue="gross") ## ## NOTE TO SELF: You could have colsToPull be a named list, like `whereIn`, and then ## use the names as arguments for "column AS name", but what use would this be? ## Really only useful for simple queries. ## ## ... : arguments added to whereIn, as a list. eg storeid=c(1, 7) ## lte, gte : Whether to use <= or <, > or >= ## RECOMMENDS `rangeDateBy` (in utilsRS) ## ## SPECIAL: colsToAgg can contain ".rowcount"; ## colsToPull can contain "sql1stOfMonth" ## colsToAgg can contain ".RU" ## NOTE 2: If any column needs quoting, the quotes need to put in mnaually. If we ## instead attempted to put in the quotes automatically, we risk quoting sql expressions ## ie "\"This Column\"" ## TODO 2015-01-24 ## All things related to count(*) in colsToAgg can be moved to colsWithaggFunc ## TODO 2015-01-24 ## sql1stOfMonth slows down queries tremendously. ## Check for when this can be handled in R in runQry() after the qres receieved ## First process 'with' since it allows for a missing 'tbl' if (!is.null(with)) { with %<>% copy %>% setnamesIfBlank_(., nms_new=paste0("unnamed__cte", seq_along(.))) if (missing(tbl) && length(with) == 1) { tbl <- names(with) schema <- NULL } } ## force args, to fail early if missing force(tbl); force(schema) ## DEPRECATED ARGUMENTS if (!missing(AggFunc)) stop ("'AggFunc' has been deprecated -- use 'aggFunc' instead (note the lowercase 'a')") if (!missing(colsToSum)) stop ("'colsToSum' has been deprecated -- use 'colsToAgg' instead\n") if ("colsToBring" %in% names(list(...))) warning ("colsToBring is not used in makeQry() -- it will be added as part of the where clause\nHINT: did you mean colsToPull ?", call.=FALSE) ## ---------------- ## ## JOIN CLAUSE NEEDS WORK ## remove the hint from join join_word <- " " if (identical(join, "Needs a full Join Sentence With 'ON'")) { join <- NULL } if (!is.null(join)) { is.char_of_length1(join, fail=TRUE) if (!grepl("\\bJOIN\\s", join, ignore.case=TRUE)) join_word <- " JOIN " # join %<>% sub("^\\*JOIN ", "", .) } ## ---------------- ## missing_ctp <- missing(colsToPull) missing_cta <- missing(colsToAgg) missing_agg <- missing(aggFunc) missing_cwa <- missing(colsWithaggFunc) # ## 2015-06-01 Unsure how to handle 'colsWithaggFunc' yet. For now, error to investigate # if (!missing_cwa && (missing_ctp && missing_cta && missing_agg)) # stop ("Dont know how to handle colsWithaggFunc when all other elements are missing. Investigate") ## If all three are missing, set to default "SELECT COUNT(*).." possibly warn user of new behavior if (missing_ctp && missing_cta && missing_agg) { msg <- "New behavior as of 2015-06-01:\n\tWhen all of colsToAgg, colsToPull and aggFunc are missing\n\tQuery will be 'SELECT COUNT(*) FROM ...'" if (showWarnings & missing_cwa) message(msg) colsToPull <- NULL colsToAgg <- c(rows = "*") aggFunc <- "COUNT" } ## if colsWithaggFunc is present but no other, then ignore all others if (!missing_cwa && length(colsWithaggFunc) && missing_cta && missing_agg) aggFunc <- NULL ## DISTINCT may not work correctly if using colsWithaggFunc; Warn the user if (!missing_cwa && isTRUE(distinct)) warning ("Setting distinct to TRUE and also including colsWithaggFunc may have strange behavior.\n\nHINT: set debugOn('makeQry_bottom') and look at how the query is constructed.") ## If all three are missing, set to default "SELECT COUNT(*).." possibly warn user of new behavior if (!missing_ctp && missing_cta && missing_agg) { ## 2015-09-25 removed: if (showWarnings) message("New behavior as of 2015-06-01:\n\tWhen only colsToPull is given and colsToAgg & aggFunc are missing\n\tQuery will be 'SELECT FROM ...'") colsToAgg <- NULL aggFunc <- NULL } ## Old calls to makeQry() used aggFunc="" to have it be blank. Set that to NULL if (!missing_agg && !is.null(aggFunc)) { if (!is.character(aggFunc)) stop ("aggFunc must be a character") ## "" is the same as NULL if (isTRUE(aggFunc == "")) aggFunc <- NULL ## Make uppercase for cleanliness aggFunc <- toupper(aggFunc) } ## missing colsToAgg and aggFunc being count makes colsToAgg = "*", and possibly colsToPull = NULL if (!missing(aggFunc) && isTRUE(aggFunc == "COUNT") && missing(colsToAgg)) { ## if colsToPull is also missing, set to NULL if (missing(colsToPull)) colsToPull <- NULL colsToAgg <- c(rows = "*") } ## Check for weird setups, such as colsToPull = "*" and colsToAgg misisng, but aggFunc given ## do not allow SELECT *, count(*) FROM ... unless set explicitly if (!missing(colsToPull) && isTRUE(unname(colsToPull) == "*") && !missing(aggFunc) && !is.null(aggFunc)) { if (missing(colsToAgg)) stop ("\nIf colsToPull is '*' and aggFunc is given, then colsToAgg must be given explicitly\n\nDETAILS: This is done to avoid user-error where the intention was, for example,\n'SELECT COUNT(*) ... ' but instead the result is 'SELECT *, COUNT(*) ...' ", call.=FALSE) else if (is.null(colsToAgg)) stop ("\ncolsToPull is '*' and aggFunc is given yet colsToAgg is NULL -- What is the desired outcome?\n\n Note that with the old makeQry() this would have resulted in 'SELECT aggFunc(*) ... ' but in the new makeQry() this results in aggFunc being ignored and instead selecting ALL from tbl.\n\nIf the intention is truly to not have an aggFunc, please set it to NULL", call.=FALSE) } ## aggFunc without colsToAgg is an error if (!missing(aggFunc) && !is.null(aggFunc) && aggFunc != "COUNT" && (missing(colsToAgg) || is.null(colsToAgg))) { if (aggFunc %in% c("MIN", "MAX") && !missing(dateCol)) colsToAgg <- dateCol else stop ("\nIf aggFunc is given explicitly (and is neither NULL nor 'COUNT'), then colsToAgg must be given explicitly as well.\nIt is currently missing from makeQry()", call.=FALSE) } ## aggFunc defaults to SUM unless colsToAgg is "*" in which case, aggFunc will be COUNT if (missing(aggFunc) && !missing(colsToAgg)) aggFunc <- if(isTRUE(unname(colsToAgg == "*"))) "COUNT" else "SUM" if (!missing(colsToPull) && any(grepl("^\\s\\*", colsToPull)) && !safety_all) stop ("New safety measure in place. must set safety_all=TRUE to allow \"SELECT * FROM ... \"") if (!missing(colsToPull) && !missing(aggFunc)) { if (isTRUE(aggFunc == "count") && isTRUE(any(trim(colsToPull) == "*"))) stop ("colsToPull is '*' and aggFunc is 'COUNT'\n\tWhat behavior is expected from makeQry() ?\n\tAre you sure you are getting that behavior?") } ## Add "rows" name to count(*) if (!missing(colsToAgg) && !missing(aggFunc)) { if (isTRUE(aggFunc=="COUNT") && identical(colsToAgg, "*")) names(colsToAgg) <- "rows" } tbl_is_subquery <- grepl("\\bSELECT\\b", tbl, ignore.case=TRUE) ## Wrap in parens if not already if (tbl_is_subquery && !is_wrapped_in_parens(tbl, trim_first=TRUE)) tbl %<>% sprintf("(%s)", .) if (tbl_is_subquery) expandStar <- FALSE if (!tbl_is_subquery) tbl %<>% tableNameClean() # browser(text="Dfdfdd") # old 2015-06-01 with new ctp/cta/agg setup : ## Allow for calls like makeQry(tbl=tbl, aggFunc="max", colsToAgg=dateCols) without # old 2015-06-01 with new ctp/cta/agg setup : ## resulting in SELECT *, max(col) FROM... # old 2015-06-01 with new ctp/cta/agg setup : if ( missing(colsToPull) && !missing(colsToAgg) && (is.null(aggFunc) || tolower(aggFunc) != "count") ) { # old 2015-06-01 with new ctp/cta/agg setup : message("colsToPull is missing and will be set to blank (not '*') since aggFunc is not count. -- set explicitly to override") # old 2015-06-01 with new ctp/cta/agg setup : colsToPull <- NULL # old 2015-06-01 with new ctp/cta/agg setup : } # old: if (!is.null(colsToAgg) && colsToAgg %in% c(".RU")) # old: colsToAgg <- getRevenueAndUnitsColsForTbl(tbl) if (!missing(colsToAgg) && ".RU" %in% colsToAgg) { wh.ru <- which(colsToAgg == ".RU")[[1L]] colsToAgg <- insert(colsToAgg[-wh.ru], getRevenueAndUnitsColsForTbl(tbl), at=wh.ru) } if (!missing(colsToPull) && ".RU" %in% colsToPull) { wh.ru <- which(colsToPull == ".RU")[[1L]] colsToPull <- insert(colsToPull[-wh.ru], getRevenueAndUnitsColsForTbl(tbl), at=wh.ru) } ## Naming aggFunc has no effect. ## User might try to, eg, aggFunc = c("total_rows" = "count") if (!is.null(names(aggFunc))) warning ("naming aggFunc has no effect") '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 'At some point we need to add in defaults' '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' if (missing(colsToAgg)) colsToAgg <- NULL if (missing(colsToPull)) colsToPull <- NULL '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' ## At least one of these must be none-null. Note, if only colsWithaggFunc is none-null then colsToPull should be used instead if (is.null(colsToPull) && (is.null(colsToAgg) && is.null(colsWithaggFunc))) stop ("Cannot have both colsToPull & colsToAgg be NULL") ## expand star if (isTRUE(colsToPull == "*") && isTRUE(expandStar)) { colsToPull <- qShowCols(tbl=tbl, schema=schema, sort=FALSE, wh=wh, dbname=dbname, snowflake_inuse=snowflake_inuse) if (!length(colsToPull)) { warning("Expanding '*' for colsToPull failed. Keeping as star\nHINT: Be sure that the tbl '", tbl, "' exists in schema '", schema, "'.") colsToPull <- "*" } else ## Drop colsDontPull colsToPull %<>% {.[tolower(.) %ni% tolower(colsDontPull)]} } ## allow for minDate/maxDate to be the string "NULL" so as to not mess up sprintf() in other functions if (is.character(minDate) && minDate == "NULL") minDate <- NULL if (is.character(maxDate) && maxDate == "NULL") maxDate <- NULL if (is.null(minDate) && missing(limit) && !(all(toupper(aggFunc) %in% c("MIN", "MAX"))) ) { message("Neither limit nor minDate have been set and the aggFunc is neither MIN() nor MAX().\nSetting limit to 1000.\nHINT: set limit=NULL explicitly to avoid") limit <- 1000 } lte.maxDate <- match.arg(lte.maxDate) gte.minDate <- match.arg(gte.minDate) # ------------------------------------- ## REMINDER TO SELF: I had originally put in something like ## if (missing(key)) key <- colsToPull ## BUT, do NOT do that. There are too many scenerios where ## they key would be something else (or, most likely, a speicific subset) ## and this would just be a waste of time. ## Also, there are too many situations where I would NOT want to auto ## set key (ie, too many colsToPull or too many rows) and it is too ## cumbersome to check all of those scenerios. ## colsToAgg & colsToPull should be mutually exlcusive if (length(shared <- intersect(colsToPull, c(colsToAgg, colsWithaggFunc)))) stop(warningCols("'colsToPull' and 'colsToAgg' should be mutually exclusive. They share the following elements:", shared), "\n HINT: Check colsToAgg and colsWithaggFunc") ## Check that tbl & schema have valid inputs if (!length(tbl)) { warning ("\n No valid values for `tbl` given. makeQry is returning NULL.") return(NULL) } if (length(tbl) != 1) { stop("\n Length of tbl is ", length(tbl), " but should be exactly 1.\n To create multiple queries, use `sapply` or `mapply`.") } if (length(schema) > 1) { stop("\n Length of schema is ", length(schema), " but should be exactly 1.\n To create multiple queries, use `sapply` or `mapply`.") } ## UPDATE 2015-02-20 -- elements in whereIn with no names will be added to the clause as a pure string # if (!is.null(whereIn) && !is.null(names(whereIn))) { # if (any(names(whereIn) == "")) # stop("\n If `whereIn` has names, the names cannot be blank (\"\") for any element of `whereIn`.") # } ## if aggFunc is count and colsToAgg is not explicit, make it count(*) if (isErr(aggFunc) && length(as.character(substitute(aggFunc))) == 1) aggFunc <- as.character(substitute(aggFunc)) if (length(aggFunc) != 1 && length(aggFunc) != length(colsToAgg)) { ## Allow for NULL aggFunc when colsWithaggFunc is NOT null ## The logic here is backwards -- only fail if the combination is NOT true. ## This is a round-about way to put an exception to the outer logic, instead of putting it in one clunky line if (! (!is.null(colsWithaggFunc) && is.null(aggFunc)) ) stop("aggFunc must be of length 1 or the same length as colsToAgg\n HINT: If no aggFunc is needed use 'colsWithaggFunc' instead of 'colsToAgg'") } # make sure tha the dateCol is specified if minDate or maxDate is not null if(is.null(dateCol) && !(is.null(c(minDate, maxDate)))) { stop("\n In `makeQry(.)`\n If `minDate` or `maxDate` is specified (which it is),\n then `dateCol` _must_ be specified as well.") } ## For staging_raw_itunes it is critical to pull the sales/return col if pulling revenue or units if (grepl("staging_raw_itunes", tbl) && !is.null(colsToPull) && colsToPull != "*") { if (any(getRevenueAndUnitsColsForTbl(tbl) %in% colsToAgg) && !("sale_return" %in% colsToPull)) warning (" ** sale_return ** is absent from colsToPull but Revenue/Units cols detected in colsToAgg \n Aggregation will be inaccurate", call.=FALSE) if (("customer_price" %in% c(colsToAgg, colsToPull)) && !("customer_currency" %in% colsToPull)) warning (" ** customer_currency ** is absent from colsToPull but customer_price is present. Keep in mind that there is customer_currency and royalty_currency", call.=FALSE) if (("royalty_price" %in% c(colsToAgg, colsToPull)) && !("royalty_currency" %in% colsToPull)) warning (" ** royalty_currency ** is absent from colsToPull but royalty_price is present. Keep in mind that there is customer_currency and royalty_currency", call.=FALSE) } if (!is.null(dateCol)) { if (!is.character(dateCol)) stop("\n `dateCol` must be a character.") if (length(dateCol) != 1) stop("\n `dateCol` must be either set to NULL or of length exactly one.") ## Convert min/maxdate to periods when dateCol is a periodid if (grepl("period_?id$", dateCol)) { if (!is.null(minDate) && grepl("^\\d{2,4}-\\d{2}-\\d{2}$", minDate)) minDate <- dateToperiodid(minDate) if (!is.null(maxDate) && grepl("^\\d{2,4}-\\d{2}-\\d{2}$", maxDate)) maxDate <- dateToperiodid(maxDate) } } ## Allow for colsToPull to contain 'sql1stOfMonth' which will be processed ## First check for the unquoted value and replace to quoted value if (!is.null(colsToPull)) { colsToPull[sapply(colsToPull, identical, sql1stOfMonth)] <- "sql1stOfMonth" if (any(wh.1st <- colsToPull == "sql1stOfMonth")) { if (is.null(dateCol)) stop ("'dateCol' cannot be NULL when 'colsToPull' contains the function sql1stOfMonth()") ## Name it nm.sql1st <- if (grepl("da(y|te)", dateCol)) sub("da(y|te)", "month", dateCol, ignore.case=TRUE) else "month" if (is.null(names(colsToPull))) names(colsToPull)[wh.1st] <- nm.sql1st else names(colsToPull)[wh.1st] [names(colsToPull)[wh.1st] == ""] <- nm.sql1st ## replace colsToPull[wh.1st] <- sql1stOfMonth(dateCol=dateCol, tbl=tbl, schema=schema, as=NULL, snowflake_inuse=snowflake_inuse) } } # If `use production` has been flagged to on, then schema should be NULL and tbl shouldnt already have produciton. as its value if (useProduction) { if (is.null(schema)) schema <- "production" else stop ("\n `useProduction` has been set to TRUE, but `schema` is not NULL.\n `schema` set to:\n ", pasteQ(schema, collapse=", "), "\n\n") if (grepl("^production.", tbl)) warning ("\n `useProduction` has been set to TRUE, but `tbl` already begins with 'production.' which will result in 'production.production.'") } # stbl <- schemaPaste(schema=schema, tbl=tbl) stbl <- dbschematbl(dbname=dbname, schema=schema, tbl=tbl) names(stbl) <- names(tbl) ntbl <- valueIfNull(names(stbl), stbl) quoteColNameAsNeeded <- function(nms) { inds <- !grepl("^[A-Za-z][A-Za-z0-9_]+$", nms) & (nms != "") if (any(inds)) nms[inds] <- sprintf('"%s"', nms[inds]) return(nms) } ## Clean up date, to either include in single quotes, or wrap in a parens, if it is a subquery quoteOrWrapDate <- function(date) { ## Depends on `hyphenate_dates` which is in makeQry ## Check if date is a periodid, in which case, do not quote it if (is.numeric(date) && !is.null(dateCol) && grepl("period_?id$", dateCol) && date > 0 && date < 1000) return(date) ## NULL, or empty string, or NOT (character or date), return as is if (is.null(date) || nchar(date) == 0 || !(is.character(date) || inherits(date, "Date"))) return(date) ## If it looks like a subquery, wrap in parens if needed, and return if (grepl("(SELECT|FROM)", date)) { if (grepl("^\\(.*\\)$", date)) return(date) return(sprintf("(%s)", date)) } ## LASTLY, convert the format to ideal sql format ## If it is a date, use format(), and return the output ## If it is a string, use grepl, and continue to final line if (inherits(date, "Date")) return(format(date, "'%Y-%m-%d'")) if (!hyphenate_dates) { if (is.character(date) && grepl("\\d{2,4}-\\d{2}-\\d{2}", date)) date <- gsub("\\-", "", date) } ## All else gets quoted return(sprintf("'%s'", as.character(date))) } browser(expr=debug || inDebugMode(c("Qry", "makeQry")), text=paste0("Browsing in `makeQry` with stbl=", stbl, " right before assigning `WHERE.CLAUSE`\n")) ## if minDate is set to Auto, the value will be a query that selects the latest date. ## Simultaneously create a flag that skips the quoting of minDate if (dontQuote.minDate <- autoMinDate || identical(tolower(minDate), "auto")) minDate <- sprintf("(SELECT max(%s) FROM %s)", dateCol, stbl) minDate <- quoteOrWrapDate(minDate) maxDate <- quoteOrWrapDate(maxDate) WHERE.CLAUSE <- makeWhereClause(whereIn=whereIn, dateCol=dateCol, minDate=minDate, maxDate=maxDate, lte.maxDate=lte.maxDate, gte.minDate=gte.minDate, tbl=stbl, prependCols.with.tbl=prependCols.with.tbl, conjunction=conjunction, ...) browser(expr=inDebugMode("makeQry_middle"), text="at middle of makeQry, after where before columns") ## ERROR CHECKING MY OWN CODE if (length(WHERE.CLAUSE) > 1) { ## We should not enter here. browser(expr=debug, text="in makeQry() about to crash. Inside clause if length(WHERE.CLAUSE) > 1 ... ") stop("WHERE.CLAUSE has a bug. It has length > 1.") } ## Convert back to NULL if it is blank if (WHERE.CLAUSE == "") WHERE.CLAUSE <- NULL ### ---- COLUMNS ------ ### ctp.complete <- colsToPull if (!is.null(colsToPull)) { ## Grab the names # OLD # nms.selectCols <- if (is.null(names(colsToPull))) colsToPull else names(colsToPull) nms.selectCols <- colNamesFromVector(colsToPull, starToCount=FALSE) ctp.sub <- substitute(colsToPull) knownRFuncs <- c("sql1stOfMonth", "sql_yr_wk") ## Search for "FUNC('COLUMN')" but not "FUNC('COLUMN1', 'COLUMN2')" ctp.is.knownFunc <- sapply(ctp.sub, function(x) is.call(x) && length(x) == 2 && as.character(x)[[1L]] %in% knownRFuncs) ## Drop any starting c() or other wrapper function if colsToPull is more than one element long is.c <- (length(ctp.sub) > 1 && ctp.sub[[1]] == "c") if (is.c) ctp.is.knownFunc <- ctp.is.knownFunc[-1L] ## Internal error if (any(ctp.is.knownFunc) && (length(ctp.is.knownFunc) != length(ctp.complete))) stop ("Investigate colsToPull and ctp.sub in makeQry() -- the lengths did not match up") ## Three things we need to do. ## 1. Apply stbl. prefix (if flagged) ## 2. apply name (if NULL) if (any(ctp.is.knownFunc)) { tmp.column.names <- sapply(seq(ctp.is.knownFunc), function(i) if (ctp.is.knownFunc[i]) as.character(ctp.sub[[i + is.c]])[[2]] else nms.selectCols[[i]]) if (prependCols.with.tbl) { if (grepl("\\.", tmp.column.names) || grepl("\\.", ctp.complete)) warning ("Not sure if prependCols.with.tbl will work correctly when ctp.is.knownFunc is TRUE and a column is already prepended with something.\nCheck line approx 615~620 in makeQry()") for (.col in tmp.column.names) ctp.complete <- paste0(ntbl, ".", .col) %>% sub(.col, repl=., ctp.complete) } ## If using sql1stOfMonth, change "day" or date" to "month" tmp.column.names[ctp.is.knownFunc] <- sub("da(y|te)", "month", tmp.column.names[ctp.is.knownFunc], ignore.case=TRUE) ## Only modify the names if the user did not set them explicitly, which we can tell by they not being the same as names(colsToPull) if (!identical(nms.selectCols, names(colsToPull))) nms.selectCols <- tmp.column.names ## No ctp.is.knownFunc } else { if (prependCols.with.tbl) ctp.complete <- ifelse(grepl("\\.", ctp.complete), ctp.complete, paste0(ntbl, ".", ctp.complete)) } ### Add possible ".rowcount" from colsToAgg ### It gets added to ctp.complete to avoid aggFunc being called on top of it; ie we don't want COUNT(COUNT(*)) if (".rowcount" %in% colsToAgg) { ## Grab the name. If It is NULL or blank, default to "rows" nm.rowcount <- names(colsToAgg)[colsToAgg == ".rowcount"][[1]] if (is.null(nm.rowcount) || nm.rowcount == "") nm.rowcount <- "rows" ## Add in the column and its name nms.selectCols <- c(nms.selectCols, nm.rowcount) ctp.complete <- c(ctp.complete, "COUNT(*)") ## clean up colsToAgg colsToAgg <- colsToAgg[colsToAgg != ".rowcount"] if (!length(colsToAgg)) colsToAgg <- NULL } ## Finish cleaning the names ## "SELECT *" should NOT be given a name nms.selectCols[nms.selectCols == "*"] <- "" ## avoid superfluous "AS" calls - ie, if not changing, dont add name nms.selectCols[nms.selectCols == ctp.complete] <- "" ## quote if needed nms.selectCols %<>% quoteColNameAsNeeded ## prepend the " AS " to those names that are not blank nms.selectCols[nms.selectCols != ""] <- sprintf(" AS %s", nms.selectCols[nms.selectCols != ""]) ## paste column and names together ctp.complete <- commaSep(paste0(ctp.complete, nms.selectCols)) } else if (".rowcount" %in% colsToAgg) { ## Grab the name. If It is NULL or blank, default to "rows" nm.rowcount <- names(colsToAgg)[colsToAgg == ".rowcount"][[1]] if (is.null(nm.rowcount) || nm.rowcount == "") nm.rowcount <- "rows" ctp.complete <- sprintf("COUNT(*) AS %s", quoteColNameAsNeeded(nm.rowcount)) ## clean up colsToAgg colsToAgg <- colsToAgg[colsToAgg != ".rowcount"] if (!length(colsToAgg)) colsToAgg <- NULL } ## if using colsToAgg OR colsWithaggFunc, add a trailing comma if (!is.null(ctp.complete)) { if (!is.null(colsToAgg) || !is.null(colsWithaggFunc)) ctp.complete %<>% paste0(",") } ## ---------------- ## ## cta.complete & cwaf.complete have almost identical calls ## except that cta.complete wraps the columns in 'aggFunc(.)' ## and cta.complete has its names slightly cleaned ## Checks if the cols* object is NULL, if yes, then so is the c*.complete object ## If it it is not NULL, sprintf, then commaSep ## cta.complete also has an extra check at the end to avoid 'sum(count(*))' ## ## TEMP: removed commaSep with identity and using the commaSep at the end { ## colsToAgg with Names nms.aggCols <- colNamesFromVector(colsToAgg) nms.aggCols <- ifelse(nms.aggCols=="*", aggFunc, nms.aggCols) nms.aggCols %<>% quoteColNameAsNeeded nms.aggFuncCols <- colNamesFromVector(colsWithaggFunc) nms.aggFuncCols %<>% quoteColNameAsNeeded cwaf.as_part <- ifelse(colsWithaggFunc == nms.aggFuncCols, "", sprintf(" AS %s", nms.aggFuncCols)) cwaf.complete <- {if (!is.null(colsWithaggFunc)) identity(sprintf("%s%s%s", if (prependCols.with.tbl) paste0(ntbl, ".") else "", colsWithaggFunc, cwaf.as_part))} # cwaf.complete <- {if (!is.null(colsWithaggFunc)) identity(sprintf("%s%s AS %s", if (prependCols.with.tbl) paste0(ntbl, ".") else "", colsWithaggFunc, nms.aggFuncCols))} cta.complete <- {if (!is.null(colsToAgg)) identity(sprintf("%s(%s%s) AS %s", aggFunc, if (prependCols.with.tbl) paste0(ntbl, ".") else "", colsToAgg, nms.aggCols))} ## avoid calls, such as sum(count(*)) if (!is.null(cta.complete)) cta.complete <- gsub(paste0(aggFunc, "\\(count\\("), "(count(", cta.complete) ;" ) ) \\) \\) for parser (ignore these)" ## clean up for aesthetics if (!is.null(ctp.complete)) cwaf.complete <- gsub("^(min|max)(\\()", "\\U\\1\\2", cwaf.complete, perl=TRUE); "\\) for parser" ## Combine the two, preserving NULL if they are both NULL cta.complete <- commaSep(c(cwaf.complete, cta.complete), preserveNULL=TRUE) } with.complete <- if (!is.null(with)) { with %>% sprintf("%s AS (\n%s\n)", names(.), .) %>% pasteC(., C="\n, ") %>% sprintf("WITH %s\n", .) } having.complete <- if (!missing(having) && !is.null(having) && having != "Needs a full clause, after HAVING keyword") { having %>% sprintf("HAVING %s", .) } if (!is.null(orderby)) { ._seq <- commaSep(seq(valueIfNull(colsToPull, 1))) if (is.numeric(orderby)) orderby <- commaSep(orderby) else if (is.logical(orderby) && !is.na(orderby) && orderby) orderby <- ._seq else if (is.character(orderby) && orderby == "colsToPull") orderby <- ._seq else if (is.character(orderby)) orderby %<>% colNamesFromVector } ## GROUP BY adding_group_by <- !is.null(groupby) || ## nogroupby will be logical(0) when we are using colsWithaggFunc and not colsToAgg; thus check for length 0 ((!nogroupby || !length(nogroupby)) && ((grepl("COUNT\\(.+\\)", ctp.complete, ignore.case=TRUE) && length(colsToPull)) || ((!is.null(colsToAgg) || !is.null(colsWithaggFunc)) && !is.null(colsToPull)))) groupby.complete <- if (adding_group_by) { if (!is.null(groupby)) paste0(" GROUP BY ", commaSep(groupby)) else paste0(" GROUP BY ", commaSep(seq(colsToPull))) } browser(expr=inDebugMode("makeQry_bottom"), text="at bottom of makeQry") ret <- { paste( if (!is.null(with.complete)) with.complete , "SELECT ", if (isTRUE(distinct)) "DISTINCT" , ctp.complete , cta.complete , "FROM ", stbl, if (!is.null(names(tbl))) paste0("AS ", names(tbl)) , if (!is.null(join)) paste0(join_word, join) , if (!is.null(WHERE.CLAUSE)) paste0(" WHERE ", WHERE.CLAUSE) , if (!is.null(groupby.complete)) groupby.complete , if (!is.null(having.complete)) having.complete , if (!is.null(orderby)) paste0(" ORDER BY ", pasteC(orderby, C=",")) , if (!is.null(limit)) paste0(" LIMIT ", format(limit, scientific=FALSE)) ) } ## Set attributes, mostly used in runQry if (!is.null(key)) { if (identical(key, "colsToPull")) key <- colsToPull attr(ret, "key") <- colNamesFromVector(key) } ## get the final dateCol which may have a different name than dateCol dateCol.final <- if (length(dateCol)) { if (length(colsToPull) && dateCol %in% colsToPull) colNamesFromVector(colsToPull[colsToPull == dateCol]) else colNamesFromVector(dateCol) } if (!is.null(dateCol)) { attr(ret, "dateCol") <- dateCol.final } ## Set attributes to the query, mostly for runQry and verboseQry classAppend_(ret, "query") setattr(ret, "qryinfo", list( tbl = tbl , schema = schema , colsToPull = colsToPull , colsToAgg = colsToAgg , aggFunc = aggFunc , whereIn = whereIn , WHERE.CLAUSE = WHERE.CLAUSE , dateCol = dateCol.final , dateCol.orig = dateCol , minDate = minDate , maxDate = maxDate , limit = limit , knownunion = FALSE )) return(ret) } ## // End of makeQry() } ## // for sublime text ### -=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~ ### get_colsToAgg_from_qry_attr <- function(qry, showWarnings=TRUE) { qryinfo <- attr(qry, "qryinfo") if (is.null(qryinfo)) { if (showWarnings) warning ("The qry did not have a 'qryinfo' attribute -- returning NULL") return(NULL) } ## It might be NULL. In which case, do not process if (!length(qryinfo$colsToAgg)) return(qryinfo$colsToAgg) colsToAgg <- colNamesFromVector(qryinfo$colsToAgg) ## Check for Agg Func if it is NULL if (toupper(qryinfo$aggFunc) == "COUNT") { if (is.null(colsToAgg) || colsToAgg == "") colsToAgg <- "rows" else if (colsToAgg == "*") colsToAgg <- "count" } return(colsToAgg) } runQry <- function(qry , connex=giveMeACon(verbose=getOption("verbose.DBcon", FALSE)) , cluster=NULL , check.table.perms=FALSE , to.dt=exists("as.data.table") , firstOfMonth=FALSE # , colsToAgg.firstOfMonth=colNamesFromVector(attr(qry, "qryinfo")$colsToAgg) , colsToAgg.firstOfMonth=get_colsToAgg_from_qry_attr(qry, showWarnings = FALSE) , emailWhenDone=FALSE , email.work.addr=emailWhenDone , emailStatus="Qry Complete" , notifyWhenDone=FALSE , notifyStatus=emailStatus , dont.drop.anything=TRUE , dont.setkey=getOption("qry.dont.setkey", FALSE) , key = ".auto." , results.not.expected=FALSE , proceed.past.erros=FALSE , allow.large.groupby=FALSE , all.pfm = getOption("db.all.pfm", TRUE) , wh=NULL , dbname = NULL # for now only used in sfQry , schema=NULL , verbose.max.width=getOption("width", 80) * 0.8 , verbose.max.lines=22L , verbose.shortCircuit=TRUE , verbose.indentAnd=grepl("\\bOR\\b", qry) , verbose.indentOr=FALSE , verbose=TRUE , verbose.key=verbose , verbose.firstOfMonth=TRUE , msg_sf = getOption("snowflake_msg_sf", TRUE) # Whether to indicate or not when calling snowflake , snowflake_inuse = getOption("snowflake_inuse", default=FALSE) , warehouse = NULL ) { ## ARGS: ## ## to.dt : if TRUE results are returned as a data.table ## results.not.expected : useuful for CREATE and INSERT statements, where no results expected ## ## 2015-11-28: FORCE snowflake for "Spotify Playlist Webscrape" if (!isTRUE(snowflake_inuse) && identical(getProjName(), "Spotify Playlist Webscrape")) { warning ("projName is 'Spotify Playlist Webscrape' but snowflake_inuse was not TRUE; setting it to TRUE") snowflake_inuse <- TRUE } if (missing(connex) && snowflake_inuse) { connex <- sfGetCon(wh=valueIfNull(wh, getSnowflakeWH()), dbname=valueIfNull(dbname, getSnowflakeDB()), schema=valueIfNull(schema, getSnowflakeSchema())) } if (!missing(cluster) && missing(snowflake_inuse) && missing(warehouse)) snowflake_inuse <- FALSE if (!all.pfm && .Pfm == "Darwin") stop ("To run on mac, set all.pfm=TRUE in runQry() or options('db.all.pfm' = TRUE)") if (missing(snowflake_inuse) && missing(cluster)) { if (inherits(connex, "RODBC") && !snowflake_inuse) { warning ("snowflake_inuse is FALSE, but connex is of type RODBC. Will call sfQry from runQry, but check your call stack", call.=FALSE) snowflake_inuse <- TRUE } } ## SNOWFLAKE -- Collect args and ship to comparable function if (snowflake_inuse) { setSnowflake(showWarnings=FALSE) verboseMsg(msg_sf, "calling sfQry() from runQry()", func="message", time=FALSE) ARGS <- collectArgs(except=c("snowflake_inuse")) return(do.call(sfQry, ARGS)) } ## undocumented. Allow for shorthand runQry(makeQry(...)) if (is.call(substitute(qry))) { q.f <- substitute(qry)[[1]] if (isErr(match.fun(q.f)) && as.character(q.f) %in% c(".m", "m")) { message("Using stop using .m() --- use makeQry instead") # q.list <- substitute(qry) # q.list[[1]] <- as.name("makeQry") # qry <- eval(q.list) } } if (!length(qry) || nchar(qry) == 0) { warning ("qry has no length", if (is.null(qry)) " -- it is NULL", "\nNothing to execute") return(qry) } ## Check for too many "GROUP BY"'s in the query, which may have happened by mistake. if (!allow.large.groupby) { pat.large.groupby <- sprintf("GROUP\\s+BY\\s+%s", pasteC(1:8, C=",\\s*")) if (any(sapply(qry, function(qy) grepl(pat.large.groupby, qy, ignore.case=TRUE)))) stop ("\nA large GROUP BY has been detected.\nThis is disallowed as a safety precaution to avoid hangs with accidentally large queries.\n\nHINT: use allow.large.groupby=TRUE") } ## if cluster is given, set DB using it cluster.bak <- getCluster() if (!is.null(cluster)) setDBall(cluster=cluster) using_redshift <- {getDBdriver() == "PostgreSQL"} ## force connection early force(connex) ## don't expect output for CREATE / INSERT / UPDATE / DROP / ALTER if (grepl("^\\s*(CREATE|INSERT|UPDATE|DROP|ALTER)\\b", qry, ignore.case=TRUE) && missing(results.not.expected)) results.not.expected <- TRUE toDrop <- c("ingestion_time", "filename", "filesize", "vendor_identifer", "vendor_offer_code") ## Get a new connection if needed if (isConExpired(connex)) { verboseMsg(verbose, "Current connex is expired, getting a new connection", time=FALSE) connex <- giveMeACon() } if (inVerboseMode.dbcon()) showDBsettings() if (missing(emailWhenDone) && !missing(emailStatus)) emailWhenDone <- TRUE if (is.list(qry) && length(qry)==1){ qry <- qry[[1]] ## TODO: Check that qry does not lose attribtues } ## Check for unquoted dates, which will give unintended results pat.unquoted_date <- "\\s\\d{2,4}-\\d{2}-\\d{2}\\s" if (grepl(pat.unquoted_date, qry) && !proceed.past.erros) { stop ("There appears to be an unquoted date values. This will result in unintended results. Appears near\n\n \".....", do.call(substr, as.list(c(qry, c(-40, 45)+regexpr(pat.unquoted_date, qry)[[1]][[1]]))), "...\"\n\n Hint: use proceed.past.erros=TRUE in runQry() to supress this error ") } if (verbose) { hr <- paste0(pasteR(verbose.max.width+3), "") #, "\n") tmp_cluster <- valueIfNull(cluster, getCluster()) cluster_statement <- ifelseNULL(tmp_cluster, yes="", no=sprintf("on cluster %02i", tmp_cluster) ) cat("\n\n\t Running query ", cluster_statement," [Began at ", timeStamp(frmt="%R %p") ,"] \n ", hr, "\n" , verboseQry(qry, max.lines=verbose.max.lines, max.width=verbose.max.width, shortCircuit.ifendl.detected=verbose.shortCircuit, indentAnd=verbose.indentAnd, indentOr=verbose.indentOr) , "\n ", hr, "\n\n", sep="") } ## CHECK if user can read from table. Will try to parse tbl from qry, and check if user has read rights. ## If rights are not allowed will throw an error. if (check.table.perms & using_redshift) { tbls <- extractTablenameFromQry(qry) perms <- qCanRead(tbl=tbls, connex=connex) if (any(!perms)) stop("\nWill not run query because it appears you do not have permission for the following tables:\n ", paste_l(tbls[!perms]), " \nYou can set 'check.table.perms=FALSE' to attempt to run anyway.") else verboseMsg(verbose, "Permission check OK: User has rights to read tables: ", paste_l(tbls), "\n") } ### ------ START EXECUTE ------ ### browser(expr=inDebugMode("QRY"), text="In runQry() right before execution.") ## dbGetQuery does not fail but instead gives warning. The error is printed to screen, but not an R error ## Thus fail on warnings, catch error, then put warn option back qry.noclass <- copy(qry) setattr(qry.noclass, "class", setdiff(class(qry), "query")) warn.bak <- getOption("warn") if (using_redshift) options(warn = 2) on.exit(options(warn = warn.bak), add=TRUE) ## EXECUTE tim <- system.time({ qres <- try(dbGetQuery(connex, qry.noclass), silent=TRUE) if (isErr(qres) && grepl("connection with pending rows, close resultSet before", qres)) { message ("There were dangling results left on the connection; they will be cleared") try(dbListResults(con)[[1]] %>% dbClearResult, silent=TRUE) ## TRY TO EXECUTE AGAIN qres <- try(dbGetQuery(connex, qry.noclass), silent=TRUE) } }) ## put back the bak ups before checking for error options(warn = warn.bak) ## 2015-08-05 -- There was an erorr in the code, where the wrong cluster was being used. ## However, that error occurred after the verbose output of "Running query on cluster xx" ## Therefore, another check is put here if (using_redshift && isTRUE(cluster != getCluster())) { warning ("\n\n\t!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n\t WRONG CLUSTER MAY HAVE BEEN USED\n\t requested cluster == ", cluster, "\n\t cluster current == ", getCluster(), "\n\t!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n") } ## Put back the original cluster, if it was changed if (!is.null(cluster) && !identical(cluster.bak, cluster)) try(setDBall(cluster=cluster.bak)) ## Check for error if (isErr(qres)) { ## dbGetException sometimes fail, hence wrap this in an error tryCatch({error <- dbGetException(connex)}, error=function(e) stop("\nTwo things failed at once! :) The Query failed to run and dbGetException failed when we tried to retrieve the error message. \n\nHere is the dbGetException error:\n", print(e), "\n\nHere is the query error: \n", print(qres), "\n--------------------------")) if (isErr(error)) {stop("runQry() failed. Output was: ", print(qres))} ## dbGetException will return "ok" if there was no error if (identical(error[["errorMsg"]], "ok")) { stop("runQry() failed, and it looks like an R error, not a DB error, possibly stemming from dbGetQuery() :\n\n\t", gsub("\\n", "\n\t", as.character(qres))) } else if (length(error$errorMsg) && nchar(error$errorMsg)) { msg <- sprintf("error Number %i and message: \n %s", error$errorNum, gsub("^\\s*ERROR:\\s*", "" , error$errorMsg)) stop("runQry() failed with ", msg) } else { stop("runQry() failed (error could not be parsed). Here is the original error:\n", capture.output(qres), "\n\nHere is the results from dbGetException(connex):\n", capture.output(error)) } } tim <- tim[["elapsed"]] ### ------ END EXECUTE ------ ### ## if qres has no dim, this is probably due to an error in the query, and the DBI driver will throw it's own error, which is caught and displayed. if (is.null(qres) || is.null(dim(qres)) || ncol(qres) == 0) { msg <- if (results.not.expected) "Query Execution Completed." else "No results were returned... exiting gracefully." ## only output the message if results were expected and verbose has not been explicitly set to FALSE if (!results.not.expected && verbose && !missing(verbose)) message(msg) ## If the results are NULL, return them invisibly. Otherwise, show what came back. if (is.null(qres)) return(invisible(qres)) return(qres) } verboseMsg(verbose, " Dim of results is ", gsub("\\[1\\]|\\\"|\\\"", "", capture.output(dim(qres))), time=FALSE) ## Only output the time IFF verbose is on AND the query returned results if (verbose && !(is.null(qres)) && !(tim < 0.001)) { cat(" Total time to execute query was ", fwSecs(tim), "\n\n", sep="") } else if (verbose) ## It should normally output as above. cat("** LOOKS LIKE SOMETHING WENT WRONG AT THE OUTPUT.** (tim is ",tim,") -- TIME AFTER RUN IS ", timeStamp(frmt="%R %p"), "\n", sep="") ## if the query took a long time, and not explicitly told not to email, send a message that it is done. if (tim > 5*60) { # greater than 5 minutes if (missing(notifyWhenDone)) notifyWhenDone <- TRUE if (missing(emailWhenDone)) { emailWhenDone <- TRUE if (missing(email.work.addr)) email.work.addr <- FALSE } } if (emailWhenDone) EmailStatusUpdate(status=emailStatus, msg=paste0("Took ", fwSecs(tim), " for:\n", verboseQry(qry, max.lines=100L, max.width=110L, shortCircuit.ifendl.detected=FALSE, indentAnd=verbose.indentAnd, indentOr=verbose.indentOr))) if (notifyWhenDone) notify(message=notifyStatus) if (to.dt) { qres <- setDT(qres) ## Only drop the unneeded columns, if flagged to do so AND we were querying 'SELECT * FROM ...' if (!dont.drop.anything && grepl("^\\s*SELECT\\s+\\*\\s+FROM", qry, ignore.case=TRUE)) suppressWarnings(qres[, c(toDrop) := NULL]) browser(expr=inDebugMode("firstOfMonth"), text="in runQry() right before aggregateMonthly()") if (firstOfMonth) { aggFunc <- tolower(attr(qry, "qryinfo")$aggFunc) if (is.character(aggFunc) && identical(substr(tolower(aggFunc), 1, 4), "mean")) warning ("When aggFunc is 'mean'-like, aggregation may be off") try(qres <- aggregateMonthly(qres, dateCol=attr(qry, "dateCol", exact=TRUE), aggFunc=aggFunc, colsToAgg=colsToAgg.firstOfMonth, failOnMissingDateCol=FALSE, verbose=verbose.firstOfMonth)) } ## SET KEY ## Try using the key attribute if present if (missing(verbose.key) && nrow(qres) < 100) verbose.key <- FALSE if (!is.null(attr(qry, "key")) && identical(key, ".auto.")) { key.cols <- attr(qry, "key") if (any(key.cols %ni% names(qres))) warning ("The qry has a 'key' attribute, but some of the colnames in that attribute are *NOT* columns in the results.\nNamely: ", pasteQand(setdiff(key.cols, names(qres)))) else if (!is.null(key.cols)) setkeyIfNot(qres, key.cols, verbose=verbose.key) ## If no attribute, try to auto set. ## If the results are relatively small, and there is no "ORDER BY" clause, order by date } else if (!dont.setkey && nrow(qres) < 1e5 && !grepl("order by", qry, ignore.case=TRUE)) { ## Second check the qry for a dateCol attribute if (!is.null(key) && key != ".auto.") { key <- intersect(key, names(qres)) if (!length(key)) warning ("None of the values in 'key' were in qres from runQry") else setkeyIfNot(qres, key, verbose=verbose.key) } else if (length(dateCol <- tolower(attr(qry, "dateCol"))) && dateCol %in% names(qres)) { setkeyIfNot(qres, dateCol, verbose=verbose.key) } else if (length(key.cols <- grep("date", names(qres), value=TRUE))) setkeyIfNot(qres, key.cols, verbose=verbose.key) } } else if (!dont.drop.anything && !missing(dont.drop.anything)) { warning("Dropping columns will only be executed if converting results to data.table. Please drop columns manually (though it is more efficient to set 'todt=TRUE' instead)\n") } browser(expr=inDebugMode("qryinfo"), text="in runQry() right before setting qryinfo") ## add queryinfo (query attributes) from makeQry caught.adding_info <- try({ qryinfo <- attr(qry, "qryinfo") whereInfo <- qryinfo$WHERE.CLAUSE if (!is.null(whereInfo) && nchar(whereInfo)) { whereInfo <- paste("WHERE", whereInfo) whereInfo <- paste0("\n", verboseQry(whereInfo)) # whereInfo <- chopAfterWord(whereInfo, c("AND", "OR"), ignore.case=FALSE, max=80, after=TRUE) # whereInfo <- pasteC(padTo(paste0(c("\nWHERE ", rep(" ", length(whereInfo)-1)), whereInfo)), C="\n") } tbl.nm <- { if (is.null(qryinfo)) removeNA(extractWordFollowing(qry, "from", onlyOne=TRUE, showWarnings=FALSE), "[unknown table]") else schemaPaste(schema=qryinfo$schema, qryinfo$tbl) } ## setInfo for the qres. check if a cluster is being used, and if so, add that to the info tmp_cluster <- valueIfNull(cluster, getCluster()) cluster_statement <- ifelseNULL(tmp_cluster, yes="", no=sprintf("|| cluster %02i ", tmp_cluster) ) setInfo(qres, sprintf("Raw DB Pull || %s %s|| %s%s", now(), valueIfNull(cluster, getCluster()), tbl.nm, whereInfo) ) setattr(qres, "qry", qry) setattr(qres, "time.data_pulled", sprintf("data pulled at %s", now())) setattr(qres, "qryinfo", qryinfo) ## set dateCol attribute dateCol <- getDateCol(qry, showWarnings=FALSE) if (!is.null(dateCol)) setDateCol(qres, dateCol, showWarnings=any(sapply(qres, is.date_or_time))) }, silent=FALSE) if (isErr(caught.adding_info)) warning ("Attempting to add the qryinfo to the qres DT failed.\n This error has been caught and the qres has been returned without other issue") ## RETURN return(qres) } ### -=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~ ### verboseQry <- function(qry, max.width=72L, max.lines=20L, spaces=3L , add.dots=TRUE , shortCircuit.ifendl.detected=nchar(qry) < 20000 , indentAnd=FALSE , indentOr=FALSE , all=FALSE) { # max lines, not implemented ## TODO : make sure `limit` gets shown at the end if (length(qry)>1) stop("qry must be of length 1") if (!length(qry)) { warning("Invalid query (zero length) sent to `verboseQry`\n") return(invisible(NULL)) } ## Remove any starting blank lines qry <- gsub("^\n+", "", qry) ## Check for all-whitespace if (all(grepl("^\\s*$", qry))) { warning ("The qry sent to verboseQry() is blank") return(qry) } ## Check if is Insert Query, which will be treated differently isInsertQry <- (grepl("^\\s*INSERT", qry[qry != ""][[1]])) ## Check if is SELECT Qury (or subquery) isSelectQry <- (grepl("^\\s*SELECT\\b", qry[qry != ""][[1]])) pat.union <- "\\s*UNION\\s*(\\b*(\\()?SELECT)" ;"\\) parser" ## for parser rep.union <- "@@UNION@@" isUnionQry <- grepl(pat.union, qry, ignore.case=TRUE) sp <- pasteR(" ", spaces) sp <- paste0("\n", sp) ## synonym p <- paste0 # If line breaks are in the qry, don't mess with it, just pad it if (grepl("\\n", qry) && shortCircuit.ifendl.detected && !isInsertQry && !isUnionQry) return(p(sp, gsub("\\n", sp, qry))) patOf <- function(word) p("(^|\\s)", word ,"\\b\\s*") ## DEBUGGING browser(expr=inDebugMode("verboseQry"), text="verboseQry, after some line splits but before changing qry.") ## TODO 20150120: ## Add a Linebreak and **[indent]** ## Check if preceeded by another value ## SELECT: Preceded by "(", "SELECT", "WHERE", "FROM" ## FROM : Preceded by "WHERE", "FROM" ## WHERE : Preceded by "WHERE" if (isUnionQry) { qry <- gsub(pat.union, paste0(rep.union, "\\1"), qry, ignore.case=TRUE) return(pasteC(lapply(strsplit(qry, rep.union)[[1]], verboseQry), C = "\n UNION\n\n", sep="")) } qry <- .verboseQry_chop_line_1(qry) ## Do not do these modifications when qry is an insert query without a select clause ## Otherwise, random "AND" and "OR" etc will be picked up from the insert data by accident if (!(isInsertQry && !isSelectQry)) { qry <- gsub(patOf("select"), p(sp, "SELECT "), qry, ignore.case=TRUE) qry <- gsub(patOf("where"), p(sp, "WHERE "), qry, ignore.case=TRUE) qry <- gsub(patOf("from"), p(sp, "FROM "), qry, ignore.case=TRUE) qry <- gsub(patOf("and"), p(sp, " AND "), qry, ignore.case=TRUE) # qry <- gsub(patOf("or"), p(sp, " OR "), qry, ignore.case=TRUE) qry <- gsub(patOf("limit"), p(sp, "LIMIT "), qry, ignore.case=TRUE) ## Order By / Group By qry <- gsub(patOf("((order|group)( by)?\\s+)"), p(sp, "\\U\\2 "), qry, ignore.case=TRUE, perl=TRUE) ## Joins qry <- gsub(patOf("(left|right|outer|inner|full outer)?( join)"), p(sp, "\\U\\2\\3 "), qry, ignore.case=TRUE, perl=TRUE) ## Some specific select items to split on, such if they are not the first item qry <- gsub("([A-Za-z]), ((cast|count|sum|datediff|min|max)\\()", p("\\1", sp, " , \\U\\2"), qry, ignore.case=TRUE, perl=TRUE) ")" ## for parsers ## , ( OFTEN APPEARS BEFORE AGG FUNCTIONS qry <- gsub(", \\(", p(sp, " , ("), qry, ignore.case=TRUE) ## fix "extract .. from ... " qry <- gsub(p("(extract\\s*\\('[A-Za-z]+'\\s*)" , sp, "FROM ", "([A-Za-z\\._\"]+\\s*\\))"), "\\1 FROM \\2", qry, ignore.case=TRUE) } ## VALUES, specific to insert queries: qry <- gsub(patOf("values"), p(ifelse(isInsertQry, "\n", sp), "VALUES\n"), qry, ignore.case=TRUE) ## Split up the query by line breaks qry <- strsplit(qry, "\n")[[1]] ## drop any intial blank lines qry <- qry[min(which(qry != "")):length(qry)] ## Insert Statements get chopped differently if (isInsertQry) { qry <- qry[qry != ""] ## if the first line contains the columns, split those out into their own line qry[[1]] <- sub("(INSERT INTO .+?) *\\(", "\\1[##CUT_HERE##] (", qry[[1]]) qry <- c(strsplit(qry[[1]], "\\[##CUT_HERE##\\]")[[1]], " ", qry[2:length(qry)]) ## which line has values line.vals.start <- grep("\\bVALUES$", qry) line.vals <- grep("\\(.+\\)", qry) ## the "INSERT INTO .. " line will also have parens. We dont want that line.vals <- line.vals[line.vals > line.vals.start] # we want to keep at most 12 values lines. Also, make sure all line.vals are sequential if (length(line.vals) > 20 && all(diff(line.vals)==1) ) { qry[line.vals[[7]]] <- " ...... " qry <- qry[-line.vals[8:(length(line.vals)-6)]] ## the remaining line vals are at line.vals[[1]], plus the next 12, except for the ellipses line.vals <- line.vals[[1]] - 1 + c(1:6, 8:21) # the (-1) because we are adding one. Easier to index. line.vals <- line.vals[line.vals <= length(qry)] } ## increase the max.width if not explicitly set if (missing(max.width)) max.width <- max(max.width, getOption("width")) ## Indent the vlaues forward two spaces qry[line.vals] <- paste0(" ", qry[line.vals]) ## if max.width is longer than, say 50, take out the middle of the values (instead of the end as will happen by default) if (max.width > 50) { toolong <- which(nchar(qry) > max.width) toolong <- intersect(toolong, c(2, line.vals)) ## adding in the columns at line 2 nc.toolong <- nchar(qry[toolong]) qry[toolong] <- paste0( substr(qry[toolong], 1, max.width-50) , " .. " , substr(qry[toolong], nc.toolong-44, nc.toolong ) ) } ## remove any dual-blank lines blank.lines <- which(qry=="") if (any(wh.blank <- which(diffNA(blank.lines) == 1))) qry <- qry[-blank.lines[wh.blank]] } maxbrks <- as.integer(round(max.lines / 5) - 1) qry <- sapply(qry, chopLine, maxNumberOfBreaks=maxbrks, dotsBeyondMax=add.dots, padToSecondSpace=TRUE, padding=10L, width=max.width, flex=0.9*max.width, USE.NAMES=FALSE) qry <- unlist(strsplit(qry, "\n"), use.names=FALSE) # FASTER THAN: strsplit(paste(qry, collapse="\n"), "\n")[[1]] # drop blank lines if (length(qry) > max.lines && !isInsertQry) qry <- qry[qry!=""] # combine lesser lines if (length(qry) > max.lines) { ## for insertquery, stop at line 5, not line 2 for (i in length(qry):(2+2.5*(isInsertQry && qry[3]==" "))) if (nchar(qry[[i-1]]) + nchar(gsub("^\\s+", " ", qry[[i]])) < max.width) { qry[[i-1]] <- paste(qry[[i-1]], gsub("^\\s+", " ", qry[[i]])) qry[[i]] <- "" } qry <- qry[qry!=""] } if (indentAnd) qry <- gsub("^(\\s*)(AND) ", "\\1 \\2 ", qry, perl=TRUE) if (indentOr) qry <- gsub("^(\\s*)(OR) ", "\\1 \\2 ", qry, perl=TRUE) ## CROP, UNLESS FLAGGED NOT-TO if (!all) { ## only modify if not isInsertQry (or is more than 3x as long) if ((length(qry) > max.lines && !isInsertQry) || length(qry) > 3*max.lines) { if (!max.lines > 3) qry <- c(qry[1:max.lines], paste(pasteR(" ", spaces), " .....")) else ## Show last three lines as well qry <- c(qry[1:(max.lines-3)], paste(pasteR(" ", spaces), "....."), qry[(length(qry)+(-2:0))]) } } return(paste(qry, collapse="\n")) } ## shorthand .m <- makeQry ## Chop line 1 .verboseQry_chop_line_1 <- function(qry, max.width) { if (missing(max.width)) { if (exists("max.width", env=parent.frame())) max.width <- get("max.width", env=parent.frame()) else max.width <- 100 } pat.select <- "(^\\s*SELECT\\s*)\\s" if (grepl(pat.select, qry[[1]], ignore.case=TRUE) && grepl("\\sFROM\\s", qry[[1]], ignore.case=TRUE)) { first_from <- regexpr("from", qry[[1]], ignore.case=TRUE) lineone <- substr(qry[[1]], 1, first_from-1) rest_of_the_lines <- substr(qry[[1]], first_from, nchar(qry[[1]])) select <- gsub(paste0(pat.select, ".*"), "\\1", lineone, ignore.case=TRUE) lineone <- gsub(pat.select, "", lineone, ignore.case=TRUE) # select # lineone nc.select <- nchar(select) ret.select <- chopAfterWord(lineone, ",", maxLength = max.width - nc.select, after=FALSE) L.rs <- length(ret.select) if (L.rs > 1) ret.select[2:L.rs] <- paste0(pasteR(" ", nc.select), ret.select[2:L.rs]) ret.select[1] <- paste(select, ret.select[1]) qry[[1]] <- pasteC(c(ret.select, rest_of_the_lines), C="\n") } return(qry) } ### -=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~ ### ## TEST CASES if (FALSE) { tbl <- 'taaaaabbllle' colsToPull <- structure(c("source", "source_uri is NULL OR source_uri = ''", "download_date"), .Names = c("", "source_uri_is_blank", "")) Q0 <- makeQry(colsToPull=colsToPull, dateCol="download_date", tbl=tbl, schema="production", distinct=TRUE, limit=NULL) Q1 <- makeQry(colsToPull=colsToPull, dateCol="download_date", aggFunc=c("count"), tbl=tbl, schema="production", distinct=TRUE, limit=NULL) Q1b <- makeQry(colsToPull=colsToPull, dateCol="download_date", aggFunc=c("count"), colsToAgg=NULL, tbl=tbl, schema="production", distinct=TRUE, limit=NULL) Q2 <- makeQry(colsToPull=colsToPull, dateCol="download_date", aggFunc=c(test="count"), colsToAgg="*", tbl=tbl, schema="production", distinct=TRUE, limit=NULL) Q3 <- makeQry(colsToPull=colsToPull, dateCol="download_date", aggFunc=c("count"), colsToAgg="*", tbl=tbl, schema="production", distinct=TRUE, limit=NULL) Q4 <- makeQry(colsToPull=colsToPull, dateCol="download_date", aggFunc=c("count"), colsToAgg=c(other = "*"), tbl=tbl, schema="production", distinct=TRUE, limit=NULL) Q5 <- makeQry(colsToPull=colsToPull, dateCol="download_date", colsToAgg="*", tbl=tbl, schema="production", distinct=TRUE, limit=NULL) ## ERROR if (FALSE) makeQry(colsToPull=colsToPull, dateCol="download_date", aggFunc=c("count"), colsToAgg="", tbl=tbl, schema="production", distinct=TRUE, limit=NULL) Q0 %>% {sprintf("\n(%s) %s -- %s", "Q0", ., valueIfNull(attr(., "qryinfo")$colsToAgg, "''"))} %>% cat(fill = TRUE) Q1 %>% {sprintf("\n(%s) %s -- %s", "Q1", ., valueIfNull(attr(., "qryinfo")$colsToAgg, "''"))} %>% cat(fill = TRUE) Q1b %>% {sprintf("\n(%s) %s -- %s", "Q1b", ., valueIfNull(attr(., "qryinfo")$colsToAgg, "''"))} %>% cat(fill = TRUE) Q2 %>% {sprintf("\n(%s) %s -- %s", "Q2", ., valueIfNull(attr(., "qryinfo")$colsToAgg, "''"))} %>% cat(fill = TRUE) Q3 %>% {sprintf("\n(%s) %s -- %s", "Q3", ., valueIfNull(attr(., "qryinfo")$colsToAgg, "''"))} %>% cat(fill = TRUE) Q4 %>% {sprintf("\n(%s) %s -- %s", "Q4", ., valueIfNull(attr(., "qryinfo")$colsToAgg, "''"))} %>% cat(fill = TRUE) Q5 %>% {sprintf("\n(%s) %s -- %s", "Q5", ., valueIfNull(attr(., "qryinfo")$colsToAgg, "''"))} %>% cat(fill = TRUE) } ### -=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~=~ ###