R/repo_public.R

In repo: A Data-Centered Data Flow Manager

############################################
######### PUBLIC METHODS ##################
############################################



#' Finds all items related to a set of item
#'
#' Relations are defined as in the dependency graph.
#'
#' @param names A \code{character} vector of item names.
#' @param type Can be one of "all", "to", "from". "to" recursively
#'     finds items that \code{names} is attached to. "from" recursively
#'     finds items that \code{names} depends on or is generated
#'     by. "all" finds both (connected components including \code{names}.
#' @param excludeseed logical. If set to FALSE \code{names} will be
#' not included in the output list.
#' @return A \code{character} vector of item names.
#' @seealso dependencies
repo_related <- function(names, type="all", excludeseed=F)
{            
    switch(type,
           "all" = {
               oldset <- NULL
               newset <- names
               while(! all(newset %in% oldset)) {
                   oldset <- newset
                   newset <- unique(c(oldset, getRelatives(oldset, T),
                                      getRelatives(oldset, F)))
               }
               set <- setdiff(newset, names)
           },

           "to" = set <- getRelatives(names, T),
           "from" = set <- getRelatives(names, F)
           )

    if(excludeseed)
        return(set, names)
    return(c(names, set))
}



#' Build and/or plots a dependency graph
#'
#' Creates a weighted adjacency matrix, in which \code{(i,j) = x}
#' means that item \code{i} is in relation \code{x} with item
#' \code{j}. The resulting graph is plotted.
#'
#' @param tags Only show nodes matching tags
#' @param tagfun Function specifying how to match tags (by default
#'     "OR": match any of \code{tags}).
#' @param depends If TRUE, show "depends on" edges.
#' @param attached If TRUE, show "attached to" edges.
#' @param generated If TRUE, show "generated by" edges.
#' @param plot If TRUE (default), plot the dependency graph.
#' @param ... Other parameters passed to the \code{plot.igraph}
#'     function.
#' @details The relation between any two items \code{i} and \code{j} can have
#'     values 1, 2 or 3, respectively meaning:
#' \itemize{
#'   \item{depends on: }{to build item \code{i}, item \code{j} was necessary.}
#'   \item{attached to: }{item \code{i} is an attachment item and is attached to
#'         item \code{j}.}
#'   \item{generated by: }{item \code{i} has been generated by item \code{j}. Item
#'         \code{j} is usually an attachment containing the source code that
#'         generated item \code{i}.}
#' }
#' @return Adjacency matrix representing the graph, with edges labeled
#'     1, 2, 3 corresponding to "depends", "attached" and "generated"
#'     respectively.
#' @examples
#' ## Repository creation
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#' 
#' ## Producing some irrelevant data
#' data1 <- 1:10
#' data2 <- data1 * 2
#' data3 <- data1 + data2
#'
#' ## Putting the data in the database, specifying dependencies
#' rp$put(data1, "item1", "First item",
#'     "repo_dependencies")
#' rp$put(data2, "item2", "Item dependent on item1", 
#'     "repo_dependencies", depends="item1")
#' rp$put(data3, "item3", "Item dependent on item1 and item2",
#'     "repo_dependencies", depends=c("item1", "item2"))
#'
#' ## Creating a temporary plot and attaching it
#' fpath <- file.path(rp$root(), "temp.pdf")
#' pdf(fpath)
#' plot(data1)
#' dev.off()
#' rp$attach(fpath, "visualization of item1", "plot",
#'    to="item1")
#'
#' ## Obtaining the dependency matrix
#' depmat <- rp$dependencies(plot=FALSE)
#' print(depmat)
#' ## The matrix can be plotted as a graph (requires igraph package)
#' rp$dependencies()
#' ## The following hides "generated" edges
#' rp$dependencies(generated=FALSE)
#' 
#' ## wiping temporary repo
#' unlink(rp_path, TRUE)
repo_dependencies <- function(tags=NULL, tagfun="OR", depends=T,
                              attached=T, generated=T, plot=T, ...)
{
    pars <- list(...)
    if(!"vertex.frame.color" %in% pars)
        pars[["vertex.frame.color"]] <- "lightblue"
    if(! "edge.arrow.size" %in% pars)
        pars[["edge.arrow.size"]] <- .4
    if(! "vertex.color" %in% pars)
        pars[["vertex.color"]] <- "lightblue"
    if(! "vertex.label.cex" %in% pars)
        pars[["vertex.label.cex"]] <- .7
    if(! "vertex.label.family" %in% pars)
        pars[["vertex.label.family"]] <- "Helvetica"
    if(! "vertex.label.color" %in% pars)
        pars[["vertex.label.color"]] <- "black"
    if(! "edge.label.color" %in% pars)
        pars[["edge.label.color"]] <- "darkgray"
    if(! "edge.label.family" %in% pars)
        pars[["edge.label.family"]] <- "Helvetica"
    if(! "edge.label.cex" %in% pars)
        pars[["edge.label.cex"]] <- .6
                              
    deps <- depgraph(tags, tagfun, depends, attached, generated)

    if(!is.null(tags))
        sube <- findEntries(tags, tagfun) else sube <- 1:length(entries)
    nodes <- unique(unlist(sapply(entries[sube], get, x="name")))
    prjs <- sapply(nodes, isProject)
    deps <- deps[!prjs,!prjs]

    if(plot) {
        if (requireNamespace("igraph", quietly = TRUE)) {
            deps2 <- deps
            rownames(deps2) <- colnames(deps2) <- basename(rownames(deps))
            g <- igraph::graph.adjacency(deps2, weighted=c("type"))
            pars[["x"]] <- g
            pars[["edge.label"]] <-
                c("depends", "attached", "generated")[igraph::get.edge.attribute(g,"type")]
            do.call(igraph::plot.igraph, pars)
        } else {
            stop("The suggested package igraph is not installed.")
        }              
    }
    invisible(deps)
}



#' Check repository integrity.
#'
#' Checks that all indexed data are present in the repository root,
#' that files are not corrupt and that no unindexed files are present.
#'
#' @details Every time the object associated to an item is stored, an
#'     MD5 checksum is saved to the repository index. \code{check}
#'     will use those to verify that the object was not changed by
#'     anything other than Repo itself.
#' @return Used for side effects.
#' @examples
#' ## Repository creation
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#'
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#' rp$put(0, "item1", "A sample item", "repo_check")
#' rp$check()
#' 
#' ## wiping temporary repo
#' unlink(rp_path, TRUE)
repo_check <- function()
{
    stopOnEmpty()
    entr <- entries

    for(i in 1:length(entr))
    {
        handleErr("CHECK_MD5_INFO_STARTING", entr[[i]]$name)
        if(file.exists(getFile(entr[[i]]$name))){
            md5s <- md5sum(getFile(entr[[i]]$name))
            if(md5s != entr[[i]]$checksum) {
                handleErr("CHECK_MD5_WARNING_FAILED")
            } else handleErr("CHECK_MD5_INFO_SUCCESS")
        } else {
            handleErr("CHECK_WARNING_NOTFOUND")
        }
    }

    handleErr("CHECK_EXTRA_INFO_STARTING")
    allfiles <- file.path(root, list.files(root, recursive=T))
    dumps <- sapply(sapply(entries, get, x="name"), getFile)
    junk <- setdiff(path.expand(allfiles), path.expand(dumps))
    junk <- setdiff(junk, repofile)
    if(length(junk)>0){
        handleErr("CHECK_EXTRA_INFO_FAILED", junk)
    } else handleErr("CHECK_EXTRA_INFO_SUCCESS")
    invisible()
}



