将数据冲突错误 (409) 转换为客户端可以理解的消息

Question

I'm relatively new to using R and shiny. Currently, I'm getting the Error: Conflict (HTTP 409) when trying to access an html file from dropbox and this is fine, I know the reason. What I do have a problem with is trying to find a way to change Error code message.

I've tried a couple forms of validation and try-catches.

library(shiny)
library(rdrop2)
library(httr)

ui <- # Define UI for dataset viewer application

shinyUI(pageWithSidebar(

headerPanel("Test DropBox html Docs to Shiny"),  

sidebarPanel(

  selectInput("Cat", "Choose a Category:",

              choices = c("A", "B", "C")),

  selectInput("Year", "Choose a Year:",

              choices = c("2012", "2011")),

  downloadButton("downFile", "Download File"),

  width = 2), 

mainPanel(

  tabsetPanel(type = "tabs",

              tabPanel("Html Pages", htmlOutput("viewReport"))), 
 width   = 10)
)
)

#IMPORTANT: The two lines below needs to be run just one time unless the token is deleted

# Create Token
token <- drop_auth()

# Save token
saveRDS(token, "droptoken.rds")

token <- readRDS("droptoken.rds")

server <- shinyServer(function(input, output) { 

# ---------------------------------------------------  
  filePutReport <- reactive(

    paste(input$Cat, "_", input$Year, "_Doc.html", sep = "")   
  )

  filePutReport2 <- reactive({
    # Search if the file exists in DropBox

    drop_download(path = paste("shiny_docs/shinydbtest/", filePutReport(), sep = ""),
                  overwrite = TRUE, local_path = "./www",
             dtoken = token)

      filePutReport()
  })

  # Show Html Pages

  output$viewReport <- renderUI({

    tags$iframe(seamless = "seamless", width = "1400", height = "1000",

                src = filePutReport2()
                )
  })

  ###
  output$downFile <- downloadHandler(
    # generate bins based on input$bins from ui.R
    filename = function() {

      paste0(filePutReport() )
    },

    content = function(file){

      file.copy(from = paste0("./www/", filePutReport2() ), to = file, overwrite = TRUE)
    }   
  )
})

shinyApp(ui = ui, server = server)

Instead of simply "Error: Conflict (HTTP 409)", I would a message a client might be able to understand. Any and all suggestions are welcome. Thank you in advance for your help.

Answer 1

In my current environment I cannot establish a connection to dropbox, but please try the approach below. I first deleted the last line refering to filePutReport() in your filePutReport2() reactive, since they are the same and you want your call to drop_download to produce either a value (TRUE) or an invisible object of class "try-error". Therefore, you need to further wrap your call to drop_download in a try statement. This way filePutReport2() either contains the value TRUE or an invisible object of class "try-error". Then you should be able to use a need/validate function in your renderUI statement including a custom error message. I hope it's working, since I can't test it.

library(shiny)
library(rdrop2)
library(httr)

ui <- # Define UI for dataset viewer application

  shinyUI(pageWithSidebar(

    headerPanel("Test DropBox html Docs to Shiny"),  

    sidebarPanel(

      selectInput("Cat", "Choose a Category:",

                  choices = c("A", "B", "C")),

      selectInput("Year", "Choose a Year:",

                  choices = c("2012", "2011")),

      downloadButton("downFile", "Download File"),

      width = 2), 

    mainPanel(

      tabsetPanel(type = "tabs",

                  tabPanel("Html Pages", htmlOutput("viewReport"))), 
      width   = 10)
  )
  )

#IMPORTANT: The two lines below needs to be run just one time unless the token is deleted

# Create Token
token <- drop_auth()

# Save token
saveRDS(token, "droptoken.rds")

token <- readRDS("droptoken.rds")

server <- shinyServer(function(input, output) { 

  # ---------------------------------------------------  
  filePutReport <- reactive(

    paste(input$Cat, "_", input$Year, "_Doc.html", sep = "")   
  )

  filePutReport2 <- reactive({
    # Search if the file exists in DropBox
    try({
    drop_download(path = paste("shiny_docs/shinydbtest/", filePutReport(), sep = ""),
                  overwrite = TRUE, local_path = "./www",
                  dtoken = token)
    }, silent = TRUE)

  })

  # Show Html Pages

  output$viewReport <- renderUI({

    validate(
      need(filePutReport2(), 'Custom error message!'))

    tags$iframe(seamless = "seamless", width = "1400", height = "1000",

                src = filePutReport()
    )
  })

  ###
  output$downFile <- downloadHandler(
    # generate bins based on input$bins from ui.R
    filename = function() {

      paste0(filePutReport() )
    },

    content = function(file){

      file.copy(from = paste0("./www/", filePutReport2() ), to = file, overwrite = TRUE)
    }   
  )
})

shinyApp(ui = ui, server = server)