Skip to content

Commit 3fe3cac

Browse files
byrongibbybyrongibby
committed
Added data-provider-schemes to read/write_registry
1 parent 2f5307e commit 3fe3cac

File tree

2 files changed

+434
-2
lines changed

2 files changed

+434
-2
lines changed

‎R/read_registry.R

Lines changed: 322 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -51,14 +51,20 @@ read_registry <- function(structure, tidy = FALSE, ...) {
5151
versions <- paste(version, collapse = ",")
5252
structure_data <-
5353
switch(structure,
54+
"agency-scheme" =
55+
read_agency_schemes(agencyids, ids, versions, params),
5456
"category-scheme" =
5557
read_category_schemes(agencyids, ids, versions, params),
5658
"codelist" =
5759
read_codelists(agencyids, ids, versions, params),
5860
"concept-scheme" =
5961
read_concept_schemes(agencyids, ids, versions, params),
62+
"data-consumer-scheme" =
63+
read_data_consumer_schemes(agencyids, ids, versions, params),
64+
"data-provider-scheme" =
65+
read_data_provider_schemes(agencyids, ids, versions, params),
6066
"dataflow" =
61-
read_dataflow(agencyids, ids, versions, params),
67+
read_dataflows(agencyids, ids, versions, params),
6268
"data-structure" =
6369
read_data_structures(agencyids, ids, versions, params),
6470
"memberlist" =
@@ -74,9 +80,12 @@ read_registry <- function(structure, tidy = FALSE, ...) {
7480

7581
structures <- lapply(structure_data, function(x) {
7682
switch(structure,
83+
"agency-scheme" = process_agency_scheme(x, params),
7784
"category-scheme" = process_category_scheme(x, params),
7885
"codelist" = process_codelist(x, params),
7986
"concept-scheme" = process_concept_scheme(x, params),
87+
"data-consumer-scheme" = process_data_consumer_scheme(x, params),
88+
"data-provider-scheme" = process_data_provider_scheme(x, params),
8089
"dataflow" = process_dataflow(x, params),
8190
"data-structure" = process_data_structure(x, params),
8291
"memberlist" = process_memberlist(x, params),
@@ -93,6 +102,109 @@ read_registry <- function(structure, tidy = FALSE, ...) {
93102

94103

95104

105+
# Agency schemes ----
106+
107+
108+
read_agency_schemes <- function(agencyids, ids, versions, params) {
109+
if (is.null(params$file)) {
110+
message(paste("\nFetching agency scheme(s) -",
111+
paste(ids, collapse = ", "), "\n"))
112+
response <- GET(params$env$registry$url,
113+
path = paste(c(params$env$registry$path, "agencyschemes"),
114+
collapse = "/"),
115+
query = list(agencyids = agencyids,
116+
ids = ids,
117+
versions = versions),
118+
add_headers(authorization = get("econdata_token",
119+
envir = .pkgenv)),
120+
accept("application/vnd.sdmx-codera.data+json"))
121+
if (response$status_code != 200) {
122+
stop(content(response, type = "application/json"))
123+
}
124+
data_message <- content(response, type = "application/json")
125+
agency_schemes <- data_message[[2]][["structures"]][["agency-schemes"]]
126+
return(agency_schemes)
127+
} else {
128+
message(paste("\nFetching agency scheme(s) -", params$file, "\n"))
129+
na <- c("", "NA", "#N/A")
130+
agencies <- read_ods(path = params$file,
131+
sheet = "agencies",
132+
na = na,
133+
as_tibble = FALSE)
134+
agency_scheme <- as.list(read_ods(path = params$file,
135+
sheet = "agency_scheme",
136+
na = na,
137+
as_tibble = FALSE))
138+
agency_scheme$agencies <- agencies
139+
return(list(agency_scheme))
140+
}
141+
}
142+
143+
process_agency_scheme <- function(structure, params) {
144+
if (is.null(params$file)) {
145+
structure_ref <- paste(structure[[2]]$agencyid,
146+
structure[[2]]$id,
147+
structure[[2]]$version,
148+
sep = "-")
149+
message("Processing agency scheme: ", structure_ref, "\n")
150+
description <- if (is.null(structure[[2]]$description[[2]])) {
151+
NA
152+
} else {
153+
structure[[2]]$description[[2]]
154+
}
155+
agency_scheme <- list(agencyid = structure[[2]]$agencyid,
156+
id = structure[[2]]$id,
157+
version = structure[[2]]$version,
158+
name = structure[[2]]$name[[2]],
159+
description = description)
160+
agencies <- lapply(structure[[2]]$agencies, function(agency) {
161+
description <- if (is.null(agency[[2]]$description[[2]])) {
162+
NA
163+
} else {
164+
agency[[2]]$description[[2]]
165+
}
166+
if (length(agency[[2]]$contacts) == 0) {
167+
list(id = agency[[2]]$id,
168+
name = agency[[2]]$name[[2]],
169+
description = description,
170+
contact_name = NA,
171+
contact_department = NA,
172+
contact_email = NA)
173+
} else {
174+
lapply(agency[[2]]$contacts, function(contact) {
175+
department <- if (is.null(contact$department[[2]])) {
176+
NA
177+
} else {
178+
contact$department[[2]]
179+
}
180+
email <- if (is.null(contact$email)) {
181+
NA
182+
} else {
183+
contact$email
184+
}
185+
list(id = agency[[2]]$id,
186+
name = agency[[2]]$name[[2]],
187+
description = description,
188+
contact_name = contact$name[[2]],
189+
contact_department = department,
190+
contact_email = email)
191+
}) |>
192+
do.call(rbind.data.frame, args = _)
193+
}
194+
}) |>
195+
do.call(rbind.data.frame, args = _)
196+
agency_scheme$agencies <- agencies
197+
class(agency_scheme) <- c(class(agency_scheme), "eds_agency_scheme")
198+
return(agency_scheme)
199+
} else {
200+
message("Processing agency scheme: ", params$file, "\n")
201+
class(structure) <- c(class(structure), "eds_agency_scheme")
202+
return(structure)
203+
}
204+
}
205+
206+
207+
96208
# Category schemes ----
97209

98210

@@ -347,10 +459,218 @@ process_concept_scheme <- function(structure, params) {
347459

348460

349461

462+
# Data consumer schemes ----
463+
464+
465+
read_data_consumer_schemes <- function(agencyids, ids, versions, params) {
466+
if (is.null(params$file)) {
467+
message(paste("\nFetching data consumer scheme(s) -",
468+
paste(ids, collapse = ", "), "\n"))
469+
response <- GET(params$env$registry$url,
470+
path = paste(c(params$env$registry$path, "dataconsumerschemes"),
471+
collapse = "/"),
472+
query = list(agencyids = agencyids,
473+
ids = ids,
474+
versions = versions),
475+
add_headers(authorization = get("econdata_token",
476+
envir = .pkgenv)),
477+
accept("application/vnd.sdmx-codera.data+json"))
478+
if (response$status_code != 200) {
479+
stop(content(response, type = "application/json"))
480+
}
481+
data_message <- content(response, type = "application/json")
482+
data_consumer_schemes <- data_message[[2]][["structures"]][["data-consumer-schemes"]]
483+
return(data_consumer_schemes)
484+
} else {
485+
message(paste("\nFetching data consumer scheme(s) -", params$file, "\n"))
486+
na <- c("", "NA", "#N/A")
487+
data_consumers <- read_ods(path = params$file,
488+
sheet = "data_consumers",
489+
na = na,
490+
as_tibble = FALSE)
491+
data_consumer_scheme <- as.list(read_ods(path = params$file,
492+
sheet = "data_consumer_scheme",
493+
na = na,
494+
as_tibble = FALSE))
495+
data_consumer_scheme$data_consumers <- data_consumers
496+
return(list(data_consumer_scheme))
497+
}
498+
}
499+
500+
process_data_consumer_scheme <- function(structure, params) {
501+
if (is.null(params$file)) {
502+
structure_ref <- paste(structure[[2]]$agencyid,
503+
structure[[2]]$id,
504+
structure[[2]]$version,
505+
sep = "-")
506+
message("Processing data consumer scheme: ", structure_ref, "\n")
507+
description <- if (is.null(structure[[2]]$description[[2]])) {
508+
NA
509+
} else {
510+
structure[[2]]$description[[2]]
511+
}
512+
data_consumer_scheme <- list(agencyid = structure[[2]]$agencyid,
513+
id = structure[[2]]$id,
514+
version = structure[[2]]$version,
515+
name = structure[[2]]$name[[2]],
516+
description = description)
517+
data_consumers <- lapply(structure[[2]][["data-consumers"]], function(data_consumer) {
518+
description <- if (is.null(data_consumer[[2]]$description[[2]])) {
519+
NA
520+
} else {
521+
data_consumer[[2]]$description[[2]]
522+
}
523+
if (length(data_consumer[[2]]$contacts) == 0) {
524+
list(id = data_consumer[[2]]$id,
525+
name = data_consumer[[2]]$name[[2]],
526+
description = description,
527+
contact_name = NA,
528+
contact_department = NA,
529+
contact_email = NA)
530+
} else {
531+
lapply(data_consumer[[2]]$contacts, function(contact) {
532+
department <- if (is.null(contact$department[[2]])) {
533+
NA
534+
} else {
535+
contact$department[[2]]
536+
}
537+
email <- if (is.null(contact$email)) {
538+
NA
539+
} else {
540+
contact$email
541+
}
542+
list(id = data_consumer[[2]]$id,
543+
name = data_consumer[[2]]$name[[2]],
544+
description = description,
545+
contact_name = contact$name[[2]],
546+
contact_department = department,
547+
contact_email = email)
548+
}) |>
549+
do.call(rbind.data.frame, args = _)
550+
}
551+
}) |>
552+
do.call(rbind.data.frame, args = _)
553+
data_consumer_scheme$data_consumers <- data_consumers
554+
class(data_consumer_scheme) <-
555+
c(class(data_consumer_scheme), "eds_data_consumer_scheme")
556+
return(data_consumer_scheme)
557+
} else {
558+
message("Processing data consumer scheme: ", params$file, "\n")
559+
class(structure) <- c(class(structure), "eds_data_consumer_scheme")
560+
return(structure)
561+
}
562+
}
563+
564+
565+
566+
# Data provider schemes ----
567+
568+
569+
read_data_provider_schemes <- function(agencyids, ids, versions, params) {
570+
if (is.null(params$file)) {
571+
message(paste("\nFetching data provider scheme(s) -",
572+
paste(ids, collapse = ", "), "\n"))
573+
response <- GET(params$env$registry$url,
574+
path = paste(c(params$env$registry$path, "dataproviderschemes"),
575+
collapse = "/"),
576+
query = list(agencyids = agencyids,
577+
ids = ids,
578+
versions = versions),
579+
add_headers(authorization = get("econdata_token",
580+
envir = .pkgenv)),
581+
accept("application/vnd.sdmx-codera.data+json"))
582+
if (response$status_code != 200) {
583+
stop(content(response, type = "application/json"))
584+
}
585+
data_message <- content(response, type = "application/json")
586+
data_provider_schemes <- data_message[[2]][["structures"]][["data-provider-schemes"]]
587+
return(data_provider_schemes)
588+
} else {
589+
message(paste("\nFetching data provider scheme(s) -", params$file, "\n"))
590+
na <- c("", "NA", "#N/A")
591+
data_providers <- read_ods(path = params$file,
592+
sheet = "data_providers",
593+
na = na,
594+
as_tibble = FALSE)
595+
data_provider_scheme <- as.list(read_ods(path = params$file,
596+
sheet = "data_provider_scheme",
597+
na = na,
598+
as_tibble = FALSE))
599+
data_provider_scheme$data_providers <- data_providers
600+
return(list(data_provider_scheme))
601+
}
602+
}
603+
604+
process_data_provider_scheme <- function(structure, params) {
605+
if (is.null(params$file)) {
606+
structure_ref <- paste(structure[[2]]$agencyid,
607+
structure[[2]]$id,
608+
structure[[2]]$version,
609+
sep = "-")
610+
message("Processing data provider scheme: ", structure_ref, "\n")
611+
description <- if (is.null(structure[[2]]$description[[2]])) {
612+
NA
613+
} else {
614+
structure[[2]]$description[[2]]
615+
}
616+
data_provider_scheme <- list(agencyid = structure[[2]]$agencyid,
617+
id = structure[[2]]$id,
618+
version = structure[[2]]$version,
619+
name = structure[[2]]$name[[2]],
620+
description = description)
621+
data_providers <- lapply(structure[[2]][["data-providers"]], function(data_provider) {
622+
description <- if (is.null(data_provider[[2]]$description[[2]])) {
623+
NA
624+
} else {
625+
data_provider[[2]]$description[[2]]
626+
}
627+
if (length(data_provider[[2]]$contacts) == 0) {
628+
list(id = data_provider[[2]]$id,
629+
name = data_provider[[2]]$name[[2]],
630+
description = description,
631+
contact_name = NA,
632+
contact_department = NA,
633+
contact_email = NA)
634+
} else {
635+
lapply(data_provider[[2]]$contacts, function(contact) {
636+
department <- if (is.null(contact$department[[2]])) {
637+
NA
638+
} else {
639+
contact$department[[2]]
640+
}
641+
email <- if (is.null(contact$email)) {
642+
NA
643+
} else {
644+
contact$email
645+
}
646+
list(id = data_provider[[2]]$id,
647+
name = data_provider[[2]]$name[[2]],
648+
description = description,
649+
contact_name = contact$name[[2]],
650+
contact_department = department,
651+
contact_email = email)
652+
}) |>
653+
do.call(rbind.data.frame, args = _)
654+
}
655+
}) |>
656+
do.call(rbind.data.frame, args = _)
657+
data_provider_scheme$data_providers <- data_providers
658+
class(data_provider_scheme) <-
659+
c(class(data_provider_scheme), "eds_data_provider_scheme")
660+
return(data_provider_scheme)
661+
} else {
662+
message("Processing data provider scheme: ", params$file, "\n")
663+
class(structure) <- c(class(structure), "eds_data_provider_scheme")
664+
return(structure)
665+
}
666+
}
667+
668+
669+
350670
# Dataflow ----
351671

352672

353-
read_dataflow <- function(agencyids, ids, versions, params) {
673+
read_dataflows <- function(agencyids, ids, versions, params) {
354674
if (is.null(params$file)) {
355675
message(paste("\nFetching dataflow(s) -",
356676
paste(ids, collapse = ", "), "\n"))

0 commit comments

Comments
 (0)