1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
#' @name SDMXMessageGroup
#' @rdname SDMXMessageGroup
#' @aliases SDMXMessageGroup,SDMXMessageGroup-method
#'
#' @usage
#' SDMXMessageGroup(xmlObj, namespaces)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @return an object of class "SDMXMessageGroup"
#'
#' @seealso \link{readSDMX}
#' @export
#'
SDMXMessageGroup <- function(xmlObj, namespaces){
new("SDMXMessageGroup",
SDMXData(xmlObj, namespaces)
)
}
#methods
#=======
class.SDMXMessageGroup <- function(xmlObj){
#namespace
nsDefs.df <- namespaces.SDMX(xmlObj)
#in case no ns found, try to find specific namespace
ns.df <- nsDefs.df[
attr(regexpr("http://www.sdmx.org", nsDefs.df$uri, ignore.case = TRUE),"match.length") == -1,]
ns.df <- as.data.frame(ns.df, stringsAsFactors = FALSE)
colnames(ns.df) <- "uri"
ns <- ns.df$uri
if(length(ns) > 1) ns <- ns[1L]
authorityNs <- nsDefs.df[nsDefs.df$uri == ns,]
authorityNs <- as.data.frame(authorityNs, stringsAsFactors = FALSE)
colnames(authorityNs) <- "uri"
if(nrow(authorityNs) == 0){
hasAuthorityNS <- FALSE
}else{
hasAuthorityNS <- TRUE
}
#business logic to inherit wrapped object class
wrappedClass <- NULL
seriesKeyXML <- NULL
if(hasAuthorityNS){
seriesKeyXML <- getNodeSet(xmlObj, "//ns:SeriesKey", c(ns = authorityNs$uri))
}else{
if(nrow(nsDefs.df) > 0){
serieNs <- nsDefs.df[regexpr("generic$", nsDefs.df$uri)>0,"uri"]
if(length(serieNs)==0) serieNs <- nsDefs.df[1,"uri"]
seriesKeyXML <- getNodeSet(xmlObj, "//ns:SeriesKey", c(ns = serieNs))
}else{
stop("Unsupported XML parser for empty target XML namespace")
}
}
if(!is.null(seriesKeyXML)){
if(length(seriesKeyXML) > 0){
wrappedClass <- "SDMXGenericData"
}else{
wrappedClass <- "SDMXCompactData"
}
}
return(wrappedClass)
}
#'@export
as.data.frame.SDMXMessageGroup <- function(x, row.names=NULL, optional=FALSE,
labels = FALSE, ...){
#TODO support for other included message types
#(at now limited to SDMXGenericData for making it work with OECD)
xmlObj <- slot(x, "xmlObj")
sdmx.df <- switch(class.SDMXMessageGroup(xmlObj),
"SDMXGenericData" = as.data.frame.SDMXGenericData(x, labels = labels),
"SDMXCompactData" = as.data.frame.SDMXCompactData(x, labels = labels),
NULL
)
return(encodeSDMXOutput(sdmx.df))
}
|
