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
|
#' @name SDMXStructureType
#' @rdname SDMXStructureType
#' @aliases SDMXStructureType,SDMXStructureType-method
#'
#' @usage
#' SDMXStructureType(xmlObj, namespaces, resource)
#'
#' @param xmlObj object of class "XMLInternalDocument derived from XML package
#' @param namespaces object of class "data.frame" given the list of namespace URIs
#' @param resource object of class "character" giving the REST resource to be
#' queried (required to distinguish between dataflows and datastructures in
#' SDMX 2.0)
#' @return an object of class "SDMXStructureType"
#'
#' @seealso \link{readSDMX}
#'
#' @export
#'
SDMXStructureType <- function(xmlObj, namespaces, resource){
new("SDMXStructureType",
SDMXType(xmlObj),
subtype = type.SDMXStructureType(xmlObj, namespaces, resource));
}
type.SDMXStructureType <- function(xmlObj, namespaces, resource){
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")
strType <- NULL
if(VERSION.21){
if(length(strNs)>0){
dsXML <- getNodeSet(xmlObj, "//ns:DataStructures", namespaces = strNs)
ccXML <- getNodeSet(xmlObj, "//ns:Concepts", namespaces = strNs)
clXML <- getNodeSet(xmlObj, "//ns:Codelists", namespaces = strNs)
#14/06/2017 add any of concept/codelist rule, less restrictive
#to confirm according to SDMX specs
if(length(dsXML)>0 & any(length(ccXML)>0,length(clXML)>0)){
strType <- "DataStructureDefinitionsType"
}else{
#others
structuresXML <- getNodeSet(xmlObj, "//ns:Structures", namespaces = messageNs)
if(length(structuresXML)>0) strType <- paste(xmlName(xmlChildren(structuresXML[[1]])[[1]]), "Type", sep="")
}
}
}else{
if(length(messageNs)>0){
flowXML <- getNodeSet(xmlObj, "//ns:Dataflows", namespaces = messageNs)
dsXML <- getNodeSet(xmlObj, "//ns:KeyFamilies", namespaces = messageNs)
ccXML <- getNodeSet(xmlObj, "//ns:Concepts", namespaces = messageNs)
clXML <- getNodeSet(xmlObj, "//ns:CodeLists", namespaces = messageNs)
if(all(c(length(dsXML)>0, length(ccXML)>0, length(clXML)>0))){
#DSD
strType <- "DataStructureDefinitionsType"
}else{
#others
if(length(ccXML)>0) return("ConceptsType")
if(length(clXML)>0) return("CodelistsType")
if(length(flowXML)>0) return("DataflowsType")
if(length(dsXML)>0){
if(is.null(resource)){
strType <- "DataStructuresType"
}else{
strType <- switch(resource,
"dataflow" = "DataflowsType",
"datastructure" = "DataStructuresType")
}
}
}
}
}
return(strType)
}
#generics
#' @export
#' @name getStructureType
#' @title getStructureType
#' @docType methods
#' @rdname SDMXStructureType-methods
#' @usage
#' getStructureType(obj)
#' @param obj object of class "SDMX"
setGeneric("getStructureType", function(obj) standardGeneric("getStructureType"));
#methods
#' @rdname SDMXStructureType-methods
setMethod(f = "getStructureType", signature = "SDMXStructureType", function(obj){
return(obj@subtype)
})
|
