Pass all R CMD checks

.Rbuildignore

@@ -1,3 +1,4 @@
 ^.*\.Rproj$
 ^\.Rproj\.user$
-^README.md
+^README.md
+NOTICE

DESCRIPTION

@@ -2,19 +2,21 @@ Package: loadtest
 Type: Package
 Title: HTTP load testing directly from R
 Version: 0.1.2
-Author@R: person("Jacqueline", "Nolis", email = "jacqueline.nolis2@t-mobile.com", role = c("aut", "cre"))
-Description: This package allows you to run a load test of an HTTP request, such as for an R plumber REST API, from within R
+Authors@R: person("Jacqueline", "Nolis", email = "jacqueline.nolis2@t-mobile.com", 
+                 role = c("aut", "cre"))
+Description: This package allows you to run a load test of an HTTP request, 
+  such as for an R plumber REST API, from within R.
 License: file LICENSE
 Encoding: UTF-8
 LazyData: true
 Imports:
   glue (>= 1.3.1),
   jsonlite (>= 1.6)
-RoxygenNote: 6.1.1
+RoxygenNote: 7.1.0
 Suggests: 
-    testthat,
-    rmarkdown,
-    ggplot2,
-    dplyr,
-    tidyr
+  testthat,
+  rmarkdown,
+  ggplot2,
+  dplyr,
+  tidyr
 SystemRequirements: Both Java 8+ and Apache JMeter are installed

R/loadtest.R

@@ -18,6 +18,60 @@
 # software without specific prior written permission.
 # =========================================================================
 
+## quiets concerns of R CMD check re: the variables in pipelines
+if (getRversion() >= "2.15.1") {
+  utils::globalVariables(
+    c(
+      ".", "time_since_start", "elapsed", "request_status", "elapsed", "thread",
+      "time_since_start_rounded", "n", "p", "label"
+    )
+  )
+}
+
+#' Convert a query string into its parts
+#'
+#' This function gets the query parameters from a url as input,
+#' and outputs a list. Each element's name is the name of the parameters,
+#' and each element's value is the parameter's value.
+#'
+#' @param query_string a string containing the query parameters e.g.: "postId=1&userId=1"
+#'
+#' @return a list
+#'
+#' @examples
+#' parse_query_string("postId=1&userId=1")
+parse_query_string <- function(query_string) {
+  query_parts <- strsplit(query_string, "&", fixed = TRUE)[[1]]
+  parameters <- strsplit(query_parts, "=", fixed = TRUE)
+  valid_parameters <- parameters[sapply(parameters, length) == 2]
+
+  if (length(valid_parameters) < length(parameters)) {
+    warning(
+      paste("The following parameters did not have a value and were dropped:",
+            paste(sapply(setdiff(parameters, valid_parameters), "[[", 1), collapse = ", "))
+    )
+  }
+
+  keys <- sapply(valid_parameters, "[[", 1)
+  decoded_keys <- unname(sapply(keys, URLdecode))
+
+  parameter_values <- sapply(valid_parameters, "[[", 2)
+  decoded_values <- unname(sapply(parameter_values, URLdecode))
+
+  return_list <- as.list(setNames(decoded_values, decoded_keys))
+
+  unique_names <- unique(names(return_list))
+
+  if (length(unique_names) < length(names(return_list))) {
+    warning(
+      paste("Duplicate parameters found, using only the first occurence of:",
+            paste(names(return_list)[duplicated(return_list)]), collapse = ", ")
+    )
+  }
+
+  return_list[unique_names]
+}
+
 
 #' Convert a url into core components
 #'
@@ -43,8 +97,15 @@ parse_url <- function(url){
     protocol <- "http"
   }
 
-  domain <- parsed_url[[3]]
-  path <- parsed_url[[5]]
+  domain <- gsub("/", "", parsed_url[[3]])
+  full_path <- parsed_url[[5]]
+  path_elements <- strsplit(parsed_url[[5]], "\\?")
+
+  if (length(path_elements[[1]]) == 0) {
+    path <- "/"
+  } else {
+    path <- path_elements[[1]][[1]]
+  }
 
   # find the port
   port <- parsed_url[[4]]
@@ -57,9 +118,40 @@ parse_url <- function(url){
     }
   }
 
+  if (length(path_elements[[1]]) > 1) {
+    query_parameters <- parse_query_string(path_elements[[1]][[2]])
+    return(
+      list(protocol = protocol, domain = domain, path = path, port = port,
+           query_parameters = query_parameters)
+    )
+  }
+
   list(protocol = protocol, domain = domain, path = path, port = port)
 }
 
+#' Encode HTML/XML entities
+#'
+#' Jemeter's documentation in XML which means special characters like &, <, >
+#' need to be encoded as HTML entities. This function does that without dependencies.
+#'
+#' @param stringified_body the request body as a single string
+#'
+#' @return a string
+#'
+#' @examples
+#' encode_html_entities('{"title":"this & that"}')
+encode_html_entities <- function(stringified_body) {
+  body_noamp <- gsub("&", "&amp;", stringified_body)
+  body_noquot <- gsub("\"", "&quot;", body_noamp)
+  body_nogt <- gsub(">", "&gt;", body_noquot)
+  body_nolt <- gsub("<", "&lt;", body_nogt)
+  body_noapos <- gsub("\'", "&apos;", body_nolt)
+
+  encoded_body <- gsub("\"", "&quot;", body_noapos)
+
+  encoded_body
+}
+
 #' Run a load test of an HTTP request
 #'
 #' This is the core function of the package, which creates many HTTP requests using Apache JMeter.
