Binary files /tmp/tmpsncm5Q/ewAZ1sFT47/r-bioc-rtracklayer-1.42.1/build/vignette.rds and /tmp/tmpsncm5Q/n52q1STSpy/r-bioc-rtracklayer-1.44.2/build/vignette.rds differ diff -Nru r-bioc-rtracklayer-1.42.1/debian/changelog r-bioc-rtracklayer-1.44.2/debian/changelog --- r-bioc-rtracklayer-1.42.1/debian/changelog 2019-01-10 07:18:08.000000000 +0000 +++ r-bioc-rtracklayer-1.44.2/debian/changelog 2019-07-27 17:40:00.000000000 +0000 @@ -1,3 +1,20 @@ +r-bioc-rtracklayer (1.44.2-1) unstable; urgency=medium + + * New upstream version + * Drop note about no testing in debian/tests/control_ + * debhelper-compat 12 + + -- Andreas Tille Sat, 27 Jul 2019 19:40:00 +0200 + +r-bioc-rtracklayer (1.44.0-1) unstable; urgency=medium + + * New upstream version + * debhelper 12 + * Standards-Version: 4.4.0 + * Remove trailing whitespace in debian/copyright + + -- Andreas Tille Fri, 19 Jul 2019 10:00:24 +0200 + r-bioc-rtracklayer (1.42.1-2) unstable; urgency=medium * Team upload. diff -Nru r-bioc-rtracklayer-1.42.1/debian/compat r-bioc-rtracklayer-1.44.2/debian/compat --- r-bioc-rtracklayer-1.42.1/debian/compat 2019-01-10 07:18:08.000000000 +0000 +++ r-bioc-rtracklayer-1.44.2/debian/compat 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -11 diff -Nru r-bioc-rtracklayer-1.42.1/debian/control r-bioc-rtracklayer-1.44.2/debian/control --- r-bioc-rtracklayer-1.42.1/debian/control 2019-01-10 07:18:08.000000000 +0000 +++ r-bioc-rtracklayer-1.44.2/debian/control 2019-07-27 17:40:00.000000000 +0000 @@ -4,7 +4,7 @@ Section: gnu-r Testsuite: autopkgtest-pkg-r Priority: optional -Build-Depends: debhelper (>= 11~), +Build-Depends: debhelper-compat (= 12), dh-r, r-base-dev, r-bioc-genomicranges (>= 1.31.8), @@ -19,7 +19,7 @@ r-cran-rcurl, r-bioc-rsamtools (>= 1.31.2), r-bioc-genomicalignments (>= 1.15.6) -Standards-Version: 4.3.0 +Standards-Version: 4.4.0 Vcs-Browser: https://salsa.debian.org/r-pkg-team/r-bioc-rtracklayer Vcs-Git: https://salsa.debian.org/r-pkg-team/r-bioc-rtracklayer.git Homepage: https://bioconductor.org/packages/rtracklayer/ diff -Nru r-bioc-rtracklayer-1.42.1/debian/copyright r-bioc-rtracklayer-1.44.2/debian/copyright --- r-bioc-rtracklayer-1.42.1/debian/copyright 2019-01-10 07:18:08.000000000 +0000 +++ r-bioc-rtracklayer-1.44.2/debian/copyright 2019-07-27 17:40:00.000000000 +0000 @@ -1,10 +1,10 @@ Format: https://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ Upstream-Name: rtracklayer -Upstream-Contact: Michael Lawrence +Upstream-Contact: Michael Lawrence Source: https://bioconductor.org/packages/rtracklayer/ Files: * -Copyright: © 2006-2016 Michael Lawrence, Vince Carey, Robert Gentleman +Copyright: © 2006-2016 Michael Lawrence, Vince Carey, Robert Gentleman License: Artistic-2.0 Files: src/ucsc/* @@ -19,7 +19,7 @@ also added to it. Jim continues to make substantial contributions. . - With the exception of the gifcomp.c module, all + With the exception of the gifcomp.c module, all modules here are free for all use - public, private, or commercial. The gifcomp.c module contains code originally distributed by CompuServe under a similar @@ -36,12 +36,12 @@ Files: src/ucsc/bits.* src/ucsc/common.* - src/ucsc/dlist.* - src/ucsc/dnaseq.* - src/ucsc/dnautil.* - src/ucsc/dystring.* - src/ucsc/errAbort.* - src/ucsc/hash.* + src/ucsc/dlist.* + src/ucsc/dnaseq.* + src/ucsc/dnautil.* + src/ucsc/dystring.* + src/ucsc/errAbort.* + src/ucsc/hash.* src/ucsc/hmmstats.c src/ucsc/htmshell.h src/ucsc/linefile.* diff -Nru r-bioc-rtracklayer-1.42.1/debian/tests/control_ r-bioc-rtracklayer-1.44.2/debian/tests/control_ --- r-bioc-rtracklayer-1.42.1/debian/tests/control_ 1970-01-01 00:00:00.000000000 +0000 +++ r-bioc-rtracklayer-1.44.2/debian/tests/control_ 2019-07-27 17:40:00.000000000 +0000 @@ -0,0 +1 @@ +# Not testing since non-packaged data is needed diff -Nru r-bioc-rtracklayer-1.42.1/DESCRIPTION r-bioc-rtracklayer-1.44.2/DESCRIPTION --- r-bioc-rtracklayer-1.42.1/DESCRIPTION 2018-11-23 00:03:57.000000000 +0000 +++ r-bioc-rtracklayer-1.44.2/DESCRIPTION 2019-07-22 23:30:06.000000000 +0000 @@ -1,7 +1,7 @@ Package: rtracklayer Title: R interface to genome annotation files and the UCSC genome browser -Version: 1.42.1 +Version: 1.44.2 Author: Michael Lawrence, Vince Carey, Robert Gentleman Depends: R (>= 3.3), methods, GenomicRanges (>= 1.31.8) Imports: XML (>= 1.98-0), BiocGenerics (>= 0.25.1), S4Vectors (>= @@ -28,9 +28,9 @@ test_rtracklayer_package.R ncbi.R zzz.R biocViews: Annotation,Visualization,DataImport git_url: https://git.bioconductor.org/packages/rtracklayer -git_branch: RELEASE_3_8 -git_last_commit: a6a85e5 -git_last_commit_date: 2018-11-20 -Date/Publication: 2018-11-22 +git_branch: RELEASE_3_9 +git_last_commit: 9b586e5 +git_last_commit_date: 2019-07-22 +Date/Publication: 2019-07-22 NeedsCompilation: yes -Packaged: 2018-11-23 00:03:57 UTC; biocbuild +Packaged: 2019-07-22 23:30:06 UTC; biocbuild Binary files /tmp/tmpsncm5Q/ewAZ1sFT47/r-bioc-rtracklayer-1.42.1/inst/doc/rtracklayer.pdf and /tmp/tmpsncm5Q/n52q1STSpy/r-bioc-rtracklayer-1.44.2/inst/doc/rtracklayer.pdf differ diff -Nru r-bioc-rtracklayer-1.42.1/inst/unitTests/test_bw.R r-bioc-rtracklayer-1.44.2/inst/unitTests/test_bw.R --- r-bioc-rtracklayer-1.42.1/inst/unitTests/test_bw.R 2018-10-30 19:33:50.000000000 +0000 +++ r-bioc-rtracklayer-1.44.2/inst/unitTests/test_bw.R 2019-07-22 21:02:20.000000000 +0000 @@ -72,13 +72,14 @@ correct_cov_short <- correct_cov[correct_cov != 0L] correct_int <- as(correct_cov_short, "NumericList") which <- GRanges(names(correct_int), IRanges(1, elementNROWS(correct_int))) + names(which) <- names(correct_int) metadata(correct_int) <- list(ranges=which) export(correct_int, test_bw_out) test <- import(test_bw_out, as="NumericList") - checkIdentical(unname(correct_int), test) + checkIdentical(correct_int, test) test <- import(test_bw_out, which=which[1], as="NumericList") - checkIdentical(elementNROWS(unname(correct_int[1])), elementNROWS(test)) + checkIdentical(elementNROWS(correct_int[1]), elementNROWS(test)) test <- import(test_bw_out, which=which[1:2], as="NumericList") - checkIdentical(unname(correct_int), test) + checkIdentical(correct_int, test) } diff -Nru r-bioc-rtracklayer-1.42.1/man/BEDFile-class.Rd r-bioc-rtracklayer-1.44.2/man/BEDFile-class.Rd --- r-bioc-rtracklayer-1.42.1/man/BEDFile-class.Rd 2018-10-30 19:33:50.000000000 +0000 +++ r-bioc-rtracklayer-1.44.2/man/BEDFile-class.Rd 2019-05-02 20:55:25.000000000 +0000 @@ -68,7 +68,8 @@ \usage{ \S4method{import}{BEDFile,ANY,ANY}(con, format, text, trackLine = TRUE, genome = NA, colnames = NULL, - which = NULL, seqinfo = NULL, extraCols = character()) + which = NULL, seqinfo = NULL, extraCols = character(), + sep = c("\t", "")) import.bed(con, ...) import.bed15(con, ...) import.bedGraph(con, ...) @@ -156,6 +157,11 @@ the last columns in the file. This enables parsing of the various BEDX+Y formats. } + \item{sep}{A character vector with a single character indicating the + field separator, like \code{read.table}. This defaults to + \code{"\t"}, as BEDtools requires, but BED files are also allowed to + be whitespace separated (\code{""}) according to the UCSC spec. + } \item{append}{If \code{TRUE}, and \code{con} points to a file path, the data is appended to the file. Obviously, if \code{con} is a connection, the data is always appended. diff -Nru r-bioc-rtracklayer-1.42.1/man/UCSCTableQuery-class.Rd r-bioc-rtracklayer-1.44.2/man/UCSCTableQuery-class.Rd --- r-bioc-rtracklayer-1.42.1/man/UCSCTableQuery-class.Rd 2018-10-30 19:33:50.000000000 +0000 +++ r-bioc-rtracklayer-1.44.2/man/UCSCTableQuery-class.Rd 2019-05-02 20:55:25.000000000 +0000 @@ -34,6 +34,7 @@ % Constructor: \alias{ucscTableQuery} \alias{ucscTableQuery,UCSCSession-method} +\alias{ucscTableQuery,character-method} % Show: \alias{show,UCSCTableQuery-method} @@ -96,7 +97,8 @@ \item{}{ \code{ucscTableQuery(x, track, range = seqinfo(x), table = NULL, names = NULL)}: Creates a \code{UCSCTableQuery} with the - \code{UCSCSession} given as \code{x} and the track name given by + \code{UCSCSession} or genome identifier given as \code{x} and + the track name given by the single string \code{track}. \code{range} should be a genome string identifier, a \code{GRanges} instance or \code{IntegerRangesList} instance, and it effectively defaults to diff -Nru r-bioc-rtracklayer-1.42.1/R/bed.R r-bioc-rtracklayer-1.44.2/R/bed.R --- r-bioc-rtracklayer-1.42.1/R/bed.R 2018-11-21 21:47:03.000000000 +0000 +++ r-bioc-rtracklayer-1.44.2/R/bed.R 2019-05-02 20:55:25.000000000 +0000 @@ -179,11 +179,11 @@ options(scipen = 100) # prevent use of scientific notation on.exit(options(scipen = scipen)) file <- con - con <- connection(con, if (append) "a" else "w") - on.exit(release(con), add=TRUE) + m <- manager() + con <- connection(m, con, if (append) "a" else "w") write.table(df, con, sep = "\t", col.names = FALSE, row.names = FALSE, quote = FALSE, na = ".") - release(con) + release(m, con) if (index) invisible(indexTrack(file)) else invisible(file) @@ -225,7 +225,9 @@ }) scanTrackLine <- function(con) { - con <- connectionForResource(con, "r") + m <- manager() + con <- connectionForResource(m, con, "r") + on.exit(release(m, con)) line <- "#" while(length(grep("^ *#", line))) # skip initial comments line <- readLines(con, 1, warn = FALSE) @@ -240,12 +242,16 @@ setMethod("import", "BEDFile", function(con, format, text, trackLine = TRUE, genome = NA, colnames = NULL, - which = NULL, seqinfo = NULL, extraCols = character()) + which = NULL, seqinfo = NULL, extraCols = character(), + sep = c("\t", "")) { if (!missing(format)) checkArgFormat(con, format) + sep <- match.arg(sep) file <- con - con <- queryForConnection(con, which) + m <- manager() + con <- queryForConnection(m, con, which) + on.exit(release(m, con)) if (attr(con, "usedWhich")) which <- NULL if (is(genome, "Seqinfo")) { @@ -300,7 +306,8 @@ `tail<-` <- function(x, n, value) if (n != 0) c(head(x, -n), value) else x pushBack(line, con) - colsInFile <- seq_len(length(strsplit(line, "\\s+")[[1]])) + pattern <- if (sep == "") "\\s+" else "\\t" + colsInFile <- seq_len(length(strsplit(line, pattern)[[1L]])) presentNames <- bedNames[colsInFile] lacksNames <- is.null(names(extraCols)) || any(names(extraCols) == "") || @@ -323,8 +330,8 @@ bed <- DataFrame(read.table(con, colClasses = bedClasses, as.is = TRUE, na.strings = ".", comment.char = "", - sep = "\t", - quote = "\"")) + sep = sep, + quote = "")) } else { if (is.null(colnames)) colnames <- character() @@ -641,11 +648,11 @@ options(scipen = 100) # prevent use of scientific notation on.exit(options(scipen = scipen)) file <- con - con <- connection(con, if (append) "a" else "w") - on.exit(release(con), add=TRUE) + m <- manager() + con <- connection(m, con, if (append) "a" else "w") + on.exit(release(m, con), add=TRUE) write.table(df, con, sep = "\t", col.names = FALSE, row.names = FALSE, quote = FALSE, na = ".") - release(con) invisible(file) }) diff -Nru r-bioc-rtracklayer-1.42.1/R/bigWig.R r-bioc-rtracklayer-1.44.2/R/bigWig.R --- r-bioc-rtracklayer-1.42.1/R/bigWig.R 2018-10-30 19:33:50.000000000 +0000 +++ r-bioc-rtracklayer-1.44.2/R/bigWig.R 2019-07-22 21:02:20.000000000 +0000 @@ -235,6 +235,7 @@ which <- as(which, "NormalIRangesList") } which <- GRanges(which) + names(which) <- names(flatWhich) C_ans <- .Call(BWGFile_query, expandPath(path(con)), as.character(seqnames(which)), ranges(which), identical(colnames(selection), "score"), diff -Nru r-bioc-rtracklayer-1.42.1/R/chain.R r-bioc-rtracklayer-1.44.2/R/chain.R --- r-bioc-rtracklayer-1.42.1/R/chain.R 2018-10-30 19:33:50.000000000 +0000 +++ r-bioc-rtracklayer-1.44.2/R/chain.R 2019-05-02 20:55:25.000000000 +0000 @@ -43,8 +43,8 @@ if (!missing(format)) checkArgFormat(con, format) ### FIXME: use readLines() to read the file, parse lines in C - if (!is(connection(con), "file")) { - stop("chain import currently only handles local, uncompressed files") + if (!isSingleString(resource(con)) || isURL(resource(con))) { + stop("chain import currently only handles local, uncompressed file paths") } .Call("readChain", path.expand(path(con)), as.character(exclude), PACKAGE="rtracklayer") diff -Nru r-bioc-rtracklayer-1.42.1/R/compression.R r-bioc-rtracklayer-1.44.2/R/compression.R --- r-bioc-rtracklayer-1.42.1/R/compression.R 2018-10-30 19:33:50.000000000 +0000 +++ r-bioc-rtracklayer-1.44.2/R/compression.R 2019-05-02 20:55:25.000000000 +0000 @@ -9,22 +9,23 @@ setClass("CompressedFile", contains = c("RTLFile", "VIRTUAL")) setGeneric("decompress", - function(con, ...) standardGeneric("decompress")) + function(manager, con, ...) standardGeneric("decompress"), + signature="con") -setMethod("decompress", "ANY", function(con, ...) con) +setMethod("decompress", "ANY", function(manager, con, ...) con) -setMethod("decompress", "CompressedFile", function(con, ...) { +setMethod("decompress", "CompressedFile", function(manager, con, ...) { resource <- resource(con) if (is.character(resource)) - manage(gzfile(resource)) # handles gzip, bzip2 and xz + manage(manager, gzfile(resource)) # handles gzip, bzip2 and xz else stop("Cannot decompress connection") }) setMethod("decompress", "character", - function(con, ...) { + function(manager, con, ...) { file <- try(FileForFormat(con), silent = TRUE) if (!is(file, "try-error")) { - decompressed <- decompress(file) + decompressed <- decompress(manager, file) if (!identical(file, decompressed)) con <- decompressed } @@ -64,18 +65,19 @@ new("GZFile", resource = resource) } -setMethod("decompress", "GZFile", function(con) { - ungzip(resource(con)) +setMethod("decompress", "GZFile", function(manager, con) { + ungzip(manager, resource(con)) }) -setGeneric("ungzip", function(x, ...) standardGeneric("ungzip")) +setGeneric("ungzip", function(manager, x, ...) standardGeneric("ungzip"), + signature="x") -setMethod("ungzip", "character", function(x) { +setMethod("ungzip", "character", function(manager, x) { uri <- .parseURI(x) if (uri$scheme != "" && uri$scheme != "file") con <- gzcon(url(x, open="rb"), text=TRUE) else con <- gzfile(uri$path) - manage(con) + manage(manager, con) }) setMethod("ungzip", "connection", function(x) { diff -Nru r-bioc-rtracklayer-1.42.1/R/gff.R r-bioc-rtracklayer-1.44.2/R/gff.R --- r-bioc-rtracklayer-1.42.1/R/gff.R 2018-10-30 19:33:50.000000000 +0000 +++ r-bioc-rtracklayer-1.44.2/R/gff.R 2019-05-02 20:55:25.000000000 +0000 @@ -262,7 +262,10 @@ } } - sniffed <- .sniffGFFVersion(resource(con)) + m <- manager() + sniff_con <- connection(m, con, "r") + on.exit(release(m, sniff_con)) + sniffed <- .sniffGFFVersion(sniff_con) version <- gffFileVersion(con) if (!length(version)) { if (is.null(sniffed)) @@ -289,10 +292,10 @@ ## Temporarily disable use of Tabix Index. ## TODO: Restore use of Tabix Index! - #con <- queryForResource(con, which) - con <- queryForResource(con) - - ans <- readGFFAsGRanges(con, + #con <- queryForResource(m, con, which) + resource <- queryForResource(m, con) + on.exit(release(m, resource), add=TRUE) + ans <- readGFFAsGRanges(resource, version=version, colnames=colnames, filter=list(type=feature.type), @@ -300,7 +303,7 @@ sequenceRegionsAsSeqinfo= sequenceRegionsAsSeqinfo, speciesAsMetadata=TRUE) - if (!attr(con, "usedWhich") && !is.null(which)) + if (!attr(resource, "usedWhich") && !is.null(which)) ans <- subsetByOverlaps(ans, which) ans }) @@ -442,7 +445,9 @@ ### scanGFFDirectives <- function(con, tag = NULL) { - con <- connection(con, "r") + m <- manager() + con <- connection(m, con, "r") + on.exit(release(m, con)) directives <- character() lines <- line <- readLines(con, n = 1) while(grepl("^#", line)) { @@ -476,7 +481,6 @@ cat("##", paste(...), "\n", sep = "", file = con, append = TRUE) .sniffGFFVersion <- function(con) { - con <- connectionForResource(con, "r") version <- NULL lines <- line <- readLines(con, n = 1) while(grepl("^#", line)) { diff -Nru r-bioc-rtracklayer-1.42.1/R/index.R r-bioc-rtracklayer-1.44.2/R/index.R --- r-bioc-rtracklayer-1.42.1/R/index.R 2018-10-30 19:33:50.000000000 +0000 +++ r-bioc-rtracklayer-1.44.2/R/index.R 2019-05-02 20:55:25.000000000 +0000 @@ -13,33 +13,36 @@ ## flexibility. setGeneric("queryForResource", - function(x, which = NULL, ...) standardGeneric("queryForResource")) + function(manager, x, which = NULL, ...) + standardGeneric("queryForResource"), + signature="x") ## Attaches 'usedWhich' attribute, an optimization hint indicating ## that subsetting by 'which' has been performed and is no longer ## necessary. Probably premature. -setMethod("queryForResource", "RTLFile", function(x, which = NULL, ...) { +setMethod("queryForResource", "RTLFile", function(manager, x, which = NULL, ...) +{ r <- resource(x) ans <- structure(r, usedWhich = FALSE) if (!is.null(which) && is.character(r)) { x_tbi <- paste(r, "tbi", sep = ".") if (file.exists(x_tbi)) - ans <- queryForResource(TabixFile(r), which = which, ...) + ans <- queryForResource(manager, TabixFile(r), which = which, ...) } ans }) setMethod("queryForResource", "TabixFile", - function(x, which, header = TRUE, ...) { + function(manager, x, which, header = TRUE, ...) { tabixHeader <- headerTabix(x) si <- Seqinfo(tabixHeader$seqnames) if (is.null(which)) { - buffer <- connectionForResource(path(x), "r") + buffer <- connectionForResource(manager, path(x), "r") if (!header) readLines(buffer, tabixHeader$skip) } else { - buffer <- manage(file()) + buffer <- manage(manager, file()) if (header) { skippedLines <- readLines(path(x), tabixHeader$skip) writeLines(skippedLines, buffer) @@ -51,9 +54,9 @@ structure(buffer, usedWhich = TRUE, seqinfo = si) }) -queryForConnection <- function(x, which = NULL, ...) { - resource <- queryForResource(x, which = which, ...) - con <- connectionForResource(resource, open = "r") +queryForConnection <- function(manager, x, which = NULL, ...) { + resource <- queryForResource(manager, x, which = which, ...) + con <- connectionForResource(manager, resource, open = "r") structure(con, usedWhich = attr(resource, "usedWhich")) } diff -Nru r-bioc-rtracklayer-1.42.1/R/io.R r-bioc-rtracklayer-1.44.2/R/io.R --- r-bioc-rtracklayer-1.42.1/R/io.R 2018-10-30 19:33:50.000000000 +0000 +++ r-bioc-rtracklayer-1.44.2/R/io.R 2019-05-02 20:55:25.000000000 +0000 @@ -18,10 +18,24 @@ prototype = prototype(elementType = "RTLFile"), contains = "SimpleList") +RTLFileList <- function(files) { + new("RTLFileList", listData = files) +} + +.ConnectionManager <- setRefClass("ConnectionManager", + fields = c(connections = "list")) + +manager <- function() .ConnectionManager() + resource <- function(x) x@resource -connection <- function(x, open = "") { - connectionForResource(resource(x), open = open) +`resource<-` <- function(x, value) { + x@resource <- value + x +} + +connection <- function(manager, x, open = "") { + connectionForResource(manager, resource(x), open = open) } resourceDescription <- function(x) { @@ -194,13 +208,19 @@ "bed" # just ranges... }) -## Uses XML::parseURI, except first checks for Windows drive letter. +## First checks for Windows drive letter. ## There are no known URI schemes that are only a single character. +isURL <- function(uri) { + if (!isSingleString(uri)) + return(FALSE) + windowsDriveLetter <- .Platform$OS.type == "windows" && + grepl("^[A-Za-z]:[/\\]", uri) + grepl("^[A-Za-z]+:", uri) && !windowsDriveLetter +} + +## Uses XML::parseURI, except custom check for whether it is a URL .parseURI <- function(uri) { - windowsDriveLetter <- .Platform$OS.type == "windows" && - grepl("^[A-Za-z]:[/\\]", uri) - hasScheme <- grepl("^[A-Za-z]+:", uri) && !windowsDriveLetter - if (!hasScheme) { + if (!isURL(uri)) { parsed <- parseURI("") parsed$path <- uri } else { @@ -260,8 +280,8 @@ stop("Cannot treat a '", class(con), "' as format '", format, "'") } -connectionForResource <- function(x, open = "") { - resource <- decompress(x) +connectionForResource <- function(manager, x, open = "") { + resource <- decompress(manager, x) if (is.character(resource)) { if (!nzchar(resource)) stop("path cannot be an empty string") @@ -272,39 +292,63 @@ } else con <- resource if (!isOpen(con) && nzchar(open)) { open(con, open) - con <- manage(con) + con <- manage(manager, con) } con } ## Connection management (similar to memory management) -manage <- function(con) { - if (!is.null(attr(con, "finalizerEnv"))) - return(con) - env <- new.env() - finalizer <- function(obj) { - if (exists("con", parent.env(environment()), inherits=FALSE)) { - close(con) - rm(con, inherits = TRUE) - TRUE - } else FALSE - } - env$finalizer <- finalizer - reg.finalizer(env, finalizer) - attr(con, "finalizerEnv") <- env - rm(env) - con -} - -unmanage <- function(con) { - attr(con, "finalizerEnv") <- NULL - con -} - -release <- function(con) { - env <- attr(con, "finalizerEnv") - if (!is.null(env)) - env$finalizer() - else FALSE -} +manage <- function(manager, con) { + manager$connections <- unique(c(manager$connections, list(con))) + attr(con, "manager") <- manager + con +} + +managed <- function(manager, con) { + con %in% manager$connections +} + +unmanage <- function(manager, con) { + manager$connections <- setdiff(manager$connections, con) + attr(con, "manager") <- NULL + con +} + +release <- function(manager, con) { + if (managed(manager, con)) { + unmanage(manager, con) + close(con) + } + con +} + +## manage <- function(con) { +## if (!is.null(attr(con, "finalizerEnv"))) +## return(con) +## env <- new.env() +## finalizer <- function(obj) { +## if (exists("con", parent.env(environment()), inherits=FALSE)) { +## close(con) +## rm(con, inherits = TRUE) +## TRUE +## } else FALSE +## } +## env$finalizer <- finalizer +## reg.finalizer(env, finalizer) +## attr(con, "finalizerEnv") <- env +## rm(env) +## con +## } + +## unmanage <- function(con) { +## attr(con, "finalizerEnv") <- NULL +## con +## } + +## release <- function(con) { +## env <- attr(con, "finalizerEnv") +## if (!is.null(env)) +## env$finalizer() +## else FALSE +## } diff -Nru r-bioc-rtracklayer-1.42.1/R/tabix.R r-bioc-rtracklayer-1.44.2/R/tabix.R --- r-bioc-rtracklayer-1.42.1/R/tabix.R 2018-10-30 19:33:50.000000000 +0000 +++ r-bioc-rtracklayer-1.44.2/R/tabix.R 2019-05-02 20:55:25.000000000 +0000 @@ -12,8 +12,9 @@ if (missing(format)) { format <- file_ext(file_path_sans_ext(path(con))) } - buffer <- queryForResource(con, which, header = header) - on.exit(release(buffer)) + m <- manager() + buffer <- queryForResource(m, con, which, header = header) + on.exit(release(m, buffer)) file <- try(FileForFormat(buffer, format), silent = TRUE) if (is(file, "try-error")) { tabixHeader <- headerTabix(con) diff -Nru r-bioc-rtracklayer-1.42.1/R/ucsc.R r-bioc-rtracklayer-1.44.2/R/ucsc.R --- r-bioc-rtracklayer-1.42.1/R/ucsc.R 2018-10-30 19:33:50.000000000 +0000 +++ r-bioc-rtracklayer-1.44.2/R/ucsc.R 2019-05-02 20:55:25.000000000 +0000 @@ -66,6 +66,12 @@ value } +handleError <- function(response) { + msg <- getNodeSet(response, "//span[text()='Error']/../text()") + if (length(msg) == 2L) + stop(sub(".*? - ", "", xmlValue(msg[[2L]]))) +} + setReplaceMethod("track", c("UCSCSession", "GenomicRangesList"), function(object, name = names(value), format = c("auto", "bed", "wig", "gff1", "bed15", @@ -83,7 +89,7 @@ { form <- ucscForm(tracks, format, ...) response <- ucscPost(object, "custom", form) -### FIXME: need to check for error + handleError(response) }) } object @@ -301,6 +307,14 @@ query }) +setMethod("ucscTableQuery", "character", + function(x, ...) { + stopifnot(isSingleString(x)) + session <- browserSession() + genome(session) <- x + ucscTableQuery(session, ...) + }) + ucscTableGet <- function(query, .parse = TRUE, tracks = FALSE, ...) ucscGet(browserSession(query), "tables", c(ucscForm(query, tracks = tracks), ...), .parse = .parse) @@ -644,9 +658,10 @@ output <- gsub("\\n.*", "", output) f <- file() writeLines(output, f) - header <- readChar(f, 1) ## strip off the '#' header prefix tab <- read.table(f, sep = "\t", header=TRUE, comment.char = "", quote = "") + ## strip off the '#' => 'X.' header prefix + colnames(tab)[1L] <- substring(colnames(tab)[1L], 3L) close(f) tab }) @@ -922,8 +937,7 @@ str <- paste(str, " visibility=", vis, sep="") color <- from@color if (length(color)) - str <- paste0(str, " color=", - paste0("\"", color, "\"", collapse=",")) + str <- paste0(str, " color=\"", paste0(color, collapse=","), "\"") priority <- from@priority if (length(priority)) str <- paste(str, " priority=", priority, sep="") @@ -1237,11 +1251,13 @@ ucsc <- unlist(lapply(object, is, "UCSCData")) lines <- unlist(lapply(object[ucsc], slot, "trackLine")) trackNames[ucsc] <- as.character(sapply(lines, slot, "name")) + tracks <- vector("list", length(object)) for (i in seq_len(length(object))) { - export(object[[i]], con, name = trackNames[i], - append = append, index = index, ...) + tracks[[i]] <- export(object[[i]], con, name = trackNames[i], + append = append, index = index, ...) append <- TRUE } + RTLFileList(tracks) }) trackLineClass <- function(subformat) @@ -1344,13 +1360,12 @@ trackLine <- object@trackLine } file <- con - con <- connection(con, if (append) "a" else "w") - on.exit(release(con)) + m <- manager() + con <- connection(m, con, if (append) "a" else "w") cat(as(object@trackLine, "character"), "\n", file=con, sep = "") - do.call(export, c(list(as(object, "GRanges"), unmanage(con), - subformat), + do.call(export, c(list(as(object, "GRanges"), con, subformat), args[!lineArgs], trackLine = trackLine)) - release(con) + release(m, con) if (index) indexTrack(FileForFormat(resource(file), subformat), skip = 1L) else invisible(file) diff -Nru r-bioc-rtracklayer-1.42.1/R/wig.R r-bioc-rtracklayer-1.44.2/R/wig.R --- r-bioc-rtracklayer-1.42.1/R/wig.R 2018-10-30 19:33:50.000000000 +0000 +++ r-bioc-rtracklayer-1.44.2/R/wig.R 2019-05-02 20:55:25.000000000 +0000 @@ -39,8 +39,9 @@ }) .wigWriter <- function(chromData, con, dataFormat, append) { - con <- connection(con, if (append) "a" else "w") - on.exit(release(con)) + m <- manager() + con <- connection(m, con, if (append) "a" else "w") + on.exit(release(m, con)) cat(dataFormat, file = con) cat(" chrom=", as.character(seqnames(chromData)[1]), file = con, sep = "") data <- score(chromData) @@ -99,7 +100,8 @@ fixedSpan <- all(spans[1] == spans) if (!fixedSpan) stop("The span must be uniform for Wiggle export. ", - "Consider bedGraph or bigWig as alternatives.") + "Consider exporting to bedGraph/bigWig, ", + "or coerce data to a GPos object first.") fixedStep <- all(steps[1] == steps) if (dataFormat == "auto") { dataFormat <- "variableStep" @@ -152,7 +154,9 @@ if (!missing(format)) checkArgFormat(con, format) file <- con - con <- connection(con, "r") + m <- manager() + con <- connection(m, con, "r") + on.exit(release(m, con)) ## check for a track line line <- scanTrackLine(con) if (!is.null(line) && trackLine) {