#15 support attachment upload

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: geonapi
 Type: Package
 Title: 'GeoNetwork' API R Interface
-Version: 0.5-3
-Date: 2022-02-21
+Version: 0.6
+Date: 2022-06-27
 Authors@R: c(person("Emmanuel", "Blondel", role = c("aut", "cre"), email = "[email protected]", comment = c(ORCID = "0000-0002-5870-5762")))
 Maintainer: Emmanuel Blondel <[email protected]>
 Description: Provides an R interface to the 'GeoNetwork' API (<https://geonetwork-opensource.org/#api>) allowing to upload and publish metadata in a 'GeoNetwork' web-application and expose it to OGC CSW.
@@ -13,4 +13,4 @@ License: MIT + file LICENSE
 URL: https://github.com/eblondel/geonapi/wiki, https://geonetwork-opensource.org
 BugReports: https://github.com/eblondel/geonapi/issues
 LazyLoad: yes
-RoxygenNote: 7.1.0
+RoxygenNote: 7.2.0

R/GNOpenAPIManager.R

@@ -423,8 +423,45 @@ GNOpenAPIManager <- R6Class("GNOpenAPIManager",
         self$ERROR(content(req))
       }
       return(out)
+    },
+
+    #'@description Uploads attachment
+    #'@param id metadata identifier
+    #'@param file file to upload
+    #'@param visibility public or private
+    #'@param approved object of class \code{logical}
+    #'@return a named list of the uploaded attachment, including the url, size, id and type, \code{NULL} otherwise
+    uploadAttachment = function(id, file, visibility = "public", approved = TRUE){
+      out <- NULL
+      self$INFO(sprintf("Attach file '%s' to record '%s'...", file, id))
+      path = sprintf("/api/records/%s/attachments?visibility=%s&approved=%s", id, visibility, approved) 
+      req <- GNUtils$POST(
+        url = self$getUrl(),
+        path = path,
+        token = private$getToken(), cookies = private$cookies,
+        user = private$user, 
+        pwd = private$getPwd(),
+        content = list(
+          file = httr::upload_file(file)
+        ),
+        contentType = "multipart/form-data",
+        encode = "multipart",
+        verbose = self$verbose.debug
+      )
+      if(status_code(req) == 201){
+        self$INFO("Successfully uploaded attachment!")
+        response <- content(req, "parsed")
+        out <- response
+        if(startsWith(out$url, "http://localhost:8080")){
+          out$url <- gsub("http://localhost:8080", paste0(unlist(strsplit(GN$getUrl(), "/"))[1:3],collapse="/"), out$url)
+        }
+      }else{
+        self$ERROR(sprintf("Error while uploading attachment - %s", message_for_status(status_code(req))))
+        self$ERROR(content(req))
+      }
+      return(out)
     }
-
+    
   )
 
 )

README.md

@@ -2,7 +2,7 @@
 ===========
 
 [![Build Status](https://github.com/eblondel/geonapi/actions/workflows/r-cmd-check.yml/badge.svg?branch=master)](https://github.com/eblondel/geonapi/actions/workflows/r-cmd-check.yml)
-[![Github_Status_Badge](https://img.shields.io/badge/Github-0.5--3-blue.svg)](https://github.com/eblondel/geonapi)
+[![Github_Status_Badge](https://img.shields.io/badge/Github-0.6-blue.svg)](https://github.com/eblondel/geonapi)
 [![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/geonapi)](https://cran.r-project.org/package=geonapi)
 [![CRAN checks](https://cranchecks.info/badges/worst/geonapi)](https://cran.r-project.org/web/checks/check_results_geonapi.html)
 [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.1345012.svg)](https://doi.org/10.5281/zenodo.1345012)