#' Plots a pie chart of repository contents
#'
#' The pie chart shows all repository items as pie slices of size
#' proportional to the item sizes on disk. Items with size smaller
#' then 5% of the total are shown together as "Others".
#'
#' @param ... Other parameters passed to the \code{pie} function.
#' @return Used for side effects.
#' @examples
#' ## Repository creation
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#' 
#' ## Producing some irrelevant data of different sizes
#' data1 <- 1:10
#' data2 <- 1:length(data(1))*2
#' data3 <- 1:length(data(1))*3
#'
#' ## Putting the data in the database, specifying dependencies
#' rp$put(data1, "item1", "First item", "repo_pies")
#' rp$put(data2, "item2", "Second item", "repo_pies")
#' rp$put(data3, "item3", "Third item", "repo_pies")
#'
#' ## Showing the pie chart
#' rp$pies()
#' 
#' ## wiping temporary repo
#' unlink(rp_path, TRUE)
repo_pies <- function(...) {
    sizes = sapply(entries, get, x="size")
    names(sizes) <- sapply(entries, get, x="name")
    sizeperc <- sizes/sum(sizes)
    toosmall <- sizeperc < .05
    if(any(toosmall)) {
        sizes <- c(sizes[!toosmall], sum(sizes[toosmall]))
        names(sizes)[length(sizes)] <- "Others"
    }
    pie(sizes, ...)
}



#' Copy items to another repository
#'
#' Copies an object file from one repository to another and creates a new entry
#' in the index of the destination repository. Supports tags and multiple names.
#' 
#' @param destrepo An object of class repo (will copy to it)
#' @param name The name (or list of names) of the item/s to copy
#' @param tags If not NULL, copy all items matching tags. NULL by
#' default.
#' @param replace What to do if item exists in destination repo (see
#'     put). F by default.
#' @param confirm If F, don't ask for confirmation when multiple items
#'     are involved. F by default.
#' @return Used for side effects.
#' @examples
#' ## Repository creation
#' rp_path1 <- file.path(tempdir(), "example_repo1")
#'
#' rp1 <- repo_open(rp_path1, TRUE)
#' rp1$put(0, "item1", "A sample item", "tag1")
#' rp_path2 <- file.path(tempdir(), "example_repo2")
#' rp2 <- repo_open(rp_path2, TRUE)
#' rp1$copy(rp2, "item1")
#'
#' ## wiping temporary repo
#' unlink(rp_path1, TRUE)
#' unlink(rp_path2, TRUE)
repo_copy <- function(destrepo, name, tags=NULL, replace=F, confirm=T)
{            
    if(!("repo" %in% class(destrepo)))
        stop("destrepo must be an object of class repo.")
    if(!xor(missing(name), is.null(tags)))
        stop("You must specify either names or tags.")

    if(length(name) > 1 | !is.null(tags)) {
        runWithTags("copy", tags, name, replace=replace,
                    askconfirm=confirm, destrepo=destrepo)
    } else {
        if(checkName(name)) {
            handleErr("ID_NOT_FOUND", name)
            return(invisible())
        }

        e <- findEntryIndex(name)
        entr <- entries[[e]]
        obj <- get("this", thisEnv)$get(name)

        destrepo$put(obj, name, entr$description, entr$tags,
                     entr$prj, entr$source,
                     entr$chunk, entr$depends,
                     replace=replace, URL=entr$URL,
                     asattach=isAttachment(name),
                     to=entr$attachedto, checkRelations=F)
    }
}



#' Provides simplified access to repository items.
#'
#' Creates a list of functions, each one associated with a repository
#' item, that can be used to access items directly.
#'
#' @details Repository handlers are functions associated with
#'     items. As opposed to item names, they can take advantage of IDE
#'     auto-completion features and do not require quotation marks. A
#'     handler to the \code{repo} object itself is provided in the
#'     list.
#' @return A list of functions.
#' @examples
#'
#' ## Repository creation
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#' 
#' ## Putting some irrelevant data
#' rp$put(1, "item1", "Sample item 1", "repo_handlers")
#' rp$put(2, "item2", "Sample item 2", "repo_handlers")
#'
#' ## Getting item handlers
#' h <- rp$handlers()
#' ## handlers have the same names as the items in the repo (and they
#' ## include an handler to the repo itself).
#' names(h)
#'
#' ## Without arguments, function "item1" loads item named "item1".
#' i1 <- h$item1()
#'
#' ## Arguments can be used to call other repo functions on the item.
#' h$item1("info")
#'
#' ## After putting new data, the handlers must be refreshed.
#' rp$put(3, "item3", "Sample item 3", "repo_handlers")
#' h <- rp$handlers()
#' names(h)
#'
#' ## wiping temporary repo
#' unlink(rp_path, TRUE)
repo_handlers <- function()
{
    h <- list()
    for(i in 1:length(entries))
    {
        fbody <- paste0('function(f="get", ...)',
                        'get("this", thisEnv)[[f]](name ="', entries[[i]]$name, '",...)')
        h[[i]] <- eval(parse(text=fbody))
    }
    h[[length(h)+1]] <- get("this", thisEnv)
    names(h) <- c(sapply(entries, get, x="name"), "repo")
    return(h)
}



#' List all tags
#'
#' Shows list of all unique tags associated with any item in the
#' repository.
#' 
#' @param name The name of a repository item.
#' @return Character vector of unique tags defined in the repo.
#' @seealso repo_put
#' @examples
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#'
#' ## Putting two items with a few tags
#' rp$put(1, "item1", "Sample item 1",
#'     c("repo_tags", "tag1"))
#' rp$put(2, "item2", "Sample item 2",
#'     c("repo_tags", "tag2"))
#'
#' ## Looking up tags
#' rp$tags()
#'
#' ## wiping temporary repo
#' unlink(rp_path, TRUE)
repo_tags <- function(name)
{
    if(missing(name)) {
        entr <- entries
        tagset <- unique(unlist(lapply(entr, get, x="tags")))
    } else {
        e <- getEntry(name)
        tagset <- e$tags
    }
    return(tagset)
}




