#116 add saveSDMX & support of RData file in readSDMX

opensdmx · Dec 21, 2016 · 11a2df8 · 11a2df8
1 parent 819a3f3
commit 11a2df8
Show file tree

Hide file tree

Showing 10 changed files with 112 additions and 10 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: rsdmx
 Version: 0.5-7
-Date: 2016-11-24
+Date: 2016-12-21
 Title: Tools for Reading SDMX Data and Metadata
 Authors@R: c(
   person("Emmanuel", "Blondel", role = c("aut", "cre"), email = "emmanuel.blondel1@gmail.com"),
@@ -43,4 +43,5 @@ Collate:
   SDMXCrossSectionalData-methods.R SDMXMessageGroup-methods.R
   SDMXDataFlow-methods.R SDMXDataFlows-methods.R SDMXRequestParams-methods.R
   SDMXRequestBuilder-methods.R SDMXREST20RequestBuilder-methods.R SDMXREST21RequestBuilder-methods.R SDMXDotStatRequestBuilder-methods.R
-  SDMXServiceProvider-methods.R SDMXServiceProviders-methods.R readSDMX.R profile.R rsdmx.R
+  SDMXServiceProvider-methods.R SDMXServiceProviders-methods.R readSDMX.R saveSDMX.R
+  profile.R rsdmx.R
diff --git a/NAMESPACE b/NAMESPACE
@@ -93,7 +93,8 @@ export(
   findSDMXServiceProvider,
   setSDMXServiceProviders,
   getSDMXServiceProviders,
-	readSDMX
+	readSDMX,
+  saveSDMX
 )
 
 exportMethods(

diff --git a/R/readSDMX.R b/R/readSDMX.R
@@ -12,6 +12,9 @@
 #'        has to be downloaded from a SDMXweb-repository. Default value is TRUE.
 #'        Ignored in case \code{readSDMX} is used with helpers (based on the 
 #'        embedded list of \code{SDMXServiceProvider})
+#' @param isRData a value of class "logical" either the path is local RData file
+#'        handling an object of class "SDMX", previously saved with \code{\link{saveSDMX}}.
+#'        Default value is FALSE.
 #' @param provider an object of class "SDMXServiceProvider". If specified, 
 #'        \code{file} and \code{isURL} arguments will be ignored.      
 #' @param providerId an object of class "character" representing a provider id. 
@@ -144,7 +147,7 @@
 #' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
 #'    
 
-readSDMX <- function(file = NULL, isURL = TRUE,
+readSDMX <- function(file = NULL, isURL = TRUE, isRData = FALSE,
                      provider = NULL, providerId = NULL,
                      agencyId = NULL, resource = NULL, resourceId = NULL, version = NULL,
                      flowRef = NULL, key = NULL, key.mode = "R", start = NULL, end = NULL, dsd = FALSE,
@@ -226,14 +229,17 @@ readSDMX <- function(file = NULL, isURL = TRUE,
   #call readSDMX original
   if(is.null(file)) stop("Empty file argument")
   if(buildRequest) isURL = TRUE
+  if(isRData) isURL = FALSE
 
   #load data
   status <- 0
   if(isURL == FALSE){
-    if(!file.exists(file))
-      stop("File ", file, "not found\n")
-    xmlObj <- xmlTreeParse(file, useInternalNodes = TRUE)
-    status <- 1
+    isXML <- !isRData
+    if(isXML){
+      if(!file.exists(file)) stop("File ", file, "not found\n")
+      xmlObj <- xmlTreeParse(file, useInternalNodes = TRUE)
+      status <- 1
+    }
   }else{
     rsdmxAgent <- paste("rsdmx/",as.character(packageVersion("rsdmx")),sep="")
     h <- RCurl::basicHeaderGatherer()
@@ -344,6 +350,12 @@ readSDMX <- function(file = NULL, isURL = TRUE,
         )
       }
     }
+  }else{
+    #read SDMX object from RData file (.RData, .rda, .rds)
+    if(isRData){
+      if(!file.exists(file)) stop("File ", file, "not found\n")
+      obj <- readRDS(file, refhook = XML::xmlDeserializeHook)
+    }
   }
 
   #attempt to get DSD in case of helper method

diff --git a/R/rsdmx.R b/R/rsdmx.R
@@ -17,7 +17,7 @@
 #'    Type: \tab Package\cr
 #'    Version
 #'    : \tab 0.5-7\cr
-#'    Date: \tab 2016-11-24\cr
+#'    Date: \tab 2016-12-21\cr
 #'    License: \tab GPL(>=2.0)\cr
 #'    LazyLoad: \tab yes\cr
 #'  }

diff --git a/R/saveSDMX.R b/R/saveSDMX.R
@@ -0,0 +1,27 @@
+#' @name saveSDMX
+#' @aliases saveSDMX
+#' @title saveSDMX
+#' @description \code{saveSDMX} is the function to save R SDMX object
+#'
+#' @usage saveSDMX(sdmxObj, file)
+#'                 
+#' @param sdmxObj an object of class \code{\link{SDMX-Class}} to save
+#' @param file a connection or the name of the file where the R object is saved to
+#' 
+#' @examples             
+#'  \donttest{
+#'    # Not run by 'R CMD check'
+#'    # (reliable remote datasource but with possible occasional unavailability)
+#'    
+#'    #examples using embedded providers
+#'    sdmx <- readSDMX(providerId = "OECD", resource = "data", flowRef = "MIG",
+#'                      key = list("TOT", NULL, NULL), start = 2011, end = 2011)
+#'    saveSDMX(sdmx, "sdmx.rda")
+#'  }
+#' 
+#' @author Emmanuel Blondel, \email{emmanuel.blondel1@@gmail.com}
+#'    
+
+saveSDMX <- function(sdmxObj, file){
+  saveRDS(sdmxObj, file, refhook = XML::xmlSerializeHook)
+}
diff --git a/man/readSDMX.Rd b/man/readSDMX.Rd
@@ -16,6 +16,10 @@ has to be downloaded from a SDMXweb-repository. Default value is TRUE.
 Ignored in case \code{readSDMX} is used with helpers (based on the
 embedded list of \code{SDMXServiceProvider})}
 
+\item{isRData}{a value of class "logical" either the path is local RData file
+handling an object of class "SDMX", previously saved with \code{\link{saveSDMX}}.
+Default value is FALSE.}
+
 \item{provider}{an object of class "SDMXServiceProvider". If specified,
 \code{file} and \code{isURL} arguments will be ignored.}
 

diff --git a/man/rsdmx.Rd b/man/rsdmx.Rd
@@ -18,7 +18,7 @@ currently focuses on the SDMX XML standard format (SDMX-ML).
    Type: \tab Package\cr
    Version
    : \tab 0.5-7\cr
-   Date: \tab 2016-11-24\cr
+   Date: \tab 2016-12-21\cr
    License: \tab GPL(>=2.0)\cr
    LazyLoad: \tab yes\cr
  }

diff --git a/man/saveSDMX.Rd b/man/saveSDMX.Rd
@@ -0,0 +1,31 @@
+% Generated by roxygen2 (4.1.1): do not edit by hand
+% Please edit documentation in R/saveSDMX.R
+\name{saveSDMX}
+\alias{saveSDMX}
+\title{saveSDMX}
+\usage{
+saveSDMX(sdmxObj, file)
+}
+\arguments{
+\item{sdmxObj}{an object of class \code{\link{SDMX-Class}} to save}
+
+\item{file}{a connection or the name of the file where the R object is saved to}
+}
+\description{
+\code{saveSDMX} is the function to save R SDMX object
+}
+\examples{
+\donttest{
+   # Not run by 'R CMD check'
+   # (reliable remote datasource but with possible occasional unavailability)
+
+   #examples using embedded providers
+   sdmx <- readSDMX(providerId = "OECD", resource = "data", flowRef = "MIG",
+                     key = list("TOT", NULL, NULL), start = 2011, end = 2011)
+   saveSDMX(sdmx, "sdmx.rda")
+ }
+}
+\author{
+Emmanuel Blondel, \email{emmanuel.blondel1@gmail.com}
+}
+
diff --git a/tests/testthat/test_saveSDMX.R b/tests/testthat/test_saveSDMX.R
@@ -0,0 +1,26 @@
+# test_saveSDMX.R
+# Author: Emmanuel Blondel <emmanuel.blondel1@gmail.com>
+#
+# Description: Unit tests for SDMX save methods
+#=======================
+require(rsdmx, quietly = TRUE)
+require(testthat)
+context("saveSDMX")
+
+test_that("saveSDMX",{
+  file <- system.file("extdata", "SDMXCodelists_Example_2.0.xml", package = "rsdmx")
+  sdmx <- readSDMX(file, isURL = FALSE)
+  sdmx.copy <- sdmx
+  saveSDMX(sdmx.copy, "tmp.RData")
+  rm(sdmx.copy)
+  sdmx.copy <- readSDMX("tmp.RData", isRData = TRUE)
+
+  for(slotName in slotNames(sdmx)){
+    if(slotName == "xmlObj"){
+      expect_true(all(sapply(XML::compareXMLDocs(sdmx@xmlObj, sdmx.copy@xmlObj), length) == 0))
+    }else{
+      expect_true(identical(slot(sdmx,slotName), slot(sdmx.copy,slotName)))
+    }
+  }
+
+})
diff --git a/tmp.RData b/tmp.RData