nhanesR: Tools for "NHANES" Database

testfile <- function(urls,files,mode,redown=TRUE,xpt=TRUE,tsv=TRUE,varLabel=TRUE,codebook=TRUE,update=TRUE){
    for (i in 1:length(urls)) {
        (yeari <- do::Replace0(urls[i],'.*='))
        (itemsi <- urlComponet(urls[i]))
        if (i==1){
            cat('\n',prepare_years(yeari),'\n')
            cat('      ',itemsi)
        }else{
            if (urlyear(urls[i]) != urlyear(urls[i-1])){
                cat('\n',prepare_years(yeari))
            }
            if (itemsi != urlComponet(urls[i-1])){
                cat('\n      ',itemsi)
            }
        }
        filepage(yeari=yeari,itemsi=itemsi,mode=mode,files=files,
                 redown=redown,
                 xpt=xpt,tsv=tsv,varLabel=varLabel,codebook=codebook,
                 updatefile=update)
        if (i == length(urls)) cat('\n')
    }
}
filepage <- function(yeari,itemsi,mode,files,filetable=NULL,
                     cat=TRUE,redown=TRUE,update=FALSE,
                     xpt=TRUE,tsv=TRUE,varLabel=TRUE,codebook=TRUE,
                     updatefile=TRUE){
    if (missing(mode)) mode <- test_mode()
    # file table
    if (is.null(filetable)){
        filetablei <<- nhs_files_web(yeari,itemsi,FALSE)
        ck <<- ncol(filetablei)<8
        if (ck) return()
        filetable <- filetablei
    }
    ckf <- do::file.name(filetable$`Data url`)  |> tolower()
    ckf <- do::Replace0(ckf,paste0('\\.',tools::file_ext(ckf)))

    if (!missing(files) & nrow(filetable)>0){
        ckf <- do::file.name(filetable$`Data url`)  |> tolower()
        ckf <- do::Replace0(ckf,paste0('\\.',tools::file_ext(ckf)))
        ckfj <- lookl(ckf,paste0(files,collapse = '|'))
        ckf <- ckf[ckfj]
        filetable <- filetable[ckfj,]
    }
    if (cat) cat(paste0(' (',nrow(filetable),')'))
    if (nrow(filetable)==0) return(invisible())
    ckfj <- lookl(ckf,'vid')
    if (any(ckfj)){
        filetable$`DOC  url`[ckfj] <- sprintf('https://wwwn.cdc.gov/nchs/nhanes/%s/%s.htm',
                                              filetable$year[ckfj],
                                              ckf[ckfj])

    }

    (fd <- paste0(get_config_path(),'/',prepare_years(yeari),'/',prepare_items(itemsi)))
    if (!dir.exists(fd))  dir.create(path = fd,showWarnings = FALSE,recursive = TRUE)
    if (cat) cat('-->',fd)
    # (j=which(tools::file_ext(tolower(filetable$`Data url`))=='zip'))
    for (j in 1:nrow(filetable)) {
        (tablej <- filetable[j,])
        (xptj <- tablej$`Data url`)
        (docj <- tablej$`DOC  url`)
        (sizej <- tablej$`Data File` |> do::Replace0(c('.*- {0,}','\\].*')))
        (fj <- tolower(do::file.name(xptj)))
        if (tolower(filetable$`Date Published`[j]) == 'withdrawn') (fj <- do::Replace0(tablej$`Doc File`,' .*'))
        (fn <- sprintf('%s/%s',fd,fj))
        if (cat) cat('\n')
        if (cat) cat(crayon::blue(paste0('           ',j,': ',fj,' (size:',sizej)))
        if (tolower(filetable$`Date Published`[j]) == 'withdrawn'){
            if (cat) cat(' withdrawn')
            next(j)
        }
        if (file.exists(fn)){
            (pattern <- paste0(do::Replace0(fj,'\\.xpt|\\.zip'),c(".sas7bdat",".codebook",".varLabel",".tsv",".update",".xpt")))
            (f5 <- list.files(fd) %in% pattern)
            (ck <- sum(f5) == 5)
            if (update) ck <- FALSE
            if (!ck){
                # download
                if (redown & xpt){
                    nullcon <- file(nullfile(), open = "wb")
                    sink(nullcon, type = "message")
                    wait <- TRUE
                    while (wait) {
                        download <- tryCatch(download.file(xptj, destfile = fn, quiet = FALSE,mode=mode),
                                             error=function(e) 'e',
                                             warning=function(w) 'w')
                        wait <- ifelse(download=='e' | download=='w',TRUE,FALSE)
                    }
                    sink(type = "message")
                    close(nullcon)
                    if (tools::file_ext(fn) == 'zip'){
                        oldwd <- getwd()
                        zip=fn
                        setwd(do::Replace0(fn,fj))
                        if (do::is.windows()){
                            unzip(zipfile = fn,overwrite = TRUE)
                            (fn <- paste0(do::knife_right(fn,3),unzip(zipfile = fn,overwrite = TRUE,list = TRUE)[,'Name'] |>
                                              tools::file_ext()))
                        }else{
                            suppressWarnings(untar(tarfile = fn))
                            (fn <- paste0(do::knife_right(fn,3),untar(tarfile = fn,list = TRUE)[,'Name'] |>
                                              tools::file_ext()))
                        }

                        # unlink(zip)
                        setwd(oldwd)
                    }
                    cat(crayon::red(paste0(' download: ',filesize(fn),')')))

                }else{
                    if (xpt){
                        if (tools::file_ext(fn) == 'zip'){
                            (zip=fn)
                            # xpt
                            if (do::is.windows()){
                                (fn <- paste0(do::knife_right(fn,3),unzip(zipfile = zip,overwrite = TRUE,list = TRUE)[,'Name'] |>
                                                  tools::file_ext()))
                            }else{
                                (fn <- paste0(do::knife_right(fn,3),untar(tarfile = zip,list = TRUE)[,'Name'] |>
                                                  tools::file_ext()))
                            }

                            if (!file.exists(fn)){
                                oldwd <- getwd()
                                setwd(do::Replace0(zip,fj))
                                if (do::is.windows()){
                                    unzip(zipfile = zip,overwrite = TRUE)
                                }else{
                                    untar(tarfile = zip)
                                }
                                # unlink(zip)
                                setwd(oldwd)
                            }else{
                                if (cat) cat(crayon::blue(paste0(' Exist: ',filesize(zip),')')))
                            }
                        }else{
                            if (cat) cat(crayon::blue(paste0(' Exist: ',filesize(fn),')')))
                        }
                    }
                }
            }else{
                if (cat) cat(crayon::blue(paste0(' Exist: ',filesize(fn),')')))
            }
        }else{
            if (xpt){# download
                nullcon <- file(nullfile(), open = "wb")
                sink(nullcon, type = "message")
                wait <- TRUE
                while (wait) {
                    download <- tryCatch(download.file(xptj, destfile = fn, quiet = FALSE,mode=mode),
                                         error=function(e) 'e',
                                         warning=function(w) 'w')
                    wait <- ifelse(download=='e' | download=='w',TRUE,FALSE)
                }
                sink(type = "message")
                close(nullcon)
                if (tools::file_ext(fn) == 'zip'){
                    oldwd <- getwd()
                    zip=fn
                    setwd(do::Replace0(fn,fj))
                    if (do::is.windows()){
                        unzip(zipfile = fn,overwrite = TRUE)
                        (fn <- paste0(do::knife_right(fn,3),unzip(zipfile = fn,overwrite = TRUE,list = TRUE)[,'Name'] |>
                                          tools::file_ext()))
                    }else{
                        suppressWarnings(untar(tarfile = fn))
                        (fn <- paste0(do::knife_right(fn,3),untar(tarfile = fn,list = TRUE)[,'Name'] |>
                                          tools::file_ext()))
                    }
                    # unlink(zip)
                    setwd(oldwd)
                }
                cat(crayon::red(paste0(' download: ',filesize(fn),')')))
            }
        }
        # add tsv and varLabel
        # if (cat) cat('-')
        if (tsv) xpt2tsv(xpt = fn)
        # varLabel
        if (varLabel){
            (file <- do::Replace(fn,paste0('\\.',tools::file_ext(fn)),'.varLabel'))
            varLabel_url(url=docj,file=file)
        }
        # codebook
        # if (cat) cat('-')
        if (codebook){
            (file <- do::Replace(fn,paste0('\\.',tools::file_ext(fn)),'.codebook'))
            codebook_url(url=docj,file=file)
        }

        # add update
        # if (cat) cat('-')
        if (updatefile){
            (file <- do::Replace(fn,paste0('\\.',tools::file_ext(fn)),'.update'))
            suppressWarnings(write.table(tablej,file,row.names = FALSE,sep = '\t'))
        }
    }
}


filesize <- function(file){
    size <- file.size(file)
    if (size < 1024){
        paste(round(size,2),'b')
    }else if (size < 1024*1024){
        paste(round(size/1024,2),'kb')
    }else if (size < 1024*1024*1024){
        paste(round(size/1024/1024,2),'mb')
    }else if (size < 1024*1024*1024*1024){
        paste(round(size/1024/1024/1024,2),'Gb')
    }else if (size < 1024*1024*1024*1024*1024){
        paste(round(size/1024/1024/1024/1024,2),'TB')
    }
}