#' Run system call on an item
#'
#' Runs a system command passing as parameter the file name containing
#' the object associated with an item.
#' 
#' @param name Name of a repo item. The path to the file that contains
#' the item will be passed to the system program.
#' @param command System command
#' @return Used for side effects.
#' @examples
#' ## Repository creation
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#'
#' ## Creating a PDF file with a figure.
#' pdffile <- file.path(rp_path, "afigure.pdf")
#' pdf(pdffile)
#' plot(runif(30), runif(30))
#' dev.off()
#'
#' ## Attaching the PDF file to the repo
#' rp$attach(pdffile, "A plot of random numbers", "repo_sys")
#' ## don't need the original PDF file anymore
#' file.remove(pdffile)
#'
#' ## Opening the stored PDF with Evince document viewer
#' \dontrun{
#' rp$sys("afigure.pdf", "evince")
#'}
#'
#' ## wiping temporary repo
#' unlink(rp_path, TRUE)
repo_sys <- function(name, command)
{
    stopOnNotFound(name)
    e <- getEntry(name)
    syscomm <-paste0(command, " ", file.path(root, e[["dump"]]))
    message(paste("Running system command:", syscomm))
    system(syscomm)
}
#' Match items by matching any field
#'
#' @param what Character to be matched against any field (see
#'     Details).
#' @param all Show also items tagged with "hide".
#' @param show Select columns to show.
#' @return Used for side effects.
#' @details
#'
#' This function actually calls print specifying the find
#' parameters. The find parameter can be any character string to be
#' matched against any item field, including string-converted size
#' (like "10x3").
#' 
#' @examples
#' rp_path <- file.path(tempdir(), "example_repo")
#' 
#' rp <- repo_open(rp_path, TRUE)
#' rp$put(1, "item1", "Sample item 1", c("tag1", "tag2"))
#' rp$put(2, "item2", "Sample item 2", c("tag1", "hide"))
#' rp$put(3, "item3", "Sample item 3", c("tag2", "tag3"))
#' rp$print()
#' rp$find("tEm2")
#' rp$find("ag2", show="t")
#' 
#' ## wiping the temp repo
#' unlink(rp_path, TRUE)
#'
repo_find <- function(what, all=F, show="ds")
{
    get("this", thisEnv)$print(find=what, all=all, show=show)
}


#'@export
print.repo <- function(x, tags=NULL, tagfun="OR",
                       find=NULL, all=F, show="ds", ...)
    x$print(tags=tags, tagfun=tagfun, find=find, all=all, show=show)


#' Show a summary of the repository contents.
#'
#' @param tags A list of character tags. Only items matching all the
#' tags will be shown.
#' @param tagfun How to combine tags (see Details).
#' @param find Character to match any filed (see Details).
#' @param all Show also items tagged with "hide".
#' @param show Select columns to show.
#' @return Used for side effects.
#' @details The \code{tagfun} param specifies how to combine multiple
#' tags when matching items. It can be either a character or a
#' function. As a character, it can be one of \code{OR}, \code{AND} or
#' \code{NOT} to specify that one, all or none of the tags must be
#' matched, respectively. If it is a function, it must take two tag
#' vectors, the first of which corresponds to \code{tags}, and return
#' TRUE for a match, FALSE otherwise.
#'
#' The find param can be any character string to be matched against
#' any item field, including string-converted size (like "10x3").
#' 
#' @examples
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#' rp$put(1, "item1", "Sample item 1", c("tag1", "tag2"))
#' rp$put(2, "item2", "Sample item 2", c("tag1", "hide"))
#' rp$put(3, "item3", "Sample item 3", c("tag2", "tag3"))
#' rp$print()
#' rp$print(all=TRUE)
#' rp$print(show="tds", all=TRUE)
#' rp$print(show="tds", all=TRUE, tags="tag1")
#' ## wiping the temp repo
#' unlink(rp_path, TRUE)
#'
#' ## wiping temporary repo
#' unlink(rp_path, TRUE)
repo_print <- function(tags=NULL, tagfun="OR", find=NULL, all=F, show="ds")
{
    if(!is.null(tags) & !is.null(find))
        stop("Please provide either tags or find.")
    
    stopOnEmpty()
    
    entr <- entries
    if(!is.null(tags) | !is.null(find)) {
        w <- findEntries(tags=tags, tagfun=tagfun, find=find)
        if(length(w)<1)
        {
            message("No matches.")
            return(invisible())
        } else {
            entr <- entr[w]
            a <- entriesToMat(w)
        }
    } else {
      a <- entriesToMat(1:length(entr))
    }

    
    
    h <- rep(F,length(entr))
    tagsets <- lapply(entr, get, x="tags")
    hidden <- sapply(tagsets, is.element, el="hide")

    if(!all)
        h[hidden] <- T

    if(length(entr)>1 & all(h))
    {
        message("All matched entries are hidden, use all=T.")
        return(invisible(NULL))
    }
    
    cols <- c(T, sapply(c("f","d","t","s"), grepl, show))
    a <- as.data.frame(a[!h,cols], nm="")

    if(sum(!h)>1)
        print(a, quote=F, row.names=F) else print(t(a), quote=F, row.names=F)

    invisible(a)
}



#' Export \code{repo} items to RDS file.
#' 
#' @param name Name (or list of names) of the item/s to export.
#' @param where Destination directory
#' @param tags List of tags: all items tagged with all the tags in the
#' list will be exported.
#' @param askconfirm If T ask confirmation when exporting multiple
#' items.
#' @return TRUE on success, FALSE otherwise.
#' @examples
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#' rp$put(1, "item1", "Sample item 1", "export")
#' rp$export("item1", tempdir()) # creates item1.RDS in a tempdir
#'
#' ## wiping temporary repo
#' unlink(rp_path, TRUE)
repo_export <- function(name, where=".", tags=NULL, askconfirm=T)
{
    if(!xor(missing(name), is.null(tags)))
        stop("You must specify either names or tags.")

    if(!is.null(tags) | length(name)>1){
        runWithTags("export", tags, name, askconfirm, where=where)
    } else {
        ipath <- file.path(root, getEntry(name)[["dump"]])
        if(isAttachment(name))
            fname <- name else fname <- paste0(name, ".RDS")
        file.copy(ipath, file.path(where, fname))
    }
}



#' Provides detailed information about an item.
#' 
#' @param name Item name (or list of names). If both name and tags are NULL, information
#' about the whole repo will be provided.
#' @param tags List of tags: info will run on all items matching the tag list.
#' @return Used for side effects.
#' @examples
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#' rp$put(1, "item1", "Sample item 1", "info")
#' rp$info("item1")
#'
#' ## wiping temporary repo
#' unlink(rp_path, TRUE)
repo_info <- function(name = NULL, tags = NULL)
{
    stopOnEmpty()
    
    if(!is.null(name))
        stopOnNotFound(name)
    
    if(!xor(is.null(name), is.null(tags))) {
        labels <- c("Root:", "Number of items:", "Total size:")
        maxw <- max(sapply(labels, nchar))
        vals <- c(compressPath(root), length(entries),
                  hmnRead(sum(sapply(entries, get, x="size"))))
        lines <- paste(format(labels, width=maxw), vals, sep=" ")
        for(i in 1:length(lines))
            cat(lines[[i]], "\n")
        return(invisible(NULL))
    }            

    
    if(!is.null(tags) | length(name)>1){
        runWithTags("info", tags, name, askconfirm=F)
    } else {            
        
        e <- findEntryIndex(name)
        if(is.null(e))
            stop("Identifier not found.")

        if("#project" %in% entries[[e]]$tags)
        {
            sess <- get("this",thisEnv)$get(name)
            cat("Project name:", name, "\n")
            cat("Description:", entries[[e]]$description, "\n")
            cat("Resources:", paste(sapply(entries[prjmembers(name)], get, x="name"),
                                    collapse="\n\t"), "\n")                    
            cat("Platform:", sess$session$platform, "\n")
            cat("OS:", sess$session$running, "\n")
            cat("R version:", sub("R version ", "",
                                  sess$session$R.version$version.string), "\n")
            cat("Packages:",
                paste(paste(names(sess$pkg), sess$pkg, sep=" "), collapse="\n\t"),
                "\n")
        } else {

            labels <- c("ID:", "Description:", "Tags:",
                        "Dimensions:", "Timestamp:",
                        "Size on disk:", "Provenance:",
                        "Attached to:", "Stored in:", 
                        "MD5 checksum:", "URL:")
            maxlen <- max(sapply(labels, nchar))

            if(is.null(entries[[e]]$attachedto))
                att <- "-" else att <- paste(entries[[e]]$attachedto, collapse=", ")
            if(is.null(entries[[e]]$URL))
                url <- "-" else url <- entries[[e]]$URL

            vals <- c(entries[[e]]$name, entries[[e]]$description,
                      paste0(entries[[e]]$tags, collapse=", "),
                      paste(entries[[e]]$dims, collapse="x"),
                      as.character(entries[[e]]$timestamp),
                      hmnRead(entries[[e]]$size),
                      paste(entries[[e]]$source, collapse=", "), att,
                      file.path(get("root",thisEnv), entries[[e]]$dump),
                      entries[[e]] $checksum, url)
            cat(paste0(format(labels, width=maxlen+1), vals, "\n"), sep="")
            cat("\n")
        }
    }
}



