R/citation.R

##-------------------------------------------------------------
## 
##-------------------------------------------------------------
write.bbtex = function(pkgs, file = "", delete = TRUE, tweak = NULL)
{
	#if(missing(file)) stop("\nfalta o nome do arquivo", call. = FALSE)
	
	if(missing(pkgs)) stop("\nfalta o nome do pacote", call. = FALSE)
	
	## verifica nome e dir
	if(file == "") nome = file else nome = .dir_file(file)
	
	if(delete) if(file.exists(nome)) file.remove(nome)
	
	pp = .bbtex(pkgs, tweak = tweak)
	
	
	if(file != "")
	{
		ini = paste("Automatically generated by package bibliotheca", 
				packageVersion("bibliotheca"), Sys.Date(), "\n\n")
		
		write(ini, file = nome, append = TRUE)
	}#end if
	
	if(is.null(tweak))
	{
		for(i in pkgs) write(unlist(pp[[i]]), file = nome, append = TRUE)
	} else {
		pp = lapply(pkgs, .bbtex, tweak=tweak)
		for(i in 1:length(pkgs)) write(unlist(pp[[i]]), file = nome, append = TRUE)
	}#end if
	
}#end write.bbtex

##----------------------------------------------------------------------------
##
##----------------------------------------------------------------------------
.hat = function(aa, pkg, year = "", tweak = NULL)
{
	y = aa["year"]
	
	n = length(aa) 
	p = length(aa) + 1
	
	if(is.na(y))
	{
		y = year
		aa[n] = sprintf("  year = {%s},", y)
		aa[p] = "}"
	}#end if
	
	if(is.null(tweak))
	{
		y1 = gsub("  year = \\{|\\},", "", y)
		ini = gsub(",", "%s,", aa[1])
		aa[1] = sprintf(ini, paste(pkg, y1, sep=""))
	} else {
		ini = gsub(",", "%s,", aa[1])
		aa[1] = sprintf(ini, tweak)
	}#end if
	
	return(aa)
}#end .hat

##----------------------------------------------------------------------------
##
##----------------------------------------------------------------------------
.bbt = function(pkg, tweak = NULL)
{
	pk = suppressMessages(suppressWarnings(utils::citation(pkg)))
	
	np = length(pk)
	
	bb = lapply(pk, utils::toBibtex)
	
	pcs = lapply(bb, .hat, pkg, tweak = tweak)
	
	if(is.null(tweak))
	{
		nome.pk = paste(pkg, c(1:np), sep="_")
	} else {
		nome.pk = paste(tweak, c(1:np), sep="_")
	}
	
	names(pcs) = nome.pk
	
	return(pcs)
}#end .bbt

##----------------------------------------------------------------------------
##
##----------------------------------------------------------------------------
altera = function(x, PP)
{
	n = PP[[x]]
	
	aut = NULL
	for(i in 1:length(n))
	{
		
		aa = PP[[x]][[i]]
		
		aut[i] = gsub("@.*\\{|,", "", aa[1])
	}#end for
	
	# FIXME: corrigir nĂºmero de duplicatas
	pac = unique(aut[duplicated(aut)])
	
	w = NULL
	if(length(pac) != 0)
	{
		zz = PP[[x]]
		
		id = grep(pac, zz)
		aa = PP[[x]][id]
		
		for(i in 1:length(aa))
		{
			bb = aa[[i]]
			ini = gsub("\\{.*,", "\\{%s,", bb[1])
			bb[1] = sprintf(ini, paste0(pac, letters[i]))
			w[i] = list(bb)
		}#end for
	}#end if
	
	if(!is.null(w))
	{
		nm = names(aa)
		
		names(w) = nm
		
		PP[[x]][nm] = w
	}#end if
	
	PP[[x]]
}#end altera


##----------------------------------------------------------------------------
##
##----------------------------------------------------------------------------
duplicados = function(pp)
{
	nome = NULL
	for(i in 1:length(pp))
	{
		if(length(pp[[i]]) > 1) 
		{
			nome1 = names(pp[i])		
			nome = c(nome, nome1)
		}#end if
	}#end for
	nome
}#end duplicados


.bbtex = function(pkgs, tweak = NULL)
{
	PP = lapply(pkgs, .bbt, tweak = tweak)
	
	if(is.null(tweak)) names(PP) = pkgs else names(PP) = tweak
	
	nome = duplicados(PP)
	
	if(is.null(tweak))
	{
		for(i in nome)
		{
			PP[[i]] = altera(i, PP)
		}#end for
	} else {
		for(i in 1:length(pkgs))
		{
			PP[[i]] = altera(tweak, PP[i])
		}#end for
	}
	PP
}#end .bbtex

##----------------------------------------------------------------------------
##
##----------------------------------------------------------------------------
.dir_file = function(fn)
{
	filen = basename(fn)
	dirn = dirname(fn)
	ext = tools::file_ext(fn)
	
	if(!dir.exists(dirn)) stop("\n diretorio nao existe", call. = FALSE)
	
	if(dirn == ".") 
	{
		if(nchar(ext) == 0)
		{
			nome = file.path(getwd(), paste0(filen, ".bib"))
		} else {
			nome = file.path(getwd(), filen)
		}#end if
		
	} else{
		if(nchar(ext) == 0)
		{
			nome = file.path(dirn, paste0(filen, ".bib"))
		} else {
			nome = file.path(dirn, filen)
		}#end if
		
	}#end if
	
	return(nome)
}#end .dir_file
salah31416/bibliotheca documentation built on June 16, 2019, 10:02 p.m.