added nga fxn started, #1

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2 (4.0.2): do not edit by hand
 
 S3method(print,muse)
+S3method(print,nga)
 export(cstmc_changes)
 export(cstmc_datasets)
 export(cstmc_group_list)
@@ -12,6 +13,7 @@ export(cstmc_tag_list)
 export(cstmc_tag_show)
 export(met_get)
 export(muse_get)
+export(nga_get)
 export(scrapi_info)
 export(scrapi_random)
 export(scrapi_search)

R/nga.R

@@ -0,0 +1,54 @@
+#' Get metadata for objects in the National Gallery of Art.
+#'
+#' @name met
+#'
+#' @param id An object id
+#' @param ... Curl args passed on to \code{\link[httr]{GET}}
+#' @examples \donttest{
+#' nga_get(id=33267)
+#' nga_get(47242)
+#' nga_get(47243)
+#' nga_get(45987)
+#' }
+
+#' @export
+#' @rdname met
+nga_get <- function(id, ...){
+  out <- musemeta_GET(sprintf(ngabase(), id), ...)
+  nga_parse(out)
+}
+
+#' @export
+print.nga <- function(x, ...){
+  cat(sprintf("<NGA metadata> %s", x$name), sep = "\n")
+  cat(sprintf("  Inscription: %s", x$inscription), sep = "\n")
+  cat(sprintf("  Provenance: %s", x$provenance), sep = "\n")
+  cat("  Exhibition history:", sep = "\n")
+  for(i in seq_along(x$history)){
+    cat(sprintf("      %s: %s", x$history[[i]]$year, x$history[[i]]$info), sep = "\n")
+  }
+  cat("  Bibliography:", sep = "\n")
+  for(i in seq_along(x$bibliography)){
+    cat(sprintf("      %s: %s", x$bibliography[[i]]$year, x$bibliography[[i]]$info), sep = "\n")
+  }
+}
+
+nga_parse <- function(x){
+  tmp <- htmlParse(x)
+  name <- xpathSApply(tmp, '//meta[@property="og:title"]', xmlGetAttr, "content")
+  prov <- xmlValue(xpathApply(tmp, "//div[@id='provenance']", xmlChildren)[[1]][['p']])
+  insc <- xmlValue(xpathApply(tmp, "//div[@id='inscription']", xmlChildren)[[1]][['p']])
+  hist <- ext_(tmp, "history")
+  biblio <- ext_(tmp, "bibliography")
+  structure(list(name=name, provenance=prov, inscription=insc, history=hist,
+                 bibliography=biblio), class="nga")
+}
+
+ngabase <- function() "http://www.nga.gov/content/ngaweb/Collection/art-object-page.%s.html"
+
+ext_ <- function(input, name){
+  tmp <- xpathApply(input, sprintf("//div[@id='%s']", name), xmlChildren)[[1]]
+  unname(lapply(tmp[ names(tmp) == "dl" ], function(x){
+    setNames(unname(sapply(c('dt','dd'), function(y) xpathApply(x, y, xmlValue))), c('year','info'))
+  }))
+}