#' Remove item from the repo (and the disk).
#' 
#' @param name An item's name.
#' @param tags A list of tags: all items matching the list will be
#' removed.
#' @param force Don't ask for confirmation.
#' @return Used for side effects.
#' @examples
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#' rp$put(1, "item1", "Sample item 1", "info")
#' rp$put(2, "item2", "Sample item 2", "info")
#' print(rp)
#' rp$rm("item1")
#' print(rp)
#'
#' ## wiping temporary repo
#' unlink(rp_path, TRUE)
repo_rm <- function(name = NULL, tags = NULL, force = F)
{
##:ess-bp-start::browser@nil:##
    checkIndexUnchanged()                   
    
    if(!xor(missing(name),missing(tags)))
        stop("You must specify either a name or a set of tags.")

    if(!is.null(tags) | length(name)>1){
        runWithTags("rm", tags, name, !force)
    } else {            
        e <- get("findEntryIndex",thisEnv)(name)
        if(is.null(e))
            return(invisible(NULL))

        rmData(name, "temp")
        rmData(name, "finalize")

        assign("entries", entries[-e], thisEnv)                
        storeIndex()
    }
}



#' Edit all items info using a text file.
#' 
#' @details Exactly one of \code{outfile} or \code{infile} must be
#'     supplied. All repository entry fields are copied to a
#'     tab-separated file when using the \code{outfile} parameter. All
#'     repo entries are updated reading from \code{infile} when the
#'     \code{infile} parameter is used. Within the TAGS field, tags
#'     must be comma-separated. The system writes a checksum to the
#'     \code{outfile} that prevents from using it as \code{infile} if
#'     repo has changed in the meantime.
#' @param outfile Name of a file to put entries data to.
#' @param infile Name of a file to read entries data from.
#' @return Used for side effects.
#' @seealso repo_set
#' @examples
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#' rp$put(1, "item1", "Sample item 1", c("tag1", "tag2"))
#' 
#' items_data_file <- tempfile()
#' rp$bulkedit(items_data_file)
#' ## Manually edit items_data_file, then update items:
#' rp$bulkedit(infile=items_data_file)
#' 
#' ## wiping temporary repo
#' unlink(rp_path, TRUE)
repo_bulkedit <- function(outfile=NULL, infile=NULL)
{
    if(!xor(is.null(infile), is.null(outfile)))
        stop("Please provide exactly one of infile or outfile.")

    if(!is.null(outfile)) {

        if(file.exists(outfile))
            stop("File already exists.")
        
        outf <- file(outfile,"at")
        writeLines(paste0(digest(entries),
                          " EDIT NEXT LINES ONLY. FIELDS MUST BE TAB-SEPARATED. ",
                          "TAGS MUST BE COMMA-SEPARATED."), outfile)
        for(i in 1:length(entries)){
            src <- entries[[i]]$source
            if(is.null(src)) src <- "NULL"
            line <- paste0(c(
                entries[[i]]$name,
                entries[[i]]$description,
                paste0(entries[[i]]$tags, collapse=", "),
                src,
                entries[[i]]$attachedto,
                entries[[i]]$depednds),
                collapse="\t"
                )
            writeLines(line, outf)
        }
        close(outf)
    } else {
        checkIndexUnchanged()
        
        if(!file.exists(infile))
            stop("Can't find input file.")
        
        indata <- strsplit(readLines(infile), "\t")

        csum <- substr(indata[[1]],1,32) 
        if(csum != digest(entries))
            stop(paste0("Checksum mismatch: it seems that input data were ",
                        "made for entries that have changed in the meantime. \n",
                        ## "Current checksum is: ", digest(entries), "\n",
                        ## "Checksum in input file is: ", indata[[1]], "\n",
                        "Overwriting could be dangerous, so I will stop here. ",
                        "Call bulkedit again to create a new input file.")
                 )
        indata <- indata[-1]

        rset <- get("this", thisEnv)$set

        for(i in 1:length(indata)) {
            src <- indata[[i]][[4]]
            if(src=="NULL")
                src <- NULL
            entries[[i]]$name <- indata[[i]][[1]]
            entries[[i]]$description <- indata[[i]][[2]]
            entries[[i]]$tags <- strsplit(gsub(" ", "", entries[[i]]$tags), ",")
            entries[[i]]$source <- src
        }

        assign("entries", entries, thisEnv)                
        storeIndex()
        message("Entries updated.")
    }
}



#' Get item attribute.
#' 
#' @param name An item name.
#' @param attrib An attribute name (currently can be only "path").
#' @return The item's attribute value.
#' @seealso repo_entries, repo_get
#' @examples
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#' rp$put(1, "item1", "Sample item 1", "tag1")
#' print(rp$attr("item1", "path"))
#'
#' ## wiping temporary repo
#' unlink(rp_path, TRUE)
repo_attr <- function(name, attrib)
{
    okattr <- c("path", "URL", "srcfile")
    if(!(attrib %in% okattr))
        stop(paste("attrib must be one of:",
                   paste(okattr, collapse=", ")))
    if(checkName(name)) {
        handleErr("ID_NOT_FOUND", name)
        return(invisible())
    }
    entry <- getEntry(name)
    switch(attrib, 
           "path" = {res <- file.path(root, entry$dump)},
           "URL" = {res <- entry$URL},
           "srcfile" = {res <- get("this", thisEnv)$get(entry$source)}
           )
    return(res)
}

##' Shows code chunk associated with an item
##'
##' @param name Item name.
##' @return List of lines of code, invisibly.
##' @export
repo_chunk <- function(name)
{
    src <- getSource(name)
    ##print(src)
    if(is.null(src))
        handleErr("CHUNK_NOSOURCE", name)
    ch <- getChunk(name)
    ##print(ch)
    if(is.null(ch))
        handleErr("CHUNK_NOCHUNK", name)
    cat(ch, "\n", sep="")
    return(invisible(ch))
}

##' Check whether a repository has an item
##'
##' @param name Item name.
##' @return TRUE if \code{name} is in the repository, FALSE otherwise.
##' @export
repo_has <- function(name)
{
    return(!is.null(getEntry(name)))
}

