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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
#' @name SDMXDataFlows
#' @rdname SDMXDataFlows
#' @aliases SDMXDataFlows,SDMXDataFlows-method
#'
#' @usage
#' SDMXDataFlows(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 "SDMXDataFlows"
#'
#' @seealso \link{readSDMX}
#' @export
#'
SDMXDataFlows <- function(xmlObj, namespaces){
new("SDMXDataFlows",
SDMX(xmlObj, namespaces),
dataflows = dataflows.SDMXDataFlows(xmlObj, namespaces)
)
}
#get list of SDMXDataFlow
#=============================
dataflows.SDMXDataFlows <- function(xmlObj, namespaces){
dataflows <- NULL
sdmxVersion <- version.SDMXSchema(xmlObj, namespaces)
VERSION.21 <- sdmxVersion == "2.1"
messageNsString <- "message"
if(isRegistryInterfaceEnvelope(xmlObj, FALSE)) messageNsString <- "registry"
messageNs <- findNamespace(namespaces, messageNsString)
strNs <- findNamespace(namespaces, "structure")
dfXML <- NULL
if(VERSION.21){
dfXML <- getNodeSet(xmlObj,
"//mes:Structures/str:Dataflows/str:Dataflow",
namespaces = c(mes = as.character(messageNs),
str = as.character(strNs)))
}else{
dfXML <- getNodeSet(xmlObj,
"//mes:Dataflows/str:Dataflow",
namespaces = c(mes = as.character(messageNs),
str = as.character(strNs)))
if(length(dfXML) == 0){
dfXML <- getNodeSet(xmlObj,
"//mes:KeyFamilies/str:KeyFamily",
namespaces = c(mes = as.character(messageNs),
str = as.character(strNs)))
}
}
if(!is.null(dfXML)){
dataflows <- lapply(dfXML, SDMXDataFlow, namespaces)
}
return(dataflows)
}
#methods
#'@export
as.data.frame.SDMXDataFlows <- function(x, ...){
out <- do.call("rbind.fill",
lapply(x@dataflows,
function(dataflow){
names <- slot(dataflow, "Name")
dataflow.names <- as.data.frame(names, stringsAsFactors = FALSE)
colnames(dataflow.names) <- paste0("Name.", colnames(dataflow.names))
desc <- slot(dataflow, "Description")
dataflow.desc <- NULL
if(length(desc) > 0){
dataflow.desc <- as.data.frame(desc, stringsAsFactors = FALSE)
colnames(dataflow.desc) <- paste0("Description.", colnames(dataflow.desc))
}
df <- data.frame(
id = slot(dataflow, "id"),
agencyID = slot(dataflow, "agencyID"),
dataflow.names,
stringsAsFactors = FALSE)
if(!is.null(dataflow.desc)){
df <- cbind(df, dataflow.desc, stringsAsFactors = FALSE)
}
df <- cbind(df,
version = slot(dataflow, "version"),
uri = slot(dataflow, "uri"),
urn = slot(dataflow, "urn"),
isExternalReference = slot(dataflow, "isExternalReference"),
isFinal = slot(dataflow, "isFinal"),
validFrom = slot(dataflow, "validFrom"),
validTo = slot(dataflow, "validTo"),
dsdRef = slot(dataflow, "dsdRef"),
stringsAsFactors = FALSE
)
return(df)
})
)
return(encodeSDMXOutput(out))
}
setAs("SDMXDataFlows", "data.frame",
function(from) as.data.frame.SDMXDataFlows(from));
|
