Jonathan zhu11/source (#77)

* Build source packages on the client, if the server matches (windows or unix)

* update version number

R/DESCRIPTION

@@ -1,7 +1,7 @@
 Package: sqlmlutils
 Type: Package
 Title: Wraps R code into executable SQL Server stored procedures
-Version: 0.7.3
+Version: 0.7.4
 Author: Microsoft Corporation
 Maintainer: Microsoft Corporation <msrpack@microsoft.com>
 Depends:

R/NAMESPACE

@@ -13,4 +13,3 @@ export(sql_install.packages)
 export(sql_installed.packages)
 export(sql_remove.packages)
 import(odbc)
-importFrom(utils,tail)

R/R/executeInSQL.R

@@ -238,7 +238,15 @@ execute <- function(connection, script, ...)
             hodbc <- connection
         }
 
-        queryResult <- dbSendQuery(hodbc, script, ...)
+        queryResult <- dbSendQuery(hodbc, script)
+
+        # Bind parameterized queries
+        #
+        if(length(list(...)) != 0)
+        {
+            dbBind(queryResult, ...)
+        }
+
         res <- dbFetch(queryResult)
 
         binVal <- res$returnVal

R/R/sqlPackage.R

@@ -749,7 +749,9 @@ checkVersion <- function(connectionString)
 
     if (is.character(versionClass) &&  versionClass == "ExtLib")
     {
-        return (list(serverIsWindows = serverIsWindows, rversion = serverVersion[['rversion']]))
+        return (list(serverIsWindows = serverIsWindows,
+                     rversion = serverVersion[['rversion']],
+                     sysname = serverVersion[['sysname']]))
     }
     else
     {
@@ -774,7 +776,6 @@ checkVersion <- function(connectionString)
 # SQL Server 2016 SP1  13.0.4001.0
 # SQL Server 2016      13.0.1601.5
 #
-#' @importFrom utils tail
 sqlCheckPackageManagementVersion <- function(connectionString)
 {
     versionClass <- NA
@@ -801,7 +802,8 @@ sqlCheckPackageManagementVersion <- function(connectionString)
     }
     else
     {
-        stop(sprintf("The package management feature is not enabled for the current user or not supported on SQL Server version %s", paste(tail(version, -1), collapse='.')), call. = FALSE)
+        stop(sprintf("The package management feature is not enabled for the current user or not supported on SQL Server version %s",
+                     paste(utils::tail(version, -1), collapse='.')), call. = FALSE)
     }
 
     return(versionClass)
@@ -814,7 +816,6 @@ sqlCheckPackageManagementVersion <- function(connectionString)
 #   list( serverType = "azure", major = 12, minor = 0, build = 2000, revision = 8)
 #   list( serverType = "box", major = 15, minor = 0, build = 400, revision = 107)
 #
-#' @importFrom utils tail
 sqlPackageManagementVersion <- function(connectionString)
 {
     force(connectionString)
@@ -834,13 +835,13 @@ sqlPackageManagementVersion <- function(connectionString)
     {
         # SQL in Azure & Managed Instance
         #
-        pmversion <- append(list(serverType = "azure"), tail(serverProperties, -2))
+        pmversion <- append(list(serverType = "azure"), utils::tail(serverProperties, -2))
     }
     else
     {
         # SQL box product
         #
-        pmversion <- append(list(serverType = "box"), tail(serverProperties, -2))
+        pmversion <- append(list(serverType = "box"), utils::tail(serverProperties, -2))
     }
 
     return (pmversion)
@@ -1244,7 +1245,7 @@ prunePackagesToInstallExtLib <- function(dependentPackages, topMostPackages, ins
     return (list(prunedPackagesToInstall, prunedPackagesToTop))
 }
 
-downloadDependentPackages <- function(pkgs, destdir, binaryPackages, sourcePackages,
+downloadDependentPackages <- function(pkgs, destdir, binaryPackages, sourcePackages, serverVersion,
                                         verbose = getOption("verbose"), pkgType = getOption("pkgType"))
 {
     downloadedPkgs <- NULL
@@ -1259,7 +1260,6 @@ downloadDependentPackages <- function(pkgs, destdir, binaryPackages, sourcePacka
             write(sprintf("%s  Downloading package [%d/%d] %s (%s)...", pkgTime(), pkgIndex, numPkgs, pkg$Package, pkg$Version), stdout())
         }
 
-        #
         # try first binary package
         #
         downloadedPkg <- utils::download.packages(pkg$Package, destdir = destdir,
@@ -1267,11 +1267,25 @@ downloadDependentPackages <- function(pkgs, destdir, binaryPackages, sourcePacka
 
         if (length(downloadedPkg) < 1)
         {
-            #
+            write(sprintf("%s  Could not find binary version in repo, trying source instead...", pkgTime()), stdout())
+
             # try source package if binary package isn't there
             #
+            if(serverVersion$sysname == Sys.info()[['sysname']])
+            {
+                # If the server and client are the same type,
+                # with source packages, we may need to build the binary on the client
+                #
+                downloadedPkg = buildSourcePackage(pkg$Package, destdir, sourcePackages)
+            }
+            else
+            {
+                # If the server and client are NOT the same type, 
+                # we just download the source package and send it to the server to build
+                #
                 downloadedPkg <- utils::download.packages(pkg$Package, destdir = destdir,
-                                                      available = sourcePackages, type = "source", quiet = TRUE)
+                                                          available = sourcePackages, type = pkgType, quiet = TRUE)
+            }
         }
 
         if (length(downloadedPkg) < 1)
@@ -1290,6 +1304,49 @@ downloadDependentPackages <- function(pkgs, destdir, binaryPackages, sourcePacka
     return (downloadedPkgs)
 }
 
+buildSourcePackage <- function(name, destdir, sourcePackages)
+{
+    # Download the source package to the destdir folder
+    #
+    downloadedPkg <- utils::download.packages(name, destdir = destdir,
+                                              available = sourcePackages, type = "source", quiet = TRUE)
+    pkgPath <- normalizePath(downloadedPkg[1,2], mustWork = FALSE)
+
+    write(sprintf("%s  Found source package, building into a binary package...", pkgTime()), stdout())
+
+    # Build the source into a binary package.
+    # This will also install the package to the destdir since we cannot build without installing.
+    # 
+    utils::install.packages(pkgPath, INSTALL_opts = "--build",
+                            repos=NULL, lib = destdir, quiet = TRUE)
+
+    # Find the binary (zip for Windows, tar.gz for Unix) that was created. 
+    # install.packages creates the binary file in the current working directory.
+    #
+    binaryFile = list.files(pattern=utils::glob2rx(paste0(name, "*zip")))[1]
+
+    if(is.na(binaryFile))
+    {
+        binaryFile = list.files(pattern=utils::glob2rx(paste0(name, "*tar.gz")))[1]
+    }
+
+    pkgMatrix = NULL
+
+    # Copy the binary file from the current working directory to the destdir
+    # so we know exactly where it is. 
+    # Construct a matrix with similar structure to download.packages return value.
+    # 
+    if(!is.na(binaryFile))
+    {
+        if(file.copy(from=binaryFile, to=destdir))
+        {
+            file.remove(binaryFile)
+            pkgMatrix = matrix(c(name, file.path(destdir, binaryFile)), ncol=2)
+        }
+    }
+
+    pkgMatrix
+}
 
 #
 # Installs packages using external library ddl support
@@ -1377,6 +1434,7 @@ sqlInstallPackagesExtLib <- function(connectionString,
         else if (scope == "PRIVATE")
         {
             # fail dbo calls to install to private scope as dbo can only install to public
+            #
             scopeint <- parseScope(scope)
             allowed <- sqlCheckPermission(connectionString, scope, owner)
 
@@ -1409,6 +1467,7 @@ sqlInstallPackagesExtLib <- function(connectionString,
     }
 
     # check scope and permission to write to scoped folder
+    #
     scope <- normalizeScope(scope)
     scopeint <- parseScope(scope)
 
@@ -1550,7 +1609,7 @@ sqlInstallPackagesExtLib <- function(connectionString,
                 #
                 downloadPkgs <- downloadDependentPackages(pkgs = pkgsToDownload, destdir = downloadDir,
                                                           binaryPackages = binaryPackages, sourcePackages = sourcePackages,
-                                                          verbose = verbose, pkgType = pkgType)
+                                                          serverVersion=serverVersion, verbose = verbose, pkgType = pkgType)
             }
 
             if (length(pkgsToDownload) > 0)

R/README.md

@@ -8,7 +8,7 @@ sqlmlutils is an R package to help execute R code on a SQL database (SQL Server
 From command prompt, run 
 ```
 R.exe -e "install.packages('odbc')"
-R.exe CMD INSTALL dist/sqlmlutils_0.7.3.zip
+R.exe CMD INSTALL dist/sqlmlutils_0.7.4.zip
 ```
 OR
 To build a new package file and install, run
@@ -19,7 +19,7 @@ To build a new package file and install, run
 ### Linux
 ```
 R.exe -e "install.packages('odbc')"
-R.exe CMD INSTALL dist/sqlmlutils_0.7.3.tar.gz
+R.exe CMD INSTALL dist/sqlmlutils_0.7.4.tar.gz
 ```
 
 # Getting started

README.md

@@ -29,7 +29,7 @@ Windows:
 From command prompt, run 
 ```
 R.exe -e "install.packages('odbc')"
-R.exe CMD INSTALL dist/sqlmlutils_0.7.3.zip
+R.exe CMD INSTALL dist/sqlmlutils_0.7.4.zip
 ```
 OR
 To build a new package file and install, run
@@ -40,7 +40,7 @@ To build a new package file and install, run
 Linux
 ```
 R.exe -e "install.packages('odbc')"
-R.exe CMD INSTALL dist/sqlmlutils_0.7.3.tar.gz
+R.exe CMD INSTALL dist/sqlmlutils_0.7.4.tar.gz
 ```
 
 # Details