##' Builds a resource using the associated code chunk
##'
##' In order to be \code{build}able, a repository item must have an
##' associated source file and code chunk.
##' @param name Name of an item in the repo.
##' @param src Path to a source file containing the code block
##'     associated with the resource. Not necessary if \code{name} is
##'     already in the repository and has an associated source item.
##' @param recursive Build dependencies not already in the repo
##'     recursively (T by default).
##' @param force Re-build dependencies recursively even if already in
##'     the repo (F by default).
##' @param env Environment in which to run the code chunk associated
##'     with the item to build. Parent environment by default.
##' @param built A list of items already built used for recursion (not
##'     meant to be passed directly).
##' @return Nothing, used for side effects.
##' @details Code chunks are defined as in the following example: ```
##'	## chunk "item 1" {
##'         x <- code_to_make_x()
##'         rp$put(x, "item 1")
##'	## }
##'```
##'
##' `item 1` must be associated to the source (`src` parameter of
##' `put`) containing the chunk code.
##'
##' @export
repo_build <- function(name, src=NULL, recursive=T, force=F, env=parent.frame(), built=list())
{
    if(checkName(forkedName(name)) && is.null(src))
        handleErr("ID_NOT_FOUND", name)
    
    ch <- getChunk(forkedName(name), src=src)
    if(is.null(ch))
        handleErr("CHUNK_NOCHUNK", name)
    opt <- get("options", thisEnv)[["replace"]]
    if(!is.null(opt))
        if(opt == "addversion" || opt==T)
            force <- T
    deps <- getEntry(name)$depends
    if(length(deps)>0) {
        for(i in 1:length(deps)) {
            if(!(deps[i] %in% built)) {
                if(!get("this", thisEnv)$has(deps[i]) || force) {
                    handleErr("INFO_BUILDING_DEPS", deps[i])
                    built <- c(built, deps[i])
                    get("this", thisEnv)$build(deps[i], recursive=T, force=force, env=env,
                                               built=built)
                }
            }
        }
    }

    
    data <- eval(parse(text=ch), env)

    return(invisible())
}



#' Retrieve an item from the repo.
#' 
#' @param name An item's name.
#' @param enableSuggestions If set to TRUE (default), enables some
#'     checks on \code{name} that are meant to gracefully handle
#'     errors and provide suggestions of similar names. If FALSE, the
#'     execution will be significantly faster in large repositories.
#' @return The previously stored object, or its file system path for
#'     attachments.
#' @examples
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#' rp$put(1, "item1", "Sample item 1", "get")
#' print(rp$get("item1"))
#'
#' ## wiping temporary repo
#' unlink(rp_path, TRUE)

repo_get <- function(name, enableSuggestions=T)
{
    name <- forkedName(name)

    if(enableSuggestions) {
        if(checkName(name)){
            enames <- sapply(entries, get, x="name")
            x <- agrep(name, enames)
            if(length(x)>0) {
                x <- x[abs(sapply(enames[x],nchar) - nchar(name))<=3]
                message(paste0(
                    "Maybe you were looking for: ",
                    paste0(enames[x], collapse=", ")
                ))
            }
            handleErr("ID_NOT_FOUND", name)
            return(invisible())
        }
    }
    entry <- getEntry(name)
    root <- get("root",thisEnv)
    if(substr(normalizePath(entry$dump, mustWork=F), 1, nchar(root)) == root) {
        newpath <- relativePath(normalizePath(entry$dump, mustWork=F))
        message(paste0("This resource was indexed in a deprecated format. ",
                       "Now updating position from:\n", entry$dump, "\nto:\n",
                       newpath))
        entry$dump <- newpath
        setEntry(name, entry)
        storeIndex()
    }

    f <- getFile(name)
    if(!file.exists(f) && !is.null(entry$URL))
        handleErr("MISS_OBJ_HAS_URL")

    if(isAttachment(name))
        data <- f else data <- readRDS(f)
    
    return(data)
}



#' Low-level list of item entries.
#' 
#' @return A detailed list of item entries.
#' @examples
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#' rp$put(1, "item1", "Sample item 1", "entries")
#' rp$put(2, "item2", "Sample item 2", "entries")
#' rp$put(3, "item3", "Sample item 3", "entries")
#' print(rp$entries())
#'
#' ## wiping temporary repo
#' unlink(rp_path, TRUE)
repo_entries <- function()
{
    ent <- get("entries",thisEnv)
    names(ent) <- sapply(ent, get, x="name")
    return(ent)
}



#' Add tags to an item.
#' 
#' @param name An item name.
#' @param newtags A list of tags that will be added to the item's tag
#' list.
#' @param tags A list of tags: newtags will be added to all items
#' matching the list.
#' @return Used for side effects.
#' @seealso repo_untag, repo_set
#' @examples
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#' rp$put(1, "item1", "Sample item 1", "tag1")
#' rp$print(show="t")
#' rp$tag("item1", "tag2")
#' rp$print(show="t")
#'
#' ## wiping temporary repo
#' unlink(rp_path, TRUE)
repo_tag <- function(name = NULL, newtags, tags = NULL)
{
    if(!xor(is.null(name), is.null(tags)))
        stop("You must provide either name or tags.")
    if(!is.null(tags) | length(name)>1)
        runWithTags("tag", tags, name, F, newtags) else
                                                       get("this", thisEnv)$set(name, addtags=newtags)                   
}



#' Run expression with cache.
#'
#' lazydo searches the repo for previous execution of an
#' expression. If a previous execution is found, the result is loaded
#' and returned. Otherwise, the expression is executed and the result
#' stashed.
#'
#' @param expr An object of class expression (the code to run).
#' @param force If TRUE, execute expr anyway
#' @param env Environment for expr, defaults to parent.
#' @return Results of the expression (either loaded or computed on the
#'     fly).
#' @details The expression results are stashed as usual. The name of
#' the resource is obtained by digesting the expression, so it will
#' look like an MD5 string in the repo. Note that the expression, and
#' not its result, will uniquely identify the item in the repo.
#'
#' The new item is automatically tagged with "stash", "hide" and
#' "lazydo".
#' @seealso repo_stash, repo_put
#' 
#' @examples
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#' 
#'
#' ## First run
#' system.time(rp$lazydo(
#'     {
#'         Sys.sleep(1/10)
#'         x <- 10
#'     }
#' ))
#'
#' ## lazydo is building resource from code.
#' ## Cached item name is: f3c27f11f99dce20919976701d921c62
#' ##   user  system elapsed 
#' ##  0.004   0.000   0.108 
#' 
#' ## Second run
#' system.time(rp$lazydo(
#'     {
#'         Sys.sleep(1/10)
#'         x <- 10
#'     }
#' ))
#'
#' ## lazydo found precomputed resource.
#' ##   user  system elapsed 
#' ##  0.001   0.000   0.001 
#'
#' 
#' ## The item's name in the repo can be obtained as the name of the
#' ## last item added:
#'
#' l <- length(rp$entries())
#' resname <- rp$entries()[[l]]$name
#' cat(rp$entries()[[l]]$description)
#' ## {
#' ##    Sys.sleep(1/10)
#' ##    x <- 10
#' ## }
#' rp$rm(resname) ## single cached item cleared
#'
#' ## wiping temporary repo
#' unlink(rp_path, TRUE)
repo_lazydo <- function(expr, force=F, env=parent.frame())
{
    ## if(!is.expression(expr))
    ##     handleErr("LAZY_NOT_EXPR")
    
    src <- paste(deparse(substitute(expr)), collapse="\n")
    resname <- digest(src)

    if(checkName(resname) || force)
    {
        handleErr("LAZY_NOT_FOUND")
        res <- eval(expr, envir=env)
        get("this", thisEnv)$stash(res, resname)
        get("this", thisEnv)$set(resname,
                                 description=src,
                                 addtags="lazydo")
        handleErr("LAZY_NAME", resname)
        return(res)
    } else {
        handleErr("LAZY_FOUND")
        return(get("this", thisEnv)$get(resname))
    }
}



