Merge branch 'feature/simplify_getpost'

* closes #1
* feature/simplify_getpost:
  tests for catmaid neuron queries
  test fetching neuronnames
  get_compact_skeleton, get_neuron_names -> catmaid_fetch
  refactor all catmaid_(GET|POST)(J) to catmaid_fetch
  check attributes as well
  add tests for example get/post requests
  enable real tests of login using environment vars
  test catmaid_connectin and login
  Add basic test infrastructure
  add catmaid_fetch() to cover GET/POST requests

DESCRIPTION

@@ -12,8 +12,9 @@ Description: This package provide access to the API exposed by the CATMAID (C
 License: GPL-3
 URL: http://catmaid.org/ https://github.com/jefferis/rcatmaid
 BugReports: https://github.com/jefferis/rcatmaid/issues
-Depends:
+Depends: 
     httr,
     jsonlite
-Suggests:
-    nat
+Suggests: 
+    nat,
+    testthat

NAMESPACE

@@ -3,6 +3,7 @@
 export(catmaid_POST)
 export(catmaid_POSTJ)
 export(catmaid_connection)
+export(catmaid_fetch)
 export(catmaid_get_compact_skeleton)
 export(catmaid_get_neuronnames)
 export(catmaid_login)

R/catmaid_connection.R

@@ -144,22 +144,12 @@ catmaid_connection<-function(server=getOption("catmaid.server"),
 #' @seealso \code{\link{catmaid_login}}, \code{\link[httr]{GET}}, 
 #'   \code{\link[httr]{POST}}
 catmaid_GET <- function(path, conn=NULL, ...) {
-  conn=catmaid_login(conn)
-  req <- GET(url=paste0(conn$server, path), 
-             set_cookies(.cookies=conn$cookies),
-             authenticate(conn$authname,conn$authpassword), ...)
-  req
+  catmaid_fetch(path, conn=conn, include_headers=include_headers, parse.json = FALSE, ...)
 }
 
 #' @rdname catmaid_GET
 catmaid_GETJ<-function(path, conn=NULL, include_headers=TRUE, ...) {
-  req=catmaid_GET(path, conn=conn, ...)
-  parsed=catmaid_parse_json(req)
-  if(include_headers) {
-    fields_to_include=c("url", "headers")
-    attributes(parsed) = c(attributes(parsed), req[fields_to_include])
-  }
-  parsed
+  catmaid_fetch(path, conn=conn, include_headers=include_headers, parse.json = TRUE, ...)
 }
 
 catmaid_parse_json <- function(req) {
@@ -171,21 +161,36 @@ catmaid_parse_json <- function(req) {
 #' @rdname catmaid_GET
 #' @export
 catmaid_POST <- function(path, body, conn=NULL, ...) {
-  conn=catmaid_login(conn)
-  req <- POST(url=paste0(conn$server, path), body=body,
-              set_cookies(.cookies=conn$cookies),
-              authenticate(conn$authname,conn$authpassword), ...)
-  req
+  catmaid_fetch(path, body, conn=conn, include_headers=include_headers, parse.json = FALSE, ...)
 }
 
 #' @rdname catmaid_GET
 #' @export
 catmaid_POSTJ<-function(path, body, conn=NULL, include_headers=TRUE, ...) {
-  req=catmaid_POST(path, body=body, conn=conn, ...)
-  parsed=catmaid_parse_json(req)
-  if(include_headers) {
-    fields_to_include=c("url", "headers")
-    attributes(parsed) = c(attributes(parsed), req[fields_to_include])
-  }
-  parsed
+  catmaid_fetch(path, body, conn=conn, include_headers=include_headers, parse.json = TRUE, ...)
+}
+
+#' @rdname catmaid_GET
+#' @description \code{catmaid_fetch} carries out a GET operation when
+#'   \code{body=NULL}, POST otherwise.
+#' @param parse.json Whether or not to parse a JSON response to an R object
+#' @export
+catmaid_fetch<-function(path, body=NULL, conn=NULL, parse.json=TRUE, 
+                        include_headers=TRUE, ...) {
+  conn=catmaid_login(conn)
+  req<-with_config(conn$config, {
+    if(is.null(body)) {
+      GET(url=paste0(conn$server, path), ...)
+    } else {
+      POST(url=paste0(conn$server, path), body=body, ...)
+    }
+  } )
+  if(parse.json) {
+    parsed=catmaid_parse_json(req)
+    if(include_headers) {
+      fields_to_include=c("url", "headers")
+      attributes(parsed) = c(attributes(parsed), req[fields_to_include])
+    }
+    parsed
+  } else req
 }

R/catmaid_metadata.R

@@ -13,7 +13,7 @@ catmaid_get_neuronnames<-function(pid, skids, ...) {
   post_data=list(pid=pid)
   post_data[sprintf("skids[%d]", seq_along(skids))]=as.list(skids)
   path=sprintf("/%d/skeleton/neuronnames", pid)
-  res=catmaid_POSTJ(path, post_data, include_headers = F, ...)
+  res=catmaid_fetch(path, body=post_data, include_headers = F, ...)
   res=unlist(res)
   # handle any missing return values
   missing_names=setdiff(as.character(skids), names(res))

R/catmaid_skeleton.R

@@ -24,7 +24,7 @@
 #' }
 catmaid_get_compact_skeleton<-function(pid, skid, conn=NULL, connectors = TRUE, tags = TRUE, raw=FALSE, ...) {
   path=file.path("", pid, skid, ifelse(connectors, 1L, 0L), ifelse(tags, 1L, 0L), "compact-skeleton")
-  skel=catmaid_GETJ(path, conn=conn, ...)
+  skel=catmaid_fetch(path, conn=conn, ...)
   names(skel)=c("nodes", "connectors", "tags")
 
   if(raw) return(skel)

man/catmaid_GET.Rd

@@ -4,6 +4,7 @@
 \alias{catmaid_GETJ}
 \alias{catmaid_POST}
 \alias{catmaid_POSTJ}
+\alias{catmaid_fetch}
 \title{Send http GET or POST request to a CATMAID server}
 \usage{
 catmaid_GET(path, conn = NULL, ...)
@@ -13,6 +14,9 @@ catmaid_GETJ(path, conn = NULL, include_headers = TRUE, ...)
 catmaid_POST(path, body, conn = NULL, ...)
 
 catmaid_POSTJ(path, body, conn = NULL, include_headers = TRUE, ...)
+
+catmaid_fetch(path, body = NULL, conn = NULL, parse.json = TRUE,
+  include_headers = TRUE, ...)
 }
 \arguments{
 \item{path}{The path on the CATMAID server relative to the CATMAID root}
@@ -30,6 +34,8 @@ as attributes on the parsed JSON object (default \code{TRUE}).}
 \item{body}{For \code{catmaid_POST(J)} the body of the post request, usually
 in the form of a named list. See the \code{\link[httr]{POST}} documentation
 for full details.}
+
+\item{parse.json}{Whether or not to parse a JSON response to an R object}
 }
 \value{
 For \code{catmaid_GET} an object of class \code{response} or, for for
@@ -39,6 +45,9 @@ For \code{catmaid_GET} an object of class \code{response} or, for for
 \description{
 \code{catmaid_GET/POST} returns the raw response, whereas
   \code{catmaid_GET/POSTJ} parses JSON content into an R object.
+
+\code{catmaid_fetch} carries out a GET operation when
+  \code{body=NULL}, POST otherwise.
 }
 \examples{
 \dontrun{

tests/testthat.R

@@ -0,0 +1,4 @@
+library(testthat)
+library(catmaid)
+
+test_check("catmaid")

tests/testthat/test-connections.R

@@ -0,0 +1,42 @@
+context("catmaid login and get/post")
+
+# set any catmaid options from environment vars
+# they could have been exported as follows:
+# do.call(Sys.setenv, options()[grep('catmaid',names(options()))])
+catmaid_opnames=paste("catmaid", c("server", "username", "password", "authname", 
+                                   "authpassword", "authtype"),
+                      sep=".")
+catmaid_ops=Sys.getenv(catmaid_opnames)
+op=options(as.list(catmaid_ops[nzchar(catmaid_ops)]))
+
+# we can only run real tests if we can log in with default parameters
+conn=try(catmaid_login(), silent = TRUE)
+# store this in options so that we can access elsewhere
+options(catmaid_temp_conn=conn)
+
+test_that("can make a connection", {
+
+  expect_error(catmaid_connection(server="http://somewhere.org"))
+  conn<-catmaid_connection(server="https://somewhere.org", username = 'calvin', password = 'hobbes')
+  expect_is(conn, "catmaid_connection")
+  expect_is(conn$config, "config")
+})
+
+test_that("can login", {
+  if(!inherits(conn, 'try-error')){
+    expect_is(conn, 'catmaid_connection')
+    expect_is(conn$authresponse, 'response')
+    expect_equal(conn$authresponse$status, 200L)
+  }
+
+})
+
+test_that("can get and post data", {
+  if(!inherits(conn, 'try-error')){
+    expect_is(skel<-catmaid_GET("1/10418394/0/0/compact-skeleton", conn=conn), 'response')
+    expect_equivalent(neuronnames<-catmaid_POSTJ("/1/skeleton/neuronnames", conn=conn,
+                                    body=list(pid=1, 'skids[1]'=10418394, 'skids[2]'=4453485)),
+                      list(`10418394` = "IPC10", `4453485` = "IPC1"))
+    expect_equal(names(attributes(neuronnames)), c("names", "url", "headers"))
+  }  
+})

tests/testthat/test-fetch.R

@@ -0,0 +1,25 @@
+context("catmaid metadata queries")
+
+# login is handled by test-connections
+conn=getOption('catmaid_temp_conn')
+
+test_that("get neuron names", {
+  if(!inherits(conn, 'try-error')){
+    expect_equal(catmaid_get_neuronnames(pid=1, skids=c(10418394,4453485)),
+                 structure(c("IPC10", "IPC1"), .Names = c("10418394", "4453485")))
+  }
+})
+
+context("catmaid neuron queries")
+
+test_that("get neuron", {
+  if(!inherits(conn, 'try-error')){
+    expect_is(skel<-catmaid_get_compact_skeleton(pid=1, skid=10418394, conn=conn), 'list')
+  }
+})
+
+test_that("read.neron.catmaid", {
+  if(!inherits(conn, 'try-error')){
+    expect_is(skel<-read.neuron.catmaid(pid=1, skid=10418394, conn=conn), 'neuron')
+  }
+})