@@ -126,7 +218,6 @@ loadtest <- function(url,
                      loops = 16,
                      ramp_time = 0,
                      delay_per_request = 0){
-
   invisible(check_java_installed())
   invisible(check_jmeter_installed())
 
@@ -139,6 +230,7 @@ loadtest <- function(url,
   domain <- parsed_url$domain
   path <- parsed_url$path
   port <- parsed_url$port
+  query_parameters <- parsed_url$query_parameters
 
   read_file_as_char <- function(file_name){
     readChar(file_name, file.info(file_name)$size)
@@ -147,7 +239,7 @@ loadtest <- function(url,
   template <- read_file_as_char(system.file("template.jmx", package = "loadtest")) # tempate for the full request
   header_template <- read_file_as_char(system.file("header_template.txt", package = "loadtest")) # template for each request header
   body_template <- read_file_as_char(system.file("body_template.txt", package = "loadtest")) # template for the request body, if one is needed
-
+  query_parameters_template <- read_file_as_char(system.file("query_parameters_template.txt", package = "loadtest")) # template for the query parameters, if one is needed
 
   original_headers <- headers
   original_body <- body
@@ -170,9 +262,11 @@ loadtest <- function(url,
   if(!is.null(body)){
 
     if(encode=="json"){
-      request_body <- gsub("\"", "&quot;", jsonlite::toJSON(body,auto_unbox=TRUE))
+      json_body <- jsonlite::toJSON(body,auto_unbox=TRUE)
+      request_body <- encode_html_entities(json_body)
+
     } else if(encode=="raw"){
-      request_body <- gsub("\"", "&quot;", body)
+      request_body <- request_body <- encode_html_entities(body)
     } else {
       stop("'encode' value not yet supported")
     }
@@ -181,6 +275,13 @@ loadtest <- function(url,
     body <- ""
   }
 
+  if (!is.null(query_parameters)) {
+    query_parameters_in_template <- lapply(seq_along(query_parameters), function(i) glue::glue(query_parameters_template, name=names(query_parameters)[[i]],value=query_parameters[[i]]))
+    query_parameters <- paste0(query_parameters_in_template,collapse="\n")
+  } else {
+    query_parameters <- ""
+  }
+
   # where to save the test specification
   spec_location <- tempfile(fileext = ".jmx")
 
@@ -199,7 +300,7 @@ loadtest <- function(url,
   message("loadtest - completed load test")
 
   # read back in the results as a data frame -------------------------------
-  output <- read.csv(save_location,
+  output <- utils::read.csv(save_location,
                             stringsAsFactors = FALSE,
                             colClasses = c(
                               timeStamp = "numeric",

R/loadtest_report.R

@@ -23,7 +23,7 @@
 #'
 #' This function uses R markdown to take the results of a jmeter run and turn it
 #'
-#' @param result the output of using loadtest()
+#' @param results the output of using loadtest()
 #' @param output_file the location to save the report. Defaults to creating loadtest_report.html in the working directory.
 #' @examples
 #' results <- loadtest(url = "https://www.t-mobile.com", method="GET", threads = 3, loops = 5)

R/plots.R

@@ -25,7 +25,7 @@
 #' @return A ggplot2 showing the elapsed times of the requests during the test
 #' @examples
 #' results <- loadtest("google.com","GET")
-#' plot_elapsed_times(result)
+#' plot_elapsed_times(results)
 #' @export
 plot_elapsed_times <- function(results){
   if (!requireNamespace("ggplot2", quietly = TRUE)) {
@@ -42,7 +42,7 @@ plot_elapsed_times <- function(results){
     ggplot2::scale_color_manual(values=c("#606060", "#E20074"), drop=FALSE)+
     ggplot2::theme(legend.position = "bottom")+
     ggplot2::scale_y_continuous(limits=c(0,NA))+
-    ggplot2::geom_hline(yintercept = median(results$elapsed))
+    ggplot2::geom_hline(yintercept = stats::median(results$elapsed))
 }
 
 #' Plot the elapsed times of the requests as a histogram

inst/query_parameters_template.txt

@@ -0,0 +1,7 @@
+              <elementProp name="{name}" elementType="HTTPArgument">
+                <boolProp name="HTTPArgument.always_encode">true</boolProp>
+                <stringProp name="Argument.value">{value}</stringProp>
+                <stringProp name="Argument.metadata">=</stringProp>
+                <boolProp name="HTTPArgument.use_equals">true</boolProp>
+                <stringProp name="Argument.name">{name}</stringProp>
+              </elementProp>

inst/template.jmx

@@ -27,6 +27,11 @@
       <hashTree>
         <HTTPSamplerProxy guiclass="HttpTestSampleGui" testclass="HTTPSamplerProxy" testname="HTTP Request" enabled="true">
           {body}
+          <elementProp name="HTTPsampler.Arguments" elementType="Arguments" guiclass="HTTPArgumentsPanel" testclass="Arguments" testname="Query parameters" enabled="true">
+            <collectionProp name="Arguments.arguments">
+            {query_parameters}
+            </collectionProp>
+          </elementProp>
           <stringProp name="HTTPSampler.domain">{domain}</stringProp>
           <stringProp name="HTTPSampler.port">{port}</stringProp>
           <stringProp name="HTTPSampler.protocol">{protocol}</stringProp>