R/dvUserStudies.r

In dvn: Access to Dataverse 3 APIs

dvUserStudies <-
function(   dvname, dv=getOption('dvn'), user=getOption('dvn.user'),
            pwd=getOption('dvn.pwd'), browser=FALSE, ...){
    if(is.null(user) | is.null(pwd))
        stop('Must specify username (`user`) and password (`pwd`)')
    if(missing(dvname) || is.null(dvname))
    	stop('Must specify name of a dataverse as `dvname`')
    if(inherits(dvname,'dvServiceDoc')){
        tmp <- dvname$dataverses$dvn
        if(length(tmp)>1)
            warning('Multiple dataverses available for this user. Results returned for first collection: \'',tmp[1],'\'.')
        dvname <- tmp[1]
    }
    xml <- dvDepositQuery(query=paste('collection/dataverse/',dvname,sep=''), user=user, pwd=pwd, dv=dv, browser=browser, ...)
    if(is.null(xml))
        invisible(NULL)
    else if(browser==FALSE){
	z <- xmlToList(xml)
        tmp <- list()
        tmp$dvname <- dvname
        tmp$dvtitle <- z$title$text
        tmp$released <- z$dataverseHasBeenReleased
        tmp$generator <- z$generator
        tmp$studies <- do.call(rbind,lapply(z[names(z)=='entry'], function(i) c(title=i$title$text, objectId=i$id)))
        rownames(tmp$studies) <- seq(rownames(tmp$studies))
        tmp$studies <- as.data.frame(tmp$studies, stringsAsFactors=FALSE)
        tmp$studies$objectId <- sapply(tmp$studies$objectId,function(i) strsplit(i,'study/')[[1]][2])
        tmp$xml <- xml
        class(tmp) <- c(class(tmp),'dvUserStudies')
        return(tmp)
    }
}

print.dvUserStudies <- function(x,...){
    cat('DV Title:     ',x$dvtitle,'\n')
    cat('DV Name:      ',x$dvname,'\n')
    cat('Released?     ',x$release,'\n')
    cat('Generated by: ',x$generator['uri'],x$generator['version'],'\n')
    cat('Studies:\n')
    print(x$studies, right=FALSE)
    invisible(x)
}