fix: quote-aware VCF/BCF header key=value parser

NEWS

@@ -1,3 +1,17 @@
+CHANGES IN VERSION 2.18
+-----------------------
+
+BUG FIXES
+
+    o .bcfHeaderAsSimpleList() now correctly parses VCF/BCF structured header
+      fields whose quoted Description (or other) values contain commas or
+      equals signs, e.g. Description="IDs [VRS version=2.0.1]". The previous
+      regex-based split produced incorrect results or extra fields in these
+      cases. The new .splitKeyVals() helper uses a character-by-character
+      quote-aware scan and splits each field on the first '=' only.
+      (See https://github.com/Bioconductor/VariantAnnotation/issues/89 and
+      https://github.com/Bioconductor/VariantAnnotation/issues/80)
+
 CHANGES IN VERSION 2.16
 -----------------------
 

R/methods-BcfFile.R

@@ -37,6 +37,39 @@ setMethod(isOpen, "BcfFile",
 
 ## scanBcfHeader
 
+## Parse the comma-separated key=value fields that appear inside a VCF/BCF
+## structured header value (the content between '<' and '>').  Values may be
+## quoted strings that contain commas or equals signs, e.g.
+##   Description="a=1,b=2"
+## The parser walks the string character-by-character so that commas and
+## equals signs inside double-quoted strings are never treated as delimiters.
+## Each field is then split on the FIRST '=' only (key names are never
+## allowed to contain '=').  Returns a list of character(2) vectors c(key,
+## value) for each field.
+.splitKeyVals <- function(s) {
+    n <- nchar(s)
+    if (n == 0L) return(list())
+    chars <- strsplit(s, "", fixed=TRUE)[[1L]]
+    in_quote <- FALSE
+    starts <- 1L
+    fields <- character(0L)
+    for (i in seq_along(chars)) {
+        ch <- chars[[i]]
+        if (ch == '"') {
+            in_quote <- !in_quote
+        } else if (ch == ',' && !in_quote) {
+            fields <- c(fields, paste(chars[starts:(i - 1L)], collapse=""))
+            starts <- i + 1L
+        }
+    }
+    fields <- c(fields, paste(chars[starts:n], collapse=""))
+    lapply(fields, function(fld) {
+        eq <- regexpr("=", fld, fixed=TRUE)
+        if (eq == -1L) c(fld, NA_character_)
+        else c(substring(fld, 1L, eq - 1L), substring(fld, eq + 1L))
+    })
+}
+
 .bcfHeaderAsSimpleList <-
     function(header)
 {
@@ -75,19 +108,10 @@ setMethod(isOpen, "BcfFile",
     tags <- sub(rex, "\\1", lines)
 
     keyval0 <- sub(rex, "\\2", lines)
-    ## Handle INFO, FORMAT, FILTER, ALT, SAMPLE
-    keyval1 <- rep(NA_character_, length(keyval0))
-    keyval <- list()
-    idx <- tags %in% c("INFO", "FORMAT", "FILTER", "ALT")
-    keyval1[idx] <- strsplit(keyval0[idx], 
-            ",(?=(ID|Number|Type)=[[:alnum:]]*)|,(?=Description=\".*?\")", 
-            perl=TRUE)
-    keyval[idx] <- lapply(which(idx), 
-        function(i, keyval1) strsplit(keyval1[[i]],
-            "(?<=[ID|Number|Type|Description])=", perl=TRUE), keyval1)
-    keyval1[!idx] <- strsplit(keyval0[!idx], ",(?=[[:alnum:]]+=)", perl=TRUE)
-    keyval[!idx] <- lapply(which(!idx), function(i, keyval1) {
-        strsplit(keyval1[[i]], "(?<=[[:alnum:]])=", perl=TRUE)}, keyval1)
+    ## Handle INFO, FORMAT, FILTER, ALT, and other structured tags.
+    ## Use .splitKeyVals (defined at package scope) which correctly handles
+    ## quoted values containing commas or '=' signs.
+    keyval <- lapply(keyval0, .splitKeyVals)
 
     tbls <- tapply(keyval, tags, 
         function(elt) {

inst/unitTests/test_BcfFile.R

@@ -122,3 +122,34 @@ test_BcfFile_scan_index <- function()
     checkEquals(1, length(res[["GENO"]]))
     checkEquals(30L, length(res[["GENO"]][["PL"]]))
 }
+
+## Tests for quoted-string-aware VCF header key=value parsing
+## (GitHub issues VariantAnnotation#89 and VariantAnnotation#80)
+test_bcfHeaderAsSimpleList_quoted_equals <- function()
+{
+    .splitKeyVals <- Rsamtools:::.splitKeyVals
+
+    ## issue #89: '=' inside Description's bracket expression
+    s1 <- paste0('ID=VRS_Allele_IDs,Number=R,Type=String,',
+                 'Description="IDs [VRS version=2.0.1;VRS-Python version=2.1.1]"')
+    kv1 <- .splitKeyVals(s1)
+    checkEquals(4L, length(kv1))
+    checkEquals("ID", kv1[[1]][1])
+    checkEquals("Description", kv1[[4]][1])
+    checkTrue(grepl("version=2.0.1", kv1[[4]][2]))
+
+    ## issue #80: '=' inside CommandLineOptions quoted value
+    s2 <- paste0('ID=SelectVariants,Version=3.4,',
+                 'CommandLineOptions="analysis_type=SelectVariants input_file=[]"')
+    kv2 <- .splitKeyVals(s2)
+    checkEquals(3L, length(kv2))
+    checkEquals("CommandLineOptions", kv2[[3]][1])
+    checkTrue(grepl("analysis_type=SelectVariants", kv2[[3]][2]))
+
+    ## commas inside quoted Description must not split the field
+    s3 <- 'ID=foo,Number=1,Type=String,Description="a, b, c=d"'
+    kv3 <- .splitKeyVals(s3)
+    checkEquals(4L, length(kv3))
+    checkEquals("Description", kv3[[4]][1])
+    checkEquals('"a, b, c=d"', kv3[[4]][2])
+}