Package version checker

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: pkginstaller
 Type: Package
 Title: Addin to Install Packages From Internal Server
-Version: 0.3.0
+Version: 0.4.0
 Author: Tom Wilson
 Maintainer: <[email protected]>
 Description: An easier way to install R packages when working in a locked down 
@@ -13,4 +13,4 @@ LazyData: true
 Imports: 
     rstudioapi,
     utils
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+export(check_package_versions)
 export(get_server_path)
 export(package_installer)
 export(update_server_path)

R/check_package_versions.R

@@ -0,0 +1,105 @@
+#' Check package versions between server collection and those installed
+#'
+#' Where applicable gives the option to upgrade installed packages from server
+#' and to downgrade and install the server version where currently exceeded.
+#'
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' check_package_versions()
+#' }
+check_package_versions <- function() {
+  pkgs_server <- get_server_path()
+
+  # List all zip files in the directory
+  search_dir <- sub("file:", "", pkgs_server)
+  zip_files <- list.files(search_dir, pattern = "\\.zip$", full.names = FALSE)
+
+  if (length(zip_files) == 0) {
+    stop("No packages found. Check server packages directory")
+  }
+
+  package_name <- sub("_.*", "", zip_files)
+
+  server_v <- sub("^.*?_", "", zip_files)
+
+  server_v <- sub("\\.zip", "", server_v)
+
+  server_v <- sub("-", "\\.", server_v)
+
+  df_all <- data.frame(package_name, server_v)
+
+  # Add installed version to new column in same format
+  cat("Getting version of each installed package...\n")
+  df_all$installed_version <- sapply(df_all$package_name, function(x) {
+    # tryCatch as packages on server might not be installed
+    tryCatch(
+      {
+        version <- as.character(utils::packageVersion(x))
+      },
+      error = function(e) {
+        NA
+      }
+    )
+  })
+
+  # Filter to just Where installed
+  # but server version does not match installed version
+  df_all <- df_all[(!is.na(df_all$installed_version)) &
+    (df_all$server_v != df_all$installed_version), ]
+
+  if (nrow(df_all) == 0) {
+    cat("All installed packages match server version")
+  }
+
+  # If packages which could be upgraded give the option
+  df_upgrade <- df_all[numeric_version(df_all$server_v) >
+    numeric_version(df_all$installed_version), ]
+
+  if (nrow(df_upgrade) > 0) {
+    cat(
+      "These", nrow(df_upgrade),
+      "packages can be upgraded from the server:\n"
+    )
+    cat(df_upgrade$package_name, sep = "\n")
+    user_response <- tolower(readline(
+      prompt =
+        "Do you want to upgrade them now? (y/n)"
+    ))
+    if (user_response %in% c("y", "yes")) {
+      cat("Upgrading ", nrow(df_upgrade), " packages...\n")
+      utils::install.packages(df_upgrade$package_name,
+        repos = NULL,
+        type = "win.binary",
+        contriburl = pkgs_server
+      )
+    } else {
+      cat("Not proceeding with package upgrades.\n")
+    }
+  }
+
+
+  # If packages which could be downgraded give the option
+  df_downgrade <- df_all[numeric_version(df_all$server_v) <
+    numeric_version(df_all$installed_version), ]
+
+  if (nrow(df_downgrade) > 0) {
+    cat("These", nrow(df_downgrade),
+        "packages exceed the version on the server:\n")
+    cat(df_downgrade$package_name, sep = "\n")
+    q <- "Do you want to uninstall them and install their server version? (y/n)"
+    user_response <- tolower(readline(prompt = q))
+    if (user_response %in% c("y", "yes")) {
+      cat("Downgrading ", nrow(df_downgrade), " packages...\n")
+      utils::remove.packages(df_downgrade$package_name)
+      utils::install.packages(df_downgrade$package_name,
+        repos = NULL,
+        type = "win.binary",
+        contriburl = pkgs_server
+      )
+    } else {
+      cat("Not proceeding with package downgrades.")
+    }
+  }
+}

inst/rstudio/addins.dcf

@@ -7,3 +7,8 @@ Name: Update server packages directory
 Description: Update the directory from where packages installed.
 Binding: update_server_path
 Interactive: true
+
+Name: Check package versions
+Description: Check each package on the server matches the installed version. If not, offer to upgrade or downgrade as appropriate.
+Binding: check_package_versions
+Interactive: true