#' Remove tags from an item.
#' 
#' @param name An item name.
#' @param rmtags A list of tags that will be removed from the item's
#' tag list.
#' @param tags A list of tags: rmtags will be removed from all items
#' matching the list.
#' @return Used for side effects.
#' @seealso repo_tag, repo_set
#' @examples
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#' rp$put(1, "item1", "Sample item 1", c("tag1", "tag2"))
#' rp$print(show="t")
#' rp$untag("item1", "tag2")
#' rp$print(show="t")
#' 
#' ## wiping temporary repo
#' unlink(rp_path, TRUE)
repo_untag <- function(name = NULL, rmtags, tags = NULL)
{
    if(!xor(is.null(name), is.null(tags)))
        stop("You must provide either name or tags.")
    if(!is.null(tags) | length(name)>1) {
        runWithTags("untag", tags, name, F, rmtags)
    } else {
        currtags <- getEntry(name)$tags
        w <- rmtags %in% currtags
        if(!any(w))
            warning(paste0("Tag/s ", paste0(rmtags[!w], collapse=", "),
                           " not present in entry ", name))
        currtags <- setdiff(currtags, rmtags)
        get("this", thisEnv)$set(name, tags = currtags)
    }
}



#' Edit an existing item.
#' 
#' @param name An item name.
#' @param obj An R object to replace the one currently associated with
#'     the item.
#' @param newname Newname of the item.
#' @param description Item's description.
#' @param tags New item's tags as a list of character.
#' @param prj New item's project as a list of character.
#' @param src New item's provenance as a list of character.
#' @param chunk New item's chunk name.
#' @param depends List of item names indicating dependencies.
#' @param addtags Tags to be added to current item's tags. Can not be
#'     used together with the parameter "tags".
#' @param URL A character containing an URL where the item is supposed
#'     to be downloaded from.
#' @param buildURL A character containing a base URL that is completed
#'     by postfixing the item's relative path. Useful to upload
#'     repositories online and make their items downloadable. The
#'     item's current URL is overwritten.
#' @return Used for side effects.
#' @seealso repo_put
#' @examples
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#' rp$put(1, "item1", "Sample item 1", c("tag1", "tag2"))
#' rp$set("item1", obj=2)
#' print(rp$get("item1"))
#' rp$set("item1", description="Modified description", tags="new_tag_set")
#' rp$info("item1")
#'
#' ## wiping temporary repo
#' unlink(rp_path, TRUE)
repo_set <- function(name, obj=NULL, newname=NULL, description=NULL,
                     tags=NULL, prj=NULL, src=NULL, chunk=NULL,
                     depends=NULL, addtags=NULL, URL=NULL,
                     buildURL=NULL)
{
    checkIndexUnchanged()                    
    
    if(missing(name) | (missing(newname) & missing(obj) & missing(description) &
                        missing(tags) & missing(addtags) & missing(src) &
                        missing(depends) & missing(URL) & missing(buildURL)))
        stop("You must provide name and one of: obj, description, tags or addtags, src, depends, URL")
    if(!missing(tags) & !missing(addtags))
        stop("You can not specify both tags and addtags.")
    if(!missing(URL) & !missing(buildURL))
        stop("You can not specify both URL and buildURL.")
    
    if(checkName(name))
        handleErr("ID_NOT_FOUND", name)

    w <- findEntryIndex(name)
    entr <- entries[[w]]

    entr$timestamp <- Sys.time()
    if(!is.null(newname))
        entr$name <- newname
    if(!is.null(description))
        entr$description <- description
    if(!is.null(tags)) {                
        entr$tags <- checkTags(tags)
    }
    if(!is.null(addtags)) {
        entr$tags <- unique(c(entr$tags, checkTags(addtags, name)))
    }
    if(!is.null(src))
        entr$source <- src

    if(!is.null(depends))
        entr$depends <- depends

    if(!missing(URL))
        entr$URL <- URL

    if(!missing(buildURL)) {
        lastl <- substr(buildURL, nchar(buildURL), nchar(buildURL))
        if(lastl=="/")
            entr$URL <- paste0(buildURL, entr$dump) else {
                                                        entr$URL <- paste0(buildURL, "/", entr$dump)
                                                    }
    }
    
    if(!is.null(obj)) {
        newinfo <- setData(entr$name, obj, isAttachment(entr$name))
        entr$dump <- newinfo[["dump"]]
        entr$size <- newinfo[["size"]]
        entr$checksum <- newinfo[["checksum"]]
        entr$dims <- newinfo[["dims"]]
    }

    entries[[w]] <- entr
    assign("entries", entries, thisEnv)
    storeIndex()
}



#' Create a new item from an existing file.
#' 
#' @param filepath The path to the file to be stored in the repo.
#' @param description A character description of the item.
#' @param tags A list of tags to sort the item. Tags are useful for
#'     selecting sets of items and run bulk actions.
#' @param src The name of the item that produced the stored
#'     object. Usually a previously attached source code file.
#' @param prj The name of a \code{project} item in the repository (see
#'     \code{project}). Default is no associated project item.
#' @param chunk The name of the code chunk within \code{src} that is
#'     responsible for building the item. Set to \code{name} by
#'     default. See \code{build}.
#' @param replace If the item exists, overwrite the specified fields.
#' @param to An existing item name to attach the file to.
#' @param URL A URL where the item contents con be downloaded from.
#' @return Used for side effects.
#' @examples
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#' 
#' \dontrun{
#' ## Creating a PDF file with a figure.
#' pdf("afigure.pdf")
#' ## Drawing a random plot in the figure
#' plot(runif(100), runif(100))
#' dev.off()
#' ## Attaching the PDF file to the repo
#' rp$attach("afigure.pdf", "A plot of random numbers", "repo_sys")
#' ## don't need the PDF file anymore
#' file.remove("afigure.pdf")
#' ## Opening the stored PDF with Evince document viewer
#' rp$sys("afigure.pdf", "evince")
#' }
#'
#' ## wiping temporary repo
#' unlink(rp_path, TRUE)
repo_attach <- function(filepath, description=NULL, tags=NULL,
                        prj=NULL, src=NULL, chunk=basename(filepath),
                        replace=F, to=NULL, URL=NULL)
{
    get("this", thisEnv)$put(filepath, basename(filepath),
                             description, tags, prj, src, chunk,
                             replace=replace, asattach=T, to=to, URL=URL)
}



#' Quickly store temporary data
#'
#' A very simplified call to put that only requires to specify
#' a variable name.
#'
#' @details
#'
#'     The \code{name} parameter is used to search the parent (or a
#'     different specified) environment for the actual object to
#'     store. Then it is also used as the item name. The reserved tags
#'     "stash" and "hide" are set. In case a stashed item by the same
#'     name already exists, it is automatically overwritten. In case a
#'     non-stashed item by the same name already exists, an error is
#'     raised. A different name can be specified through the rename
#'     parameter in such cases.
#' @param object The object to store in the repo.
#' @param rename An optional character containing the new name for the
#'     item. Otherwise the name of object is used as item's name.
#' @return Used for side effects.
#' @seealso repo_put, repo_lazydo
#' @examples
#' \dontrun{
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#' tempdata <- runif(10)
#' rp$stash(tempdata)
#' rp$info("tempdata")
#'
#' ## wiping temporary repo
#' unlink(rp_path, TRUE)
#' }
repo_stash <- function(object, rename = deparse(substitute(object)))
{
    name <- deparse(substitute(object))
    if(!stopOnEmpty(T)){
        e <- getEntry(rename)
        if(!is.null(e))
            if(!"stash" %in% e$tags)
                stop(paste("A non-stash entry by the same name already exists,",
                           "try setting the rename parameter."))
    }
    
    get("this", thisEnv)$put(object, rename, "Stashed object",
                             c("stash", "hide"), replace=T)
}



