forked from nationalparkservice/EMLeditor
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy patheditEMLfunctions.R
2877 lines (2654 loc) · 117 KB
/
editEMLfunctions.R
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
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
#' Edit data package title
#'
#' @details The `set_title()` function checks to see if there is an existing title and then asks the user if they would like to change the title. Some work is still needed on this function as `get_eml()` automatically returns all instances of a given tag. Specifying which title will be important for this function to work well.
#'
#' @param eml_object is an EML-formatted R object, either generated in R or imported (typically from an EML-formatted .xml file) using EML::read_eml(<filename>, from="xml").
#' @param data_package_title is a character string that will become the new title for the data package. It can be specified directly in the function call or it can be a previously defined object that holds a character string.
#' @param force logical. Defaults to false. If set to FALSE, a more interactive version of the function requesting user input and feedback. Setting force = TRUE facilitates scripting.
#' @param NPS Logical. Defaults to TRUE. **Most NPS users should leave this as the default**. Only under specific circumstances should it be set to FALSE: if you are **not** publishing with NPS, if you need to set the publisher location to some place other than the Fort Collins Office (e.g. you are NOT working on a data package) or your product is "for" the NPS but not "by" the NPS and you need to specify a different agency, set NPS = FALSE. When NPS=TRUE, the function will over-write existing publisher info and inject NPS as the publisher along the the Central Office in Fort Collins as the location. Additionally, it sets the "for or by NPS" field to TRUE and specifies the originating agency as NPS.
#'
#' @importFrom mockr local_mock
#' @importFrom rlang local_options
#'
#' @return an EML-formatted R object
#' @export
#'
#' @examples
#' \dontrun{
#' data_package_title <- "New Title. Must match DataStore Reference title."
#' eml_object <- set_title(eml_object, data_package_title)
#' }
set_title <- function(eml_object,
data_package_title,
force = FALSE,
NPS = TRUE) {
# scripting route:
if (force == TRUE) {
eml_object$dataset$title <- data_package_title
}
# interactive route:
if (force == FALSE) {
doc <- eml_object$dataset$title
if (is.null(doc)) {
eml_object$dataset$title <- data_package_title
cat("No previous title was detected. Your new title, ",
crayon::blue$bold(data_package_title),
" has been added.",
sep = ""
)
} else {
cat("Your EML already has an title, ",
crayon::blue$bold(doc),
".\n", sep = "")
cat("Are you sure you want to replace it?\n")
var1 <- .get_user_input()
# if User opts to retain DOI, retain it
if (var1 == 1) {
# print the existing DOI to the screen:
eml_object$dataset$title <- data_package_title
cat("You have replaced your title. The new title is: ",
crayon::blue$bold(data_package_title), ".", sep = ""
)
}
# if User opts to change DOI, change it:
if (var1 == 2) {
print("Your original title was retained.")
}
}
}
# Set NPS publisher, if it doesn't already exist
if (NPS == TRUE) {
eml_object <- .set_npspublisher(eml_object)
}
# add/update EMLeditor and version to metadata:
eml_object <- .set_version(eml_object)
return(eml_object)
}
#' Check & set a DOI
#'
#' @description `set_doi()` checks to see if there is a DOI in the alternateIdentifier tag. The EMLassemblyline package stores data package DOIs in this tag (although the official EML schema has the DOI in a different location). If there is no DOI in the alternateIdentifier tag, the function adds a DOI & reports the new DOI. If there is a DOI, the function reports the existing DOI, and prompts the user for input to either retain the existing DOI or overwrite it. Reports back the existing or new DOI, depending on the user input.
#'
#' As an alternative, consider using `set_datastore_doi()`, which will automatically initiate a draft reference on DataStore and inject the corresponding DOI into metadata.
#'
#' @details if `set_doi()` is used to change the DOI, it will also update the urls listed in metadata for each data file to reflect the new DOI/DataStore reference. If you didn't have links to your data files, `set_doi()` will add them - but only if you actually update the doi.
#'
#' @inheritParams set_title
#'
#' @param ds_ref is the same as the 7-digit reference code generated on DataStore when a draft reference is initiated.You should NOT include the full URL, DOI prefix, or anything except the 7-digit DataStore Reference Code.
#'
#' @returns an EML-formatted R object
#' @export
#' @examples
#' \dontrun{
#' eml_object <- set_doi(eml_object, 1234567)
#' }
set_doi <- function(eml_object, ds_ref, force = FALSE, NPS = TRUE) {
# scripting route:
if (force == TRUE) {
eml_object$dataset$alternateIdentifier <- paste0(
"doi: https://doi.org/10.57830/", ds_ref)
}
# interactive route:
if (force == FALSE) {
# Look for an existing data package DOI:
doi <- eml_object$dataset$alternateIdentifier
# If there is no existing DOI, add a DOI to the metadata
if (is.null(doi)) {
eml_object$dataset$alternateIdentifier <- paste0(
"doi: https://doi.org/10.57830/",
ds_ref
)
#get new doi:
doi <- eml_object$dataset$alternateIdentifier
doi <- sub(".*? ", "", doi)
# print the new DOI to the screen:
cat("No DOI detected.")
cat("Your newly specified DOI is: ",
crayon::blue$bold(doi),
sep = ""
)
}
# If there is a DOI, find the correct doi by searching for the text "doi: ".
else {
# If a DOI exists, ask the user what to do about it:
cat("Your EML already has a DOI:\n")
cat(crayon::blue$bold(doi),
"\n\n",
sep = ""
)
cat("Are you sure you want to replace your DOI?\n")
var1 <- .get_user_input()
# if User opts to retain DOI, retain it
if (var1 == 2) {
# print the existing DOI to the screen:
doi <- sub(".*? ", "", doi)
cat("Your DOI remains: ", crayon::blue$bold(doi), sep = "")
}
# if User opts to change DOI, change it:
if (var1 == 1) {
eml_object$dataset$alternateIdentifier <- paste0(
"doi: https://doi.org/10.57830/", ds_ref)
# get the new DOI:
doi <- eml_object$dataset$alternateIdentifier
doi <- sub(".*? ", "", doi)
# print the new DOI to the screen:
cat("Your newly specified DOI is: ", crayon::blue$bold(doi),
".\n", sep = "")
}
}
}
# update data URLs to correspond to new DOI
# (this should probably be a separate function)
data_table <- EML::eml_get(eml_object, "dataTable")
data_table <- within(data_table, rm("@context"))
data_url <- paste0("https://irma.nps.gov/DataStore/Reference/Profile/",
ds_ref)
#handle case when there is only one data table:
if("physical" %in% names(data_table)){
eml_object$dataset$dataTable$physical$distribution$online$url <-
data_url
}
# handle case when there are multiple data tables:
else {
for(i in seq_along(data_table)){
eml_object$dataset$dataTable[[i]]$physical$distribution$online$url <-
data_url
}
}
if (force == FALSE) {
cat("Your data files url also been updated to: ",
crayon::blue$bold(data_url), ".\n", sep = "")
}
# Set NPS publisher, if it doesn't already exist
if (NPS == TRUE) {
eml_object <- .set_npspublisher(eml_object)
}
# add/update EMLeditor and version to metadata:
eml_object <- .set_version(eml_object)
return(eml_object)
}
#' Add Park Unit Connections to metadata
#'
#' @description `set_content_units()` adds all specified park units and their N, E, S, W bounding boxes to <geographicCoverage>. This information will be used to fill in the Content Unit Links field in DataStore. Invalid park unit codes will return an error and the function will terminate. If you don't know a park unit code, see [`get_park_code()`](https://nationalparkservice.github.io/NPSutils/reference/get_park_code.html) from the [NPSutils](https://nationalparkservice.github.io/NPSutils/index.html) package].
#'
#' @details Adds the Content Unit Link(s) to a geographicCoverage. Content Unit Links(s) are the (typically) four-letter codes describing the park unit(s) where data were collected (e.g. ROMO, not ROMN). Each park unit is given a separate geographicCoverage element. For each content unit link, the unit name will be listed under geographicDescription and prefaced with "NPS Content Unit Link:". The geographicCoverage element will be given the attribute "system = content unit link". Required child elements (bounding coordinates) are auto populated to produce a rectangle that encompasses the park unit in question. If the default force=FALSE option is retained, the user will be shown existing content unit links (if any exist) and asked to 1) retain them 2) add to them or 3) replace them. If the force is set to TRUE, the interactive components will be skipped and the existing content unit links will be replaced.
#'
#' @inheritParams set_title
#'
#' @param park_units a list of comma-separated strings where each string is a park unit code.
#'
#' @returns an EML-formatted R object
#' @export
#' @examples
#' \dontrun{
#' park_units <- c("ROMO", "YELL")
#' set_content_units(eml_object, park_units)
#' }
set_content_units <- function(eml_object, park_units,
force = FALSE,
NPS = TRUE){
# test whether park units are actually park units:
null_units <- NULL
for(i in seq_along(park_units)){
is_unit <- .get_unit_polygon(park_units[i]) #
null_units <- append(null_units, is_unit)
}
if (is.null(null_units)) {
return()
}
# add text to indicate that these are park unit connections.
units <- paste0("NPS Content Unit Link: ", park_units)
#generate new geographic coverage for NPS Content Unit Links:
unit_list <- NULL
for (i in seq_along(park_units)){
poly <- .get_unit_polygon(park_units[i])
poly <- as.data.frame(poly[[1]][1])
N <- max(poly[, 2])
S <- min(poly[, 2])
W <- min(poly[, 1])
E <- max(poly[, 1])
geocov <- EML::eml$geographicCoverage(
geographicDescription =
paste0("NPS Content Unit Link: ", park_units[i]),
boundingCoordinates = EML::eml$boundingCoordinates(
northBoundingCoordinate = N,
eastBoundingCoordinate = E,
southBoundingCoordinate = S,
westBoundingCoordinate = W),
system = "content unit link")
unit_list <- append(unit_list, list(geocov))
}
# get geographic coverage from eml_object
doc <- eml_object$dataset$coverage$geographicCoverage
# Are there content unit links already specified?
exist_units <- NULL
for (i in seq_along(doc)) {
doc2 <- unlist(doc)
if (suppressWarnings(
stringr::str_detect(doc2[i],
"NPS Content Unit Link")) == TRUE) {
exist_units <- append(exist_units, doc2[[i]])
}
}
# if there is no content unit links add it directly to eml_object
if (is.null(exist_units)) {
if (is.null(doc)) {
eml_object$dataset$coverage$geographicCoverage <- unit_list
} else {
#if there are multiple existing geographic coverages:
if (length(seq_along(doc[[1]])) > 1) {
# combine new and old geo coverages (new always at the top!)
doc <- append(unit_list, doc)
# write over the existing geographic coverage
eml_object$dataset$coverage$geographicCoverage <- doc
}
# if there is only one geo coverage:
if (length(seq_along(doc[[1]])) == 1) {
geocov2 <- EML::eml$geographicCoverage(
geographicDescription =
doc$geographicDescription,
boundingCoordinates =
doc$boundingCoordinates
)
# add park unit connections and existing geo coverage (park units always on top!)
unit_list<-append(unit_list, list(geocov2))
#insert into EML:
eml_object$dataset$coverage$geographicCoverage <- unit_list
#eml_object$dataset$coverage$geographicCoverage <- list(unit_list, (geocov2))
}
}
if (force == FALSE) {
cat("No previous Content Unit Links Detected\n")
cat("Your Content Unit Links have been set to:\n")
for(i in seq_along(park_units)){
cat(crayon::blue$bold(park_units[i]), "\n")
sep = ""
}
}
}
# if there already content unit links:
if (!is.null(exist_units)) {
if (force == FALSE) {
cat("Your metadata already has the following Content Unit Links Specified:\n")
for (i in seq_along(exist_units)) {
cat(crayon::blue$bold(exist_units[i]), "\n")
}
cat("Do you want to:\n\n 1: Retain the existing Unit Connections\n 2: Add to the exsiting Unit Connections\n 3: Replace the existing Unit Connections")
var1 <- .get_user_input3()
# Do nothing:
if (var1 == 1) {
cat("Your existing Unit Connections were retained.")
}
# Add to existing content unit links:
if (var1 == 2) {
#if there are multiple pre-existing geographic coverages:
if (length(seq_along(doc[[1]])) > 1) {
# combine new and old geo coverages (new always at the top!)
doc <- append(unit_list, doc)
# write over the existing geographic coverage
eml_object$dataset$coverage$geographicCoverage <- doc
}
# if there is only one geo coverage:
if (length(seq_along(doc[[1]])) == 1) {
geocov2 <- EML::eml$geographicCoverage(
geographicDescription =
doc$geographicDescription,
boundingCoordinates =
doc$boundingCoordinates
)
# add park unit connections and existing geo coverage (park units always on top!)
unit_list<-append(unit_list, list(geocov2))
#insert into EML:
eml_object$dataset$coverage$geographicCoverage <- unit_list
}
# Report on newly set content units; first get the new content units:
newgeo <- eml_object$dataset$coverage$geographicCoverage
exist_units <- NULL
for (i in seq_along(newgeo)) {
if (suppressWarnings(stringr::str_detect(
newgeo[i],
"NPS Content Unit Link"
)) == TRUE) {
exist_units <- append(exist_units,
newgeo[[i]]$geographicDescription)
}
}
# print current/new units:
cat("Your metadata now has the following Content Unit Links Specified:\n")
for (i in seq_along(exist_units)) {
cat(crayon::blue$bold(exist_units[i]), "\n")
}
}
# replace existing content unit links:
if (var1 == 3) {
#if there is only one item in geoCov, it is not nested as deeply as when there are multiple. Renest single items so that all geoCov are at the same level of nesting:
if(!is.null(names(doc))){
doc <- list(doc)
}
#get all geographic coverage that is NOT content unit links:
no_units <- NULL
for (i in seq_along(doc)) {
if (suppressWarnings(
stringr::str_detect(doc[[i]][1],
"NPS Content Unit Link")) == FALSE) {
no_units <- append(no_units, list(doc[[i]]))
}
}
# if the only geo unit was a previous connection, replace it:
if (is.null(no_units)) {
eml_object$dataset$coverage$geographicCoverage <- unit_list
}
#if there are geographic units other than content units, add to those:
if (!is.null(no_units)) {
#if there is only one non-content unit geographic coverage element:
unit_list <- append(unit_list, no_units)
#insert into EML:
eml_object$dataset$coverage$geographicCoverage <- unit_list
}
# get new geo units:
newgeo <- eml_object$dataset$coverage$geographicCoverage
exist_units <- NULL
for (i in seq_along(newgeo)) {
if (suppressWarnings(stringr::str_detect(
newgeo[i],
"NPS Content Unit Link"
)) == TRUE) {
exist_units <- append(
exist_units,
newgeo[[i]]$geographicDescription
)
}
}
# return current/new units:
cat("Your metadata now has the following Content Unit Links Specified:\n")
for (i in seq_along(exist_units)) {
cat(crayon::blue$bold(exist_units[i]), "\n")
}
}
}
}
# scripting route
if (force == TRUE) {
#if there is only one item in geoCov, it is not nested as deeply as when
#there are multiple. Re-nest single items so that all geoCov are at the
#same level of nesting:
if(!is.null(names(doc))){
doc <- list(doc)
}
#get all geographic coverage that is NOT content unit links:
no_units <- NULL
for (i in seq_along(doc)) {
if (suppressWarnings(
stringr::str_detect(doc[[i]][1],
"NPS Content Unit Link")) == FALSE) {
no_units <- append(no_units, list(doc[[i]]))
}
}
# if the only geo unit was a previous connection, replace it:
if (is.null(no_units)) {
eml_object$dataset$coverage$geographicCoverage <- unit_list
}
#if there are geographic units other than content units, add to those:
if (!is.null(no_units)) {
#if there is only one non-content unit geographic coverage element:
unit_list <- append(unit_list, no_units)
#insert into EML:
eml_object$dataset$coverage$geographicCoverage <- unit_list
}
}
# Set NPS publisher, if it doesn't already exist
if (NPS == TRUE) {
eml_object <- .set_npspublisher(eml_object)
}
# add/update EMLeditor and version to metadata:
eml_object <- .set_version(eml_object)
return(eml_object)
}
#' Adds CUI dissemination codes to metadata
#'
#' @description
#' `set_cui_code()` adds Controlled Unclassified Information (CUI) dissemination codes to EML metadata. These codes determine who can or cannot have access to the data. Unless you have a specific mandate to restrict data, all data should be available to the public. if the CUI dissemination code is PUBLIC, the CUI marking should also be PUBLIC (`see set_cui_marking()`) and the license should be set to CC0 or public domain (see `set_int_rights()`). If your data contains CUI and you need to set the CUI dissemination code to anything other than PUBLIC, please be prepared to provide a legal justification in the form of the appropriate CUI marking (see `set_cui_marking()`).
#'
#' @details `set_cui_code()` adds a CUI dissemination code to the tag CUI under additionalMetadata/metadata. The available choices for CUI dissemination codes at NPS are (pay attention to the spaces!):
#'
#' PUBLIC: The data contain no CUI, dissemination is not restricted.
#' FED ONLY: Contains CUI. Only federal employees should have access (similar to the "internal only" setting in DataStore)
#' FEDCON: Contains CUI Only federal employees and federal contractors should have access to the data (again, very similar to the DataStore "internal only" setting)
#' DL ONLY: Contains CUI. Should only be available to a named list of individuals. (where and how to supply that list TBD)
#' NOCON - Contains CUI. Federal, state, local, or tribal employees may have access, but contractors cannot.
#'
#' For a more detailed explanation of the CUI dissemination codes, please see the national archives [CUI Registry: Limited Dissemination Controls](https://www.archives.gov/cui/registry/limited-dissemination) web page.
#'
#' @inheritParams set_title
#' @param cui_code a string consisting of one of 7 potential CUI codes: PUBLIC, FED ONLY, FEDCON, DL ONLY, or NOCON
#' @returns an EML-formatted R object
#' @export
#' @examples
#' \dontrun{
#' set_cui_dissem(eml_object, "PUBLIC")
#' }
set_cui_code <- function(eml_object,
cui_code = c("PUBLIC",
"NOCON",
"DL ONLY",
"FEDCON",
"FED ONLY"),
force = FALSE,
NPS = TRUE) {
cui_code <- toupper(cui_code)
# verify CUI code entry; stop if does not equal one of six valid codes listed above:
cui_code <- match.arg(cui_code)
# Generate new CUI element for additionalMetadata
my_cui <- list(metadata = list(CUI = cui_code), id = "CUI")
# get existing additionalMetadata elements:
doc <- eml_object$additionalMetadata
#if no additional metadata at all....
if(is.null(doc)){
eml_object$additionalMetadata <- list(my_cui)
}
if(!is.null(doc)){
#helps track lists of different lengths/hierarchies
x <- length(doc)
# Is CUI code already specified?
exist_cui <- NULL
for (i in seq_along(doc)) {
y <- suppressWarnings(stringr::str_replace_all(doc[i], " ", ""))
if (suppressWarnings(stringr::str_detect(y, "CUI\\b")) == TRUE) {
seq <- i
exist_cui <- doc[[i]]$metadata$CUI
}
}
# scripting route:
if (force == TRUE) {
#what is [[seq]]? It works but...
eml_object$additionalMetadata[[seq]] <- my_cui
}
# interactive route:
if (force == FALSE) {
# If no existing CUI, add it in:
if (is.null(exist_cui)) {
if (x == 1) {
eml_object$additionalMetadata <- list(my_cui,
eml_object$additionalMetadata)
}
if (x > 1) {
eml_object$additionalMetadata[[x + 1]] <- my_cui
}
cat("No previous CUI was detected. Your CUI has been set to ",
crayon::bold$blue(cui_code), ".", sep = "")
}
# If existing CUI, stop.
if (!is.null(exist_cui)) {
cat("CUI has previously been specified as ",
crayon::bold$blue(exist_cui),
".\n", sep = "")
cat("Are you sure you want to reset it?")
var1 <- .get_user_input() #1 = yes, 2 = no
if (var1 == 1) {
eml_object$additionalMetadata[[seq]] <- my_cui
cat("Your CUI code has been rest to ",
crayon::blue$bold(cui_code), ".", sep = "")
}
if (var1 == 2) {
cat("Your original CUI code was retained")
}
}
}
}
# Set NPS publisher, if it doesn't already exist
if (NPS == TRUE) {
eml_object <- .set_npspublisher(eml_object)
}
# add/updated EMLeditor and version to metadata:
eml_object <- .set_version(eml_object)
return(eml_object)
}
#' Adds CUI to metadata
#'
#' @description
#' #' `r lifecycle::badge("deprecated")`
#' set_cui adds CUI dissemination codes to EML metadata
#'
#' @details set_cui adds a CUI code to the tag CUI under additionalMetadata/metadata.
#'
#' @inheritParams set_title
#' @param cui_code a string consisting of one of 5 potential CUI codes. Pay attention to the spaces:
#' FED ONLY - Contains CUI. Only federal employees should have access (similar to "internal only" in DataStore)
#' FEDCON - Contains CUI. Only federal employees and federal contractors should have access (also very much like current "internal only" setting in DataStore)
#' DL ONLY - Contains CUI. Should only be available to a names list of individuals (where and how to list those individuals TBD)
#' NOCON - Contains CUI. Federal, state, local, or tribal employees may have access, but contractors cannot.
#' PUBLIC - Does NOT contain CUI.
#' @returns an EML-formatted R object
#' @export
#' @examples
#' \dontrun{
#' set_cui(eml_object, "PUBFUL")
#' }
set_cui <- function(eml_object, cui_code = c("PUBLIC", "NOCON", "DL ONLY",
"FEDCON", "FED ONLY"),
force = FALSE, NPS = TRUE) {
#add in deprecation
lifecycle::deprecate_soft(when = "0.1.5", "set_cui()", "set_cui_code()")
cui_code <- toupper(cui_code)
# verify CUI code entry; stop if does not equal one of six valid codes listed above:
cui_code <- match.arg(cui_code)
# Generate new CUI element for additionalMetadata
my_cui <- list(metadata = list(CUI = cui_code), id = "CUI")
# get existing additionalMetadata elements:
doc <- eml_object$additionalMetadata
#if no additional metadata at all....
if(is.null(doc)){
eml_object$additionalMetadata <- list(my_cui)
}
if(!is.null(doc)){
#helps track lists of different lengths/hierarchies
x <- length(doc)
# Is CUI already specified?
exist_cui <- NULL
for (i in seq_along(doc)) {
if (suppressWarnings(stringr::str_detect(doc[i], "CUI")) == TRUE) {
seq <- i
exist_cui <- doc[[i]]$metadata$CUI
}
}
# scripting route:
if (force == TRUE) {
#what is [[seq]]?
eml_object$additionalMetadata[[seq]] <- my_cui
}
# interactive route:
if (force == FALSE) {
# If no existing CUI, add it in:
if (is.null(exist_cui)) {
if (x == 1) {
eml_object$additionalMetadata <- list(my_cui,
eml_object$additionalMetadata)
}
if (x > 1) {
eml_object$additionalMetadata[[x + 1]] <- my_cui
}
cat("No previous CUI code was detected. Your CUI code has been set to ",
crayon::bold$blue(cui_code), ".", sep = "")
}
# If existing CUI, stop.
if (!is.null(exist_cui)) {
cat("CUI code has previously been specified as ",
crayon::bold$blue(exist_cui),
".\n", sep = "")
var1 <- .get_user_input() #1 = yes, 2 = no
if (var1 == 1) {
eml_object$additionalMetadata[[seq]] <- my_cui
cat("Your CUI code has been rest to ",
crayon::blue$bold(cui_code), ".", sep = "")
}
if (var1 == 2) {
cat("Your original CUI code was retained")
}
}
}
}
# Set NPS publisher, if it doesn't already exist
if (NPS == TRUE) {
eml_object <- .set_npspublisher(eml_object)
}
# add/updated EMLeditor and version to metadata:
eml_object <- .set_version(eml_object)
return(eml_object)
}
#' The function sets the CUI marking for the data package
#'
#' @description `r lifecycle::badge("experimental")`
#' The Controlled Unclassified Information (CUI) marking is different from the CUI dissemination code. The CUI dissemination code (set `set_cui_code()`) sets who can have access to the data package. The CUI marking set by `set_cui_marking()` specifies the reason (if any) that the data are being restricted.
#' If the CUI dissemination code is set to PUBLIC, the CUI marking must also be PUBLIC.
#' If the CUI dissemination code is set to anything other than PUBLIC, the CUI marking must be set to SP-NPSR, SP-HISTP or SP-ARCHR.
#'
#' @details CUI markings are the legal justification for why data are being restricted from the public. If data contain no CUI, the CUI marking must be set to PUBLIC (and the CUI dissemination code must be set to PUBLIC and the license must be set to CC0 or Public Domain). If the data contain CUI (i.e. the CUI dissemination code is not PUBLIC), you must use the CUI marking to provide a legal justification for why the data are restricted. Only one CUI marking can be applied. At NPS, the following markings are available:
#'
#' PUBLIC: The data contain no CUI, dissemination is not restricted.
#' SP-NPSR: "National Park System Resources" - This material contains information concerning the nature and specific location of a National Park System resource that is endangered, threatened, rare, or commercially valuable, of mineral or paleontological objects within System units, or of objects of cultural patrimony within System units.
#' SP-HISTP: "Historic Properties" - This material contains information related to the location, character, or ownership of historic property.
#' SP-ARCHR: "Archaeological Resources" - This material contains information related to information about the nature and location of any archaeological resource for which the excavation or removal requires a permit or other permission.
#'
#' For more information on CUI markings, please visit the [CUI Markings](https://www.archives.gov/cui/registry/category-marking-list) list maintained by the National Archives.
#'
#' @inheritParams set_title
#' @param cui_marking String. One of four options, "PUBLIC", "SP-NPSR", "SP-HISTP" or "SP-ARCHR" are available.
#'
#' @return an EML-formatted R object
#' @export
#'
#' @examples
#' \dontrun{
#' eml_object <- set_cui_marking(eml_object, "PUBLIC")
#' }
set_cui_marking <- function (eml_object,
cui_marking = c("PUBLIC",
"SP-NPSR",
"SP-HISTP",
"SP-ARCHR"),
force = FALSE,
NPS = TRUE) {
cui_marking <- toupper(cui_marking)
# verify CUI code entry; stop if does not equal one of six valid codes listed above:
cui_marking <- match.arg(cui_marking)
# Generate new CUI element for additionalMetadata
my_cui <- list(metadata = list(CUImarking = cui_marking), id = "CUImarking")
# get existing additionalMetadata elements:
add_meta <- eml_object$additionalMetadata
#get the location of CUI dissemination codes in additionalMetadata:
x <- NULL
for (i in 1:length(seq_along(add_meta))) {
if (names(add_meta[[i]][["metadata"]]) == "CUI") {
x <- i
break
}
}
#if no CUI dissemination code exit the function; warn if force == FALSE
if (is.null(x)) {
if (force == FALSE) {
cat("Your metadata does not contain a CUI dissemination code.")
cat("Use ",
crayon::bold$green("set_cui_code()"),
" to add a dissemination code to the metadata.",
sep = "")
}
return(invisible(eml_object))
}
#get location of CUI marking codes in additionalMetadata:
y <- NULL
for (i in 1:length(seq_along(add_meta))) {
if(names(add_meta[[i]][["metadata"]]) == "CUImarking") {
y <- i
break
}
}
#if CUI marking already exists:
if (!is.null(y)) {
#get existing CUI marking:
existing_cui_marking <- add_meta[[y]][["metadata"]][["CUImarking"]]
#don't replace an existing CUI marking with the same marking
if (existing_cui_marking == cui_marking) {
if (force == FALSE) {
cat("Your metadata already have an existing CUI marking of ",
crayon::bold$blue(existing_cui_marking),
".\n",
sep = "")
cat("Your metadata CUI marking was not updated.\n")
}
return(invisible(eml_object))
}
#if CUI markings already exist, ask if they should be replaced/changed?
if (force == FALSE) {
cat("Your metadata already contains the CUI marking: ",
crayon::blue$bold(existing_cui_marking),
".\n",
sep = "")
cat("Are you sure you want to change it?\n")
var1 <- .get_user_input()
if (var1 == 2) {
cat("Your original CUI marking has been retained")
return(invisible(eml_object))
}
}
}
#extract CUI dissemination code
cui <- add_meta[[x]][["metadata"]][["CUI"]]
#test that cui code and cui marking are both public:
if (cui == "PUBLIC" & cui_marking != "PUBLIC") {
if (force == FALSE){
msg <- paste0("to choose a CUI marking that coincides",
" with your CUI dissemination code or use ")
cat("Your CUI dissemination code is set to ", cui, ".\n", sep ="")
cat("The CUI dissemination code and CUI marking must coincide.\n")
cat("Use ",
crayon::green$bold("set_cui_marking() "),
msg,
crayon::green$bold("set_cui_code()"),
" to change your CUI dissemination code.\n", sep = "")
}
return(invisible(eml_object))
}
#test that if cui_code is not public, cui_marking is not public.
if (cui != "PUBLIC" & cui_marking == "PUBLIC") {
if (force == FALSE){
msg <- paste0("to choose a CUI marking that coincides",
" with your CUI dissemination code or use ")
cat("Your CUI dissemination code is set to ", cui, ".\n", sep = "")
cat("The CUI dissemination code and CUI marking must coincide.\n")
cat("Use ",
crayon::green$bold("set_cui_marking() "),
msg,
crayon::green$bold("set_cui_code()"),
" to change your CUI dissemination code\n.", sep = "")
}
return(invisible(eml_object))
}
# at this point cui_code and cui_marking coincide
# add cui_marking and put it back in additional metadata
# Generate new CUI element for additionalMetadata
my_cui <- list(metadata = list(CUImarking = cui_marking), id = "CUI marking")
# if there was no CUImarking, add one:
if (is.null(y)) {
x <- length(eml_object$additionalMetadata)
eml_object$additionalMetadata[[x + 1]] <- my_cui
} else {
#otherwise, overwrite the existing CUI marking:
eml_object[["additionalMetadata"]][[y]] <- my_cui
}
if (force == FALSE) {
cat("Your CUI marking has been set to ", crayon::blue$bold(cui_marking))
}
# Set NPS publisher, if it doesn't already exist
if (NPS == TRUE) {
eml_object <- .set_npspublisher(eml_object)
}
# add/updated EMLeditor and version to metadata:
eml_object <- .set_version(eml_object)
return(eml_object)
}
#' adds DRR connection
#'
#' @description set_drr adds the DOI of an associated DRR
#'
#' @details adds uses the DataStore Reference ID for an associate DRR to the <usageCitation> as a properly formatted DOI (prefaced with "DRR: ") to the <usageCitation> element. Creates and populates required children elements for usageCitation including the DRR title, creator organization name, and report number. Note the organization name (org_name) defaults to NPS. If you do NOT want the organization name for the DRR to be NPS, set org_name="Your Favorite Organization" *and* set NPS=FALSE. Also sets the id flag for this usageCitation to "associatedDRR".
#'
#' @inheritParams set_title
#' @param drr_ref_id a 7-digit string that is the DataStore Reference ID for the DRR associated with the data package.
#' @param drr_title the title of the DRR as it appears in the DataStore Reference.
#' @param org_name String. Defaults to NPS. If the organization publishing the DRR is *not* NPS, set org_name to your publishing organization's name.
#'
#' @returns an EML-formatted R object
#' @export
#' @examples
#' \dontrun{
#' drr_title <- "Data Release Report for Data Package 1234"
#' set_drr(eml_object, "2293234", drr_title)
#' }
set_drr <- function(eml_object,
drr_ref_id,
drr_title,
org_name = "NPS",
force = FALSE,
NPS = TRUE) {
doi <- paste0("DRR: https://doi.org/10.36967/", drr_ref_id)
cite <- EML::eml$usageCitation(
alternateIdentifier = doi,
title = drr_title,
creator = EML::eml$creator(
organizationName = org_name
),
report = EML::eml$report(reportNumber = drr_ref_id),
id = "associatedDRR"
)
if (force == TRUE) {
eml_object$dataset$usageCitation <- cite
}
if (force == FALSE) {
doc <- eml_object$dataset$usageCitation
if (is.null(doc) == TRUE) {
cat("No previous DRR was detected")
eml_object$dataset$usageCitation <- cite
cat("Your DRR, ", crayon::blue$bold(drr_title),
" has been added.", sep = "")
} else {
cat("Your current DRR is: ", crayon::blue$bold(doc$title),
".\n", sep = "")
cat("The current DOI is: ", crayon::blue$bold(doc$alternateIdentifier),
".\n",
sep = ""
)
cat("Are you sure you want to change it?\n")
var1 <- .get_user_input() #1 = Yes; 2 = No
if (var1 == 1) {
eml_object$dataset$usageCitation <- cite
cat("Your new DRR is: ", crayon::blue$bold(doc$title), ".\n", sep = "")
cat("Your new DOI is: ", crayon::blue$bold(doc$alternateIdentifier),
".\n",
sep = ""
)
}
if (var1 == 2) {
cat("Your original DRR was retained")
}
}
}
# Set NPS publisher, if it doesn't already exist
if (NPS == TRUE) {
eml_object <- .set_npspublisher(eml_object)
}
# add/update EMLeditor and version to metadata:
eml_object <- .set_version(eml_object)
return(eml_object)
}
#' adds an abstract
#'
#' @description `set_abstract()` adds (or replaces) a simple abstract.
#'
#' @details Checks for an abstract. If no abstract is found, it inserts the abstract given in @param abstract. If an existing abstract is found, the user is asked whether they want to replace it or not and the appropriate action is taken. Currently set_abstract does not allow for complex formatting such as bullets, tabs, or multiple spaces. You can add line breaks with "\\n" and a new paragraph (blank line between text) with "\\n\\n". You are strongly encouraged to open your abstract in a text editor such as notepad and make sure there are no stray characters. If you need multiple paragraphs, you will need to do that via EMLassemblyline (for now).
#'
#' @inheritParams set_title
#' @param abstract is a text string that is your abstract. You can generate this directly in R or import a .txt file.
#'
#' @returns an EML-formatted R object
#' @export
#' @examples
#' \dontrun{
#' eml_object <- set_abstract(eml_object, "This is a very short abstract")
#' }
set_abstract <- function(eml_object,
abstract,
force = FALSE,
NPS = TRUE) {
# scripting route:
if (force == TRUE) {
eml_object$dataset$abstract <- abstract
}
# interactive route:
if (force == FALSE) {
# get existing abstract, if any:
doc <- eml_object$dataset$abstract
if (is.null(doc)) {
eml_object$dataset$abstract <- abstract
cat("No previous abstract was detected.\n")
cat("Your new abstract has been added.\n")
cat("View the current abstract using get_abstract.")
} else {
cat("Your EML already has an abstract.\n")
cat("Are you sure you want to replace it?\n\n")
var1 <- .get_user_input() #1 = yes, 2 = no
# if User opts to replace abstract:
if (var1 == 1) {
# print the existing DOI to the screen:
eml_object$dataset$abstract <- abstract
cat("You have replaced your abstract.\n")
cat("View the current abstract using get_abstract.")
}
# if User opts not to replace abstract:
if (var1 == 2) {
cat("Your original abstract was retained.\n")
cat("View the current abstract using get_abstract.")
}
}
}
# Set NPS publisher, if it doesn't already exist
if (NPS == TRUE) {
eml_object <- .set_npspublisher(eml_object)
}
# add/update EMLeditor and version to metadata:
eml_object <- .set_version(eml_object)
return(eml_object)
}
#' Set Notes for DataStore landing page
#'
#' @description `set_additional_info()` will add information to the additionalInfo element in EML.
#'
#' @details The contents of the additionalInformation element are used to populate the 'notes' field on the DataStore landing page. Users may want to edit the notes if errors or non-ASCII text characters are discovered because the notes are prominently displayed on DataStore. To avoid non-standard characters, users are highly encouraged to generate Notes using a text editor such as Notepad rather than a word processor such as MS Word.
#'
#' At this time, `set_additional_info()` does not support complex formatting such as, bullets, tabs, or multiple spaces. You can add line breaks with "\\n" and a new paragraph (a blank line between text) with "\\n\\n".
#'
#' @inheritParams set_title
#' @param additional_info String. Will become the "notes" on the DataStore landing page.
#'
#' @return an EML-formated R object
#' @export
#'
#' @examples
#' \dontrun{
#' eml_object <- set_additional_info(eml_object,
#' "Some text for the Notes section on DataStore.")
#' }
set_additional_info <- function(eml_object,
additional_info,
force = FALSE,
NPS = TRUE) {
# scripting route:
if (force == TRUE) {
eml_object$dataset$additionalInfo <- additional_info
}
# interactive route:
if (force == FALSE) {
# get existing abstract, if any:
doc <- eml_object$dataset$additionalInfo
if (is.null(doc)) {
eml_object$dataset$additionalInfo <- additional_info
cat("No previous additionalInfo was detected.\n")
cat("Your new additionalInfo has been added.\n")
cat("View the current additionalInfo using get_additional_info.")
} else {
cat("Your EML already has additionalInfo.\n")
cat("Are you sure you want to replace it?\n\n")
var1 <- .get_user_input() #1 = yes, 2 = no
# if User opts to replace abstract:
if (var1 == 1) {
# print the existing DOI to the screen:
eml_object$dataset$additionalInfo <- additional_info
cat("You have replaced your additionalInfo.\n")
cat("View the current additionalInfo using get_additional_info.")
}