R/packages.R

In salah31416/bibliotheca: Tools Library

##-------------------------------------------------------------
## 
##-------------------------------------------------------------
packages = function(...,
					   install = TRUE, 
					   lib, 
					   lib.loc = NULL,	
					   type = getOption("pkgType"), 
					   repos = getOption("repos"), 
					   loadp = TRUE, 
					   up.date = FALSE, 
					   verbose = TRUE, 
					   suppress = TRUE)
{
	if(missing(...)) return(invisible(NULL))
	
	## nomes dos pacotes como vetor
	v = tryCatch(is.vector(...), error = function(e)return(FALSE))

	## nomes dos pacotes
	if(v) pkgs = as.vector(...) else 
		pkgs = as.character(match.call(expand.dots = FALSE)[[2]])

	PKGS = .name_pkgs(pkgs)
	pkgs_cran = PKGS$cran
	pkgs_gh = PKGS$gh$pgh
	
	pkgs = c(pkgs_cran, pkgs_gh)

	## verifica se o pacote está carregado
	pkgs = no.load(pkgs)

	if(length(pkgs)==0)return(invisible(NULL))
	
	## instala pacote fonte
	if(is.null(repos)) pkgs = unlist(lapply(pkgs, install_source))

	## nada definido sai com valor null
	if(is.null(pkgs)) return(invisible(NULL))

	## carrega o pacote
	loaded = load_pac(pkgs=pkgs, suppress = suppress)

	## ---- INSTALL ----
	if(!all(loaded))
	{	
		## pacotes não carregados	
		noload = pkgs[!loaded]

		GH = PKGS$gh
		github = GH$login_gh[GH$pgh %in% noload]
		cran = noload[noload %in% pkgs_cran]

		if(install) 
		{	## instala os pacotes
			CRAN = install_pac(cran, repos=repos, type=type, 
								  lib=lib, verbose = FALSE)

			cran_ok = CRAN$Installed

			GH = install.github(github, verbose = F)

			gh_ok = GH$Installed

			pkgok = c(gh_ok, cran_ok)

			.aviso_cran(CRAN$Table, verbose=verbose)

			.aviso_gh(GH$Table, verbose=verbose)

			## carrega após instalar
			if(length(pkgok) & loadp) {
				load_pac(pkgok, suppress = suppress)
			} else { pkgok = NULL }

		} else {
			## pacote not existe no cran
			if(verbose) mensagem(noload, msg = 2)
			pload = NULL
		}#end if
	}#end if
	
	
	if(length(pkgs[loaded]) | exists("pkgok"))
	{	## nomes dos pacotes carregados
		
		if(exists("pkgok")) 
		{
			pload = c(pkgs[loaded], pkgok) 
		} else {
			pload = pkgs[loaded]
		}#end if

		## pacote carregado
		if(length(pload))
		{
			if(up.date)
			{
				registra(pload)
				
				ploadat = upgradeable(pacs = pload, verbose=verbose)
				upd = grep("\\*", ploadat)

				if(length(upd)) 
				{
					if(verbose) mensagem(ploadat, 
							msg = 1, subtitulo="*updatable packages")
				} else {
					if(verbose) mensagem(ploadat, msg = 1)
				}#end if
			} else {

				registra(pload)
				
				ver = unlist(lapply(pload, 
						function(x){packageDescription(x, 
										fields="Version", drop=T)}))
				if(verbose) mensagem(paste(pload, ver), msg = 1)
			}#end if
		}#end if
	}#end if
	
	#pacs = ifelse(length(pload != 0), TRUE, FALSE)
	
	return(invisible(pload))
}#end function packages

##-------------------------------------------------------------
##					LOAD_PAC
##-------------------------------------------------------------
load_pac = function(pkgs, lib.loc = NULL, suppress = TRUE) 
{
	if(suppress)
	{
		loadpkgs = function(x, lib.loc)
		{
			suppressMessages(suppressWarnings(library(x, 
						quietly = F, 
						logical.return =TRUE, 
						character.only = TRUE, lib.loc))) 
		}#end function loadpkgs

	} else {

		loadpkgs = function(x, lib.loc) 
		{ 
			suppressWarnings(library(x, 
							 quietly = TRUE, 
							 logical.return =TRUE, 
							 character.only = TRUE, lib.loc)) 
		}#end function loadpkgs
	}#end if
	
	## load packages
	loaded = sapply(pkgs, loadpkgs, lib.loc=lib.loc)

	return(loaded)
	
}#end function


##-------------------------------------------------------------
##					ATUALIZA
##-------------------------------------------------------------
upgradeable = function(pacs, verbose = TRUE)
{
	
	upk = update_pac(menu = FALSE, verbose=verbose)
	
	if(is.null(upk)) 
	{ 
		ver = unlist(lapply(pacs, function(x)packageDescription(x, fields="Version", drop=T)))
		pacs = paste(pacs, ver)
		return(pacs) 
		
	} else {
		
		pk.y = pacs[pacs %in% upk$Package]
		pk.n = pacs[!pacs %in% upk$Package]
		
		if(length(pk.y))
		{
			ver1 = unlist(lapply(pk.y, function(x)packageDescription(x, fields="Version", drop=T)))
			up.yes = paste(pk.y, ver1, "*") 
			#ver1 = paste(upk$Installed, "\u2192", upk$ReposVer)
			#up.yes = paste(pk.y, ver1)
		} else up.yes = NULL
		
		if(length(pk.n))
		{
			ver2 = unlist(lapply(pk.n, function(x)packageDescription(x, fields="Version", drop=T)))
			up.no = paste(pk.n, ver2) 
		} else up.no = NULL
		
		out = c(up.yes, up.no)
		return(out)
	}#end if
}#end function

##-------------------------------------------------------------
##					NO.LOAD
##-------------------------------------------------------------
no.load = function(pkgs) 
{
	pkgs = pkgs[!pkgs %in% .packages()]

	if(length(pkgs) == 0) return(NULL) else return(pkgs)
}#end no.load


##-------------------------------------------------------------
## 
##-------------------------------------------------------------
registra = function(pkgs)
{
	info.txt = system.file('info/info.log', package = 'bibliotheca')
	
	reg = paste(format(Sys.time(), "%Y-%m-%d %X"), pkgs)
	
	cat(reg, file = info.txt, append = TRUE, sep="\n")
	
	return(invisible(NULL))
}#end registra


##-------------------------------------------------------------
## 
##-------------------------------------------------------------
.name_pkgs = function(pkgs)
{
	pgh = pkgs[grep("/", pkgs, value=F)]

	pac = pkgs[!pkgs %in% pgh]

	if(!length(pac)) pac = NULL

	if(!length(pgh))
	{
		gh = name_pgh = pgh = NULL
		#return(pac)
	} else {

		n = seq(2, 2*length(pgh), 2)

		name_pgh = unlist(strsplit(pgh, "/"))[n]

		gh = data.frame("login_gh"=pgh, "pgh"=name_pgh, stringsAsFactors=FALSE)
	}#end if

	return(list("cran"=pac, "gh"=gh))

}#end .name_pkgs