#' Remove all stashed data
#'
#' @param force If TRUE, no confirmation is asked.
#' @return Used for side effects.
#' @seealso repo_rm, repo_stash
#' @examples
#' \dontrun{
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#' tempdata <- runif(10)
#' rp$stash("tempdata")
#' rp$print(all=TRUE)
#' rp$stashclear(TRUE)
#'
#' ## wiping temporary repo
#' unlink(rp_path, TRUE)
#' }
repo_stashclear <- function(force=F)
{
    get("this", thisEnv)$rm(tags=c("stash", "hide"), force=force)
}



#' Download item remote content
#'
#' @details Repo index files can be used as pointers to remote
#'     data. The pull function will download the actual data from the
#'     Internet, including regular items or attachment. Another use of
#'     the URL item's parameter is to attach a remote resource without
#'     downloading it.
#' @param name Name of the existing item that will be updated.
#' @param replace If TRUE, existing item's object is overwritten.
#' @return Used for side effects.
#' @examples
#' ## Repository creation
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#' remote_URL <- paste0("https://github.com/franapoli/repo/blob/",
#'                      "untested/inst/remote_sample.RDS?raw=true")
#'
#' ## The following item will have remote source
#' rp$put("Local content", "item1", "Sample item 1", "tag",
#'          URL = remote_URL)
#' print(rp$get("item1"))
#'
#' ## suppressWarnings(try(rp$pull("item1"), TRUE))
#'  tryCatch(rp$pull("item1"),
#'          error = function(e)
#'              message("There were warnings whle accessing remote content"),
#'          warning = function(w)
#'              message("Could not download remote content")
#'          )
#' print(rp$get("item1"))
#'
#' ## wiping temporary repo
#' unlink(rp_path, TRUE)
repo_pull <- function(name, replace=F) {
    e <- getEntry(name)
    if(is.null(e$URL))
        handleErr("NO_URL", name)
    if(file.exists(e$dump) && !replace)
        handleErr("DATA_ALREADY_THERE", name)
    tf <- tempfile()
    download.file(e$URL, tf)

    if(isAttachment(name)) {
        get("this", thisEnv)$set(name, obj=tf)
    } else get("this", thisEnv)$set(name, obj=readRDS(tf))            
}




#' Defines and \code{put}-s a \code{project} item.
#'
#' A \code{project} item is a special item containing session
#' information, including package dependencies. Every time a new item
#' is stored in the repository, it will automatically be assigned to
#' the current project, if one has been defined, and session
#' information will be updated.
#'
#' @param name character containing the name of the project
#' @param description character containing a longer description of the
#'     project
#' @param replace logical, if T then an existing project item by the
#'     same name will be overwritten.
#' @return Used for side effects.
repo_project <- function(name, description, replace=T)
{
    get("this", thisEnv)$put(NULL, name, description,
                             c("hide", "#project"), replace=replace)
    updatePrjInfo(name)
}



#' Create a new item in the repository.
#'
#' Given an R object, stores it to an RDS file in the \code{repo} root
#' and add an associated item to the \code{repo} index, including
#' object name, description, tags and more.
#' 
#' @details The item \code{name} can be any string, however it should
#'     be a concise identifier, possibly without special character
#'     (could become mandatory soon). Some tags have a special
#'     meaning, like "hide" (do not show the item by default),
#'     "attachment" (the item is an attachment - this should never be
#'     set manually), "stash" (the item is a stashed item, makes the
#'     item over-writable by other "stash" items by default).
#' @param obj An R object to store in the repo.
#' @param name A character identifier for the new item. If NULL, the
#'     name of the \code{obj} variable will be used.
#' @param description A character description of the item.
#' @param tags A list of tags to sort the item. Tags are useful for
#'     selecting sets of items and run bulk actions.
#' @param prj The name of a \code{project} item in the repository (see
#'     \code{project}). Default is no associated project item.
#' @param src Name of an existing item to be annotated as the
#'     "generator" of the new item. Usually it is an attachment item
#'     containing the source code that generated the new item. Default
#'     is NULL.
#' @param chunk The name of the code chunk within \code{src} that is
#'     responsible for building the item. Set to \code{name} by
#'     default. See \code{build}.
#' @param depends Character vector: items that depend on this
#'     item. Default is NULL.
#' @param replace One of: V, F, "addversion" to define behavior when
#'     an item by the same name exists. If V, overwrite it. If F stop
#'     with an error. If "addversion" the new item is stored as a new
#'     version and the old item is renamed by appending a "#N"
#'     suffix. Default is F.
#' @param asattach Specifies that the item is to be treated as an
#'     attachment (see attach). Default is F.
#' @param to Vector of character. Specifies which item this item is
#'     attached to. Default is NULL.
#' @param URL Remote URL where the \code{pull} function expects to
#'     download actual item data from. Default is NULL.
#' @param checkRelations Check if items referenced by this item
#'     exist. Default is T.
#' @param addversion Deprecated, use the \code{replace} parameter
#'     instead.
#' @return Used for side effects.
#' @seealso get, set, attach, info
#' @examples
#' ## Repository creation
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#'
#' ## Producing some irrelevant data
#' data1 <- 1:10
#' data2 <- data1 * 2
#' data3 <- data1 / 2
#'
#' ## Putting the data in the database, specifying dependencies
#' rp$put(
#'     obj = data1,
#'     name = "item1",
#'     description = "First item",
#'     tags = c("repo_put", "a_random_tag"),
#'     )
#' rp$put(data2, "item2", "Item dependent on item1",
#'     "repo_dependencies", depends="item1")
#' rp$put(data3, "item3", "Item dependent on item1 and item2",
#'     "repo_dependencies", depends=c("item1", "item2"))
#'
#' print(rp)
#'
#' ## Creating another version of item1
#' data1.2 <- data1 + runif(10)
#' rp$put(data1.2, name = "item1", "First item with additional noise",
#'     tags = c("repo_put", "a_random_tag"), replace="addversion")
#' print(rp, all=TRUE)
#' rp$info("item1#1")
#'
#' ## wiping temporary repo
#' unlink(rp_path, TRUE)
repo_put <- function(obj, name=NULL, description=NULL, tags=NULL,
                     prj=NULL, src=NULL, chunk=name, depends=NULL,
                     replace=F, asattach=F, to=NULL, addversion=F,
                     URL=NULL, checkRelations=T)
{
    checkIndexUnchanged()

    ## Global settings override
    opt <- get("options", thisEnv)[["replace"]]
    if(!is.null(opt))
        replace <- opt
    opt <- get("options", thisEnv)[["src"]]
    if(!is.null(opt))
        src <- opt
    opt <- get("options", thisEnv)[["prj"]]
    if(!is.null(opt))
        prj <- opt

    if(addversion)
        stop("addversion is deprecated, use replace=\"addversion\"")
    
    if(replace == "addversion") {
        ## This code is to cope with new interface after
        ## removing addversion parameter
        addversion = T 
        replace = F
    }
    
    
    if(missing(obj))
        stop("You must provide parameter: obj")

    if(is.null(name))
        name <- deparse(substitute(obj))
    
    if(name == "repo")
        handleErr("ID_RESERVED")    
    
    if(!is.null(to))
        asattach <- T

    if(asattach)
        if(!file.exists(obj))
            handleErr("ATTACHMENT_FILE_NOT_FOUND", obj)
##:ess-bp-start::browser@nil:##
    
    notexist <- checkName(name)

    if(!notexist & replace==F) {
        entry <- getEntry(name)
        if("stash" %in% entry$tags)
            replace <- T
    }
    
    if(!notexist & !replace & !addversion)
        handleErr("ID_EXISTING", name)
    
    if(!asattach) {
        if(!is.null(dim(obj)))
            dims <- dim(obj) else
                                 dims <- length(obj)
    } else {
        dims <- NULL
        tags <- unique(c(tags, "attachment"))
    }

    if(!is.null(depends) && checkRelations) 
        stopOnNotFound(sapply(depends, forkedName))

    if(!is.null(src) && checkRelations) 
        stopOnNotFound(src)
    
    if(!is.null(to) && checkRelations)
        stopOnNotFound(to)

    if(!is.null(prj) && checkRelations)
        stopOnNotFound(prj)
    
    repoE <- list(name = name,
                  description = description,
                  tags = tags,
                  prj = prj,
                  class = class(obj),
                  dims = dims,
                  timestamp = Sys.time(),
                  dump = NULL,
                  size = NULL,
                  checksum = NULL,
                  source = src,
                  chunk = chunk,
                  depends = depends,
                  attachedto = to,
                  URL = URL)            
    
    if(!notexist & addversion) {
        newname <- checkVersions(name)$new
        get("this", thisEnv)$set(name, newname=newname)
        if(!("hide" %in% get("this", thisEnv)$tags(newname))) ## avoid warning                
            get("this", thisEnv)$tag(newname, "hide")
    }            

    entr <- get("entries", thisEnv)

    if(!notexist & replace) {
        ei <- findEntryIndex(name)
        rmData(name, "temp")
        oldEntr <- entr[[ei]]
    } else ei <- length(entries)+1
    
    tryCatch({
        fdata <- get("storeData", thisEnv)(name, obj, asattach)
    }, error = function(e) {
        print(e)
        if(!notexist & replace) 
            rmData(name, "undo")
        stop("Error writing data.")
    }, finally = {
        repoE["size"] <- fdata[["size"]]
        repoE["checksum"] <- md5sum(path.expand(fdata[["path"]]))
        repoE["dump"] <- relativePath(fdata[["path"]])

        ## rmData must be called before overwriting the old
        ## entry (particularly the dump field)
        if(!notexist & replace)
            rmData(name, "finalize")

        entr[[ei]] <- repoE
        assign("entries", entr, thisEnv)
        get("storeIndex", thisEnv)()
        
    }
    )

    if(asattach && !("hide" %in% repoE$tags))
        get("this", thisEnv)$tag(name, "hide")

    if(!is.null(prj) && checkRelations) updatePrjInfo(prj)
}


