[Distr-commits] r920 - pkg/utils
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Sep 13 10:38:35 CEST 2013
Author: ruckdeschel
Date: 2013-09-13 10:38:35 +0200 (Fri, 13 Sep 2013)
New Revision: 920
Added:
pkg/utils/DESCRIPTIONutilsExamples.R
Modified:
pkg/utils/DESCRIPTIONutils.R
Log:
updated DESCRIPTIONutils.R -> pls check if also works on Linux / in particular whether getRevNr() works (in file getRevNr.R)
Modified: pkg/utils/DESCRIPTIONutils.R
===================================================================
--- pkg/utils/DESCRIPTIONutils.R 2013-09-13 07:45:16 UTC (rev 919)
+++ pkg/utils/DESCRIPTIONutils.R 2013-09-13 08:38:35 UTC (rev 920)
@@ -1,7 +1,5 @@
### some utils for unified treatment of DESCRIPTION files from R
-source("C:/rtest/distr/branches/distr-2.4/pkg/utils/getRevNr.R")
-
updatePackageHelp <- function(package){
if(file.exists(file.path(package, "DESCRIPTION"))){
DFF <- read.dcf(file = file.path(package, "DESCRIPTION"))
@@ -25,76 +23,98 @@
}}
}
+## needs: getRevNr() in getRevNr.R in utils/ e.g.
+## source("C:/rtest/distr/branches/distr-2.4/pkg/utils/getRevNr.R")
-changeDescription <- function(startDir, names, values,
- pkgs = NULL,
- withSVNread = TRUE,
- withPackageHelpUpdate = TRUE,
- pathRepo = NULL,
- withDate = TRUE){
- oldDir <- getwd()
- on.exit(setwd(oldDir))
- setwd(startDir)
- if(withSVNread){
- startD <- gsub("/branches/[^/]+","",startDir)
- if(is.null(pathRepo)) pathRepo <- gsub(".*/([^/]+)/*$","\\1", startD)
- svnrev <- getRevNr(startD, pathRepo)[[1]]
- print(svnrev)
- if("SVNRevision" %in% names){
- values[which(names=="SVNRevision"),] <- svnrev
- }else{
- nr <- nrow(values)
- names <- c(names,"SVNRevision")
- values <- rbind(values,rep(svnrev,ncol(values)))
- rownames(values)[nr+1] <- "SVNRevision"
- }
- }
- if(withDate){
- if(!"Date" %in% names){
- nr <- nrow(values)
- dat <- format(Sys.time(), format="%Y-%m-%d")
- names <- c(names,"Date")
- values <- rbind(values,rep(dat,ncol(values)))
- rownames(values)[nr+1] <- "Date"
- }
- }
-# print(names)
-# print(values)
-
- if(is.matrix(values) && is.null(colnames(values)))
- colnames(values) <- rep(pkgs, length.out = ncol(values))
-
- if(is.null(pkgs)) {
- pkgs <- pkgs <- dir("pkg/")
- idx <- grep(".+\\.",pkgs)
- if(length(idx)) idx <- -idx else idx <- TRUE
- pkgs <- pkgs[idx]
- }
- if (length(pkgs) && length(names) && length(values)){
- pkgs <- pkgs[sapply(pkgs, function(x)
- file.exists(paste("pkg/",x,"/DESCRIPTION",sep="")))]
+ changeDescription <- function(startDir ## folder with pkgs to be updated,
+ ### e.g. "C:/rtest/distr/branches/distr-2.6"
+ ,names ### names of the DESCRIPTION tags to be updated
+ ,values ### values of the DESCRIPTION tags to be updated
+ ## (a matrix, columns = pkgs and row = tags see examples)
+ ,pkgs = NULL ## pkgs to be updated; if NULL all pkgs in startfolder
+ ,withSVNread = TRUE ### should SVNRevision be updated
+ ,withPackageHelpUpdate = TRUE ### should file <pkg>-package.Rd in man
+ ## be updated
+ ,pathRepo = NULL ### path to svn repo; if NULL deduced from startDir
+ ### assuming r-forge
+ ,withDate = TRUE, ### shall date be updated?
+ inRforge = TRUE, ### shall we use r-forge as repository
+ ## (otherwise need full URL as arg pathRepo
+ withlogin = TRUE, ### do we need option --login (yes in cygwin, don't know in Linux)
+ PathToBash = "C:/cygwin/bin/bash", ## path to bash
+ PathToreadsvnlog.sh="C:/rtest/distr/branches/distr-2.4/pkg/utils",
+ ### path to shell script readsvnlog.sh
+ tmpfile = "C:/rtest/tmp-svnlog5.txt", ### some tmpfile to which we write the
+ ## results temporarily; is deleted afterwords
+ verbose=FALSE
+ verbose = FALSE){
+ oldDir <- getwd()
+ on.exit(setwd(oldDir))
+ setwd(startDir)
+ if(withSVNread){
+ startD <- gsub("/branches/[^/]+","",startDir)
+ if(is.null(pathRepo)) pathRepo <- gsub(".*/([^/]+)/*$","\\1", startD)
+ svnrev <- getRevNr(startD, pathRepo, inRforge, withlogin,
+ PathToBash, PathToreadsvnlog.sh)[[1]]
+ print(svnrev)
+ if("SVNRevision" %in% names){
+ values[which(names=="SVNRevision"),] <- svnrev
+ }else{
+ nr <- nrow(values)
+ names <- c(names,"SVNRevision")
+ values <- rbind(values,rep(svnrev,ncol(values)))
+ rownames(values)[nr+1] <- "SVNRevision"
+ }
+ }
+ if(withDate){
+ if(!"Date" %in% names){
+ nr <- nrow(values)
+ dat <- format(Sys.time(), format="%Y-%m-%d")
+ names <- c(names,"Date")
+ values <- rbind(values,rep(dat,ncol(values)))
+ rownames(values)[nr+1] <- "Date"
+ }
+ }
+ # print(names)
+ # print(values)
- if(!is.matrix(values))
- values <- matrix(values, length(names), length(pkgs),
- dimnames = list(names, pkgs))
- else values <- values[,pkgs,drop=F]
- # get packages
- sapply(pkgs, function(x){
- FN <- file.path("pkg",x,"DESCRIPTION")
- xx <- read.dcf(FN)
-# print(xx)
-# print(values)
-# print(names)
-# print(values[names,x])
-# print(xx[,names])
- xx[,names] <- values[names,x]
- write.dcf(xx, file=FN,width=1.2*getOption("width"))
- if(withPackageHelpUpdate)
- updatePackageHelp(package=file.path("pkg",x))
- })
+ if(is.matrix(values) && is.null(colnames(values)))
+ colnames(values) <- rep(pkgs, length.out = ncol(values))
+ if(is.null(pkgs)) {
+ pkgs <- pkgs <- dir("pkg/")
+ idx <- grep(".+\\.",pkgs)
+ if(length(idx)) idx <- -idx else idx <- TRUE
+ pkgs <- pkgs[idx]
+ }
+ if (length(pkgs) && length(names) && length(values)){
+ pkgs <- pkgs[sapply(pkgs, function(x)
+ file.exists(file.path("pkg",x,"DESCRIPTION")))]
+ print(pkgs)
+ if(!is.matrix(values))
+ values <- matrix(values, length(names), length(pkgs),
+ dimnames = list(names, pkgs))
+ else values <- values[,pkgs,drop=F]
+ # get packages
+ sapply(pkgs, function(x){
+ FN <- file.path("pkg",x,"DESCRIPTION")
+ xx <- read.dcf(FN)
+ if(verbose){
+ print(xx)
+ print(values)
+ print(names)
+ print(values[names,x])
+ print(xx[,names])
+ }
+ xx[,names] <- values[names,x]
+ print(xx[,names])
+ write.dcf(xx, file=FN,width=1.2*getOption("width"))
+ if(withPackageHelpUpdate)
+ updatePackageHelp(package=file.path("pkg",x))
+ })
+ }
+ return(invisible())
}
- return(invisible())
-}
+### Examples see DESCRIPTIONutilsExamples.R in same folder
getVersions <- function(startDir = "C:/rtest/robast/branches/robast-0.7",
pkgs){
@@ -104,98 +124,8 @@
ff[1,"Version"]}))}
-##############################################################################
-# EXAMPLES
-##############################################################################
-if(FALSE){## Example 1
-Pkgs <- c("startupmsg", "SweaveListingUtils",
- "distr", "distrEx", "distrDoc",
- "distrMod", "distrTeach", "distrSim", "distrTEst")
-Names <- c("Version", "License", "Date")
-Values <- matrix(c("2.0.2","LGPL-3"),3,length(Pkgs))
-colnames(Values) <- Pkgs
-rownames(Values) <- Names
-Values["Version",] <- c("0.5.2", "0.1.1", "2.0.3", "2.0.2", "2.0.3",
- rep("2.0.2",4))
-changeDescription(startDir = "C:/rtest/distr",names=Names,
- pkgs=Pkgs, values=Values)
-}
-if(FALSE){## Example 2
-Pkgs <- c("SweaveListingUtils", "distr", "distrEx",
- "distrMod", "distrTeach", "distrSim", "distrTEst")
-Names <- c("Date")
-Values <- matrix((format(Sys.time(), format="%Y-%m-%d")),1,length(Pkgs))
-colnames(Values) <- Pkgs
-rownames(Values) <- Names
-changeDescription(startDir = "C:/rtest/distr",names="Date",
- pkgs=Pkgs, values=format(Sys.time(), format="%Y-%m-%d"))
-}
-if(FALSE){### Version 2.4.1
-Pkgs <- c("startupmsg", "SweaveListingUtils",
- "distr", "distrEx", "distrDoc",
- "distrMod", "distrTeach", "distrSim",
- "distrTEst", "distrEllipse", "distrRmetrics")
-Names <- c("Version")
-Values <- matrix(c("2.4.1",1,length(Pkgs))
-colnames(Values) <- Pkgs
-rownames(Values) <- Names
-Values["Version",,drop=FALSE] <- c("0.8.1", "0.6.1", rep("2.4.1",9))
-changeDescription(startDir = "C:/rtest/distr",names=Names,
- pkgs=Pkgs, values=Values)
-}
-if(FALSE){### Version 0.9.1
-Pkgs <- c("RobLox", "RobLoxBioC", "RobRex", "ROptRegTS")
-Names <- c("Version","License")
-Values <- matrix(c("0.9","LGPL-3"),2,length(Pkgs))
-colnames(Values) <- Pkgs
-rownames(Values) <- Names
-changeDescription(startDir = "C:/rtest/robast",names=Names,
- pkgs=Pkgs, values=Values)
-}
-if(FALSE){
-Pkgs <- c("RandVar", "ROptEstOld")
-Names <- c("Version","License")
-Values <- matrix(c("0.9.1","LGPL-3"),2,length(Pkgs))
-colnames(Values) <- Pkgs
-rownames(Values) <- Names
-changeDescription(startDir = "C:/rtest/robast",names=Names,
- pkgs=Pkgs, values=Values)
-
-Pkgs <- c("RandVar", "ROptEstOld", "RobAStBase", "RobAStRDA", "RobLox", "RobRex", "RobLoxBioC", "ROptEst", "RobExtremes", "ROptRegTS")
-Names <- c("Version")
-Values <- matrix(c("1.0"),1,length(Pkgs))
-colnames(Values) <- Pkgs
-rownames(Values) <- Names
-changeDescription(startDir = "C:/rtest/robast/branches/robast-1.0",names=Names,
- pkgs=Pkgs, values=Values)
-}
-
-if(FALSE){### Version 2.5
-Pkgs <- c("startupmsg", "SweaveListingUtils",
- "distrEx", "distrDoc",
- "distrTeach",
- "distrTEst", "distrEllipse", "distrRmetrics")
-Names <- c("Version")
-Values <- matrix(c("2.5"),1,length(Pkgs))
-colnames(Values) <- Pkgs
-rownames(Values) <- Names
-Values["Version",,drop=FALSE] <- c("0.9", "0.7", rep("2.5",6))
-changeDescription(startDir = "C:/rtest/distr",names=Names,
- pkgs=Pkgs, values=Values)
-
-Pkgs <- c("distr", "distrSim","distrMod")
-Names <- c("Version")
-Values <- matrix(c("2.6"),1,length(Pkgs))
-colnames(Values) <- Pkgs
-rownames(Values) <- Names
-changeDescription(startDir = "C:/rtest/distr/branches/distr-2.6",names=Names,
- pkgs=Pkgs, values=Values)
-}
-##############################################################################
-
-
copyDescription <- function(startDir){
oldDir <- getwd()
on.exit(setwd(oldDir))
Added: pkg/utils/DESCRIPTIONutilsExamples.R
===================================================================
--- pkg/utils/DESCRIPTIONutilsExamples.R (rev 0)
+++ pkg/utils/DESCRIPTIONutilsExamples.R 2013-09-13 08:38:35 UTC (rev 920)
@@ -0,0 +1,90 @@
+##############################################################################
+# EXAMPLES
+##############################################################################
+if(FALSE){## Example 1
+Pkgs <- c("startupmsg", "SweaveListingUtils",
+ "distr", "distrEx", "distrDoc",
+ "distrMod", "distrTeach", "distrSim", "distrTEst")
+Names <- c("Version", "License", "Date")
+Values <- matrix(c("2.0.2","LGPL-3"),3,length(Pkgs))
+colnames(Values) <- Pkgs
+rownames(Values) <- Names
+Values["Version",] <- c("0.5.2", "0.1.1", "2.0.3", "2.0.2", "2.0.3",
+ rep("2.0.2",4))
+changeDescription(startDir = "C:/rtest/distr",names=Names,
+ pkgs=Pkgs, values=Values)
+}
+
+if(FALSE){## Example 2
+Pkgs <- c("SweaveListingUtils", "distr", "distrEx",
+ "distrMod", "distrTeach", "distrSim", "distrTEst")
+Names <- c("Date")
+Values <- matrix((format(Sys.time(), format="%Y-%m-%d")),1,length(Pkgs))
+colnames(Values) <- Pkgs
+rownames(Values) <- Names
+changeDescription(startDir = "C:/rtest/distr",names="Date",
+ pkgs=Pkgs, values=format(Sys.time(), format="%Y-%m-%d"))
+}
+
+if(FALSE){### Version 2.4.1
+Pkgs <- c("startupmsg", "SweaveListingUtils",
+ "distr", "distrEx", "distrDoc",
+ "distrMod", "distrTeach", "distrSim",
+ "distrTEst", "distrEllipse", "distrRmetrics")
+Names <- c("Version")
+Values <- matrix(c("2.4.1",1,length(Pkgs))
+colnames(Values) <- Pkgs
+rownames(Values) <- Names
+Values["Version",,drop=FALSE] <- c("0.8.1", "0.6.1", rep("2.4.1",9))
+changeDescription(startDir = "C:/rtest/distr",names=Names,
+ pkgs=Pkgs, values=Values)
+}
+if(FALSE){### Version 0.9.1
+Pkgs <- c("RobLox", "RobLoxBioC", "RobRex", "ROptRegTS")
+Names <- c("Version","License")
+Values <- matrix(c("0.9","LGPL-3"),2,length(Pkgs))
+colnames(Values) <- Pkgs
+rownames(Values) <- Names
+changeDescription(startDir = "C:/rtest/robast",names=Names,
+ pkgs=Pkgs, values=Values)
+}
+if(FALSE){
+Pkgs <- c("RandVar", "ROptEstOld")
+Names <- c("Version","License")
+Values <- matrix(c("0.9.1","LGPL-3"),2,length(Pkgs))
+colnames(Values) <- Pkgs
+rownames(Values) <- Names
+changeDescription(startDir = "C:/rtest/robast",names=Names,
+ pkgs=Pkgs, values=Values)
+
+Pkgs <- c("RandVar", "ROptEstOld", "RobAStBase", "RobAStRDA", "RobLox", "RobRex", "RobLoxBioC", "ROptEst", "RobExtremes", "ROptRegTS")
+Names <- c("Version")
+Values <- matrix(c("1.0"),1,length(Pkgs))
+colnames(Values) <- Pkgs
+rownames(Values) <- Names
+changeDescription(startDir = "C:/rtest/robast/branches/robast-1.0",names=Names,
+ pkgs=Pkgs, values=Values)
+}
+
+if(FALSE){### Version 2.5
+Pkgs <- c("startupmsg", "SweaveListingUtils",
+ "distrEx", "distrDoc",
+ "distrTeach",
+ "distrTEst", "distrEllipse", "distrRmetrics")
+Names <- c("Version")
+Values <- matrix(c("2.5"),1,length(Pkgs))
+colnames(Values) <- Pkgs
+rownames(Values) <- Names
+Values["Version",,drop=FALSE] <- c("0.9", "0.7", rep("2.5",6))
+changeDescription(startDir = "C:/rtest/distr",names=Names,
+ pkgs=Pkgs, values=Values)
+
+Pkgs <- c("distr", "distrSim","distrMod")
+Names <- c("Version")
+Values <- matrix(c("2.6"),1,length(Pkgs))
+colnames(Values) <- Pkgs
+rownames(Values) <- Names
+changeDescription(startDir = "C:/rtest/distr/branches/distr-2.6",names=Names,
+ pkgs=Pkgs, values=Values)
+}
+##############################################################################
More information about the Distr-commits
mailing list