## After refactoring has the same name as the globalfunction:
## repo_cpanel <- function()
## {
##     repo_cpanel(get("this", thisEnv)$root())
## }


## The following has been dropped
## #' Append text to an existing item content.
## #'
## #' This feature is experimental.
## #' 
## #' @param id The name of an item whose object is of class character.
## #' @param txtorfunc Text to be appended to the item's object. It can
## #' also be a on object of class function: in this case, its source is
## #' appended.
## #' @return Used for side effects.
## repo_append <- function(id, txtorfunc)
## {
##     checkIndexUnchanged()
    
##     notexist <- checkName(id)
##     if(notexist)
##         stop("Identifier not found.")

##     if(class(txtorfunc)=="function")
##         txtorfunc <- paste0("\n",
##                             paste(deparse(txtorfunc), collapse="\n"),
##                             "\n")

##     if(class(txtorfunc)!="character")
##         stop("txtorfunc must be an object of class function or character")
    
##     ##e <- findEntryIndex(id)
##     curobj <- this$get(id)
##     this$set(id, obj=paste0(curobj, txtorfunc))
## }



#' Show path to repo root
#' 
#' @return character containing the path to the root of the repo.
#' @examples
#' rp_path <- file.path(tempdir(), "example_repo")
#' rp <- repo_open(rp_path, TRUE)
#' print(rp$root())
#'
#' ## wiping temporary repo
#' unlink(rp_path, TRUE)

repo_root <- function()
{
    return(get("root",thisEnv))
}


#' Returns item's dependencies
#'
#' @param name The name of a repository item.
#' @return The items on which the input item depends.
repo_depends <- function(name)
{
    return(getEntry(name)$depends)
    ## deps <- get("dependants", thisEnv)(name)
    ## depnames <- sapply(entries[deps], get, x="name")
    ## return(depnames)
}


#' Loads an item to current workspace
#'
#' Like \code{repo_get}, returns the contents of a stored item. But,
#' unlike \code{repo_get}, loads it to the current namespace.
#'
#' @param names List or vector of repository item names.
#' @param overwrite_existing Overwrite an existing variable by the
#'     same name in the current workspace. If F (defaults) throws an
#'     error.
#' @param env Environment to load the variable into (parent environment
#'     by default).
#' @return Nothing, used for side effects.
repo_load <- function(names, overwrite_existing=F, env=parent.frame())
{
    for(i in 1:length(names)) {
        obj <- get("this", thisEnv)$get(names[[i]])
        assign(names[[i]], obj, envir=env)
    }
    return(invisible(NULL))
}


#' Set repository-wide options
#'
#' @param ... options to set
#' @return if optional parameters are not passed, the current options
#'     are returned

repo_options <- function(...)
{
    ls <- list(...)
    curopt <- get("options", thisEnv)
    if(length(ls)==0)
        return(curopt)
    for(i in 1:length(ls))
        curopt[[names(ls)[i]]] <- ls[[i]]
    assign('options', curopt, envir=thisEnv)
}



repo_methods_public <- function()
{
    methods = list(
        related = repo_related,
        dependencies = repo_dependencies,
        check = repo_check,
        pies = repo_pies,
        copy = repo_copy,
        handlers = repo_handlers,
        tags = repo_tags,
        sys = repo_sys,
        find = repo_find,
        print = repo_print,
        export = repo_export,
        info = repo_info,
        rm = repo_rm,
        bulkedit = repo_bulkedit,
        attr = repo_attr,
        get = repo_get,
        entries = repo_entries,
        tag = repo_tag,
        lazydo = repo_lazydo,
        untag = repo_untag,
        set = repo_set,
        attach = repo_attach,
        stash = repo_stash,
        stashclear = repo_stashclear,
        pull = repo_pull,
        project = repo_project,
        put = repo_put,
        cpanel = repo_cpanel,
        root = repo_root,
        options = repo_options,
        has = repo_has,
        chunk = repo_chunk,
        build = repo_build,
        depends = repo_depends,
        load = repo_load
    )
    return(methods)
}