googlesheet.r

# This is the server logic for a Shiny web application.
# 

# Google sheets connection

  ## prepare the OAuth token and set up the target sheet:
  ##  - do this interactively
  ##  - do this EXACTLY ONCE
  
  # shiny_token <- gs_auth() # authenticate w/ your desired Google identity here
  # saveRDS(shiny_token, "shiny_app_token.rds")

  #   wedding_responses_google <- gs_new(
  #     title="wedding_responses_google",
  #     input = data.frame(
  #       coming = "test",
  #       language = "test",
  #       kidscoming = "test",
  #       guestemail = "test",
  #       guestmessage = "test"
  #     )
  #   )
  
  # wedding_responses_google$sheet_key # 1apwbs9UCpTGVhP89QO3GAexGb_z-0oIa3hL82h5UDxo
  
  ## shiny_app_token.rds in .gitignore

  googlesheets::gs_auth(token = "shiny_app_token.rds")
  sheet_key <- "1apwbs9UCpTGVhP89QO3GAexGb_z-0oIa3hL82h5UDxo"
  wedding_responses_google <- googlesheets::gs_key(sheet_key)

# load data ----
  
  data_guestlist <- readRDS("guestlist.rds")
  #gmail_password <- readChar("gmail_app_password.txt", 
  #                           file.info("gmail_app_password.txt")$size)

# Packages ----
  library(shiny)
  #library(mailR)
  library(googlesheets)
  library(dplyr)
  

# Servers ----
shinyServer(function(input, output,session) {
  
# this guest -----
  thisguest <- reactive({
    code <- tolower(input$text) # move code to var
    data_guestlist %>%
      filter(passcode==code)
  })
  
# Check code -----
  output$codecheck <- renderText({ 
    code <- input$text # move code to var
    # stop if not entered
      if(code=="Bitte geben Sie das Kennwort ein") { 
          return(NULL)
        }
# check code -----
    data_guest <- thisguest()
    # stop if code wrong
      if(nrow(data_guest)==0 & input$language=="English") { 
        return("Opps, there is mistake in your code")
      }
      if(nrow(data_guest)==0 & input$language=="Deutsch") { 
        return("Upps , es gibt Fehler in Ihrem Code")
      }
# Output, hey -----
      if(input$language=="English") { 
        output <- paste0(
          "Hey,  ",data_guest["displayname"]," thanks  for  logging  in  to   RSVP"
        )
      }
      if(input$language=="Deutsch") { 
        output <- paste0(
          "Grezi, ",data_guest["displayname"]," danke fur kommen zu RSVP"
        )
      }
    output
    })

# Who's coming? -----
  output$coming <- renderUI({
    if(nrow(thisguest())==0) return(NULL)
    if(input$language=="English") {
    output <- checkboxGroupInput("coming", "Who's coming?",
                       c(thisguest()$Name,
                         thisguest()$Partner,
                         "Sorry we can't come"))
    }
    if(input$language=="Deutsch") {
      output <- checkboxGroupInput("coming", "Wer kommt?",
                       c(thisguest()$Name,
                         thisguest()$Partner,
                         "Keine kommen :("))}
    output
  })
  
# Kids's coming? -----
  output$kidscoming <- renderUI({
    if(nrow(thisguest())==0) return(NULL)
    if(is.na(thisguest()$Children)) return(NULL)
    kidnumbers <- thisguest()$Children
    if(input$language=="English") {
      output <- checkboxGroupInput("kidscoming", 
                                   "Can your children make it as well?",
                                   c("Yes!",
                                     "No :("))
    }
    if(input$language=="Deutsch") {
      output <- checkboxGroupInput("kidscoming", 
                                   "Kind kommt?",
                                   c("Ja!",
                                     "Nien :("))
    }
    output
  })
  
# Guest's email -----
  output$guestemail <- renderUI({
    if(nrow(thisguest())==0) return(NULL)
    if(input$language=="English") {
      output <-   textInput("guestemail", 
                            label = p("Please enter your email address"), 
                            value = "Email address")
    }
    if(input$language=="Deutsch") {
      output <-   textInput("guestemail", 
                            label = p("Deine email"), 
                            value = "Deine email")
    }
    output
  })
  
# Guest's message -----
  output$guestmessage <- renderUI({
    if(nrow(thisguest())==0) return(NULL)
    if(input$language=="English") {
      output <- textInput("guestmessage", 
                          label = h4("Any other messages for Tina or James?"), 
                          value = "Write your message here.",
                          width = '100%')
    }
    if(input$language=="Deutsch") {
      output <- textInput("guestmessage", 
                          label = h4("Du sprechen zu Tina oder James"), 
                          value = "Schriben heir.",
                          width = '100%')
    }
    output
  }) 
  
# Submit button -----
  output$submit <- renderUI({
    if(nrow(thisguest())==0) return(NULL)
    if(input$language=="English") {
      output <- actionButton("submit", "Save my RSVP")
    }
    if(input$language=="Deutsch") {
      output <- actionButton("submit", "rette meine Um Antwort wird gebeten")
    }
    output
  })
  
  observe({
    if (is.null(input$submit) || input$submit == 0){return()}
    js_string <- 'alert("Do you want to submit now?");'
    session$sendCustomMessage(type='jsCode', list(value = js_string))
    text <- isolate(input$inText)
    output$outText <- renderUI({
      h4(text)
    })
  })
  
# Save data -----
  
#   observe({
#     if(is.null(input$submit) || input$submit==0) return(NULL)
#     
#     message <- paste(
#       input$coming,
#       input$kidscoming,
#       input$guestemail,
#       input$guestmessage
#     )
#     
#     send.mail(
#       from = paste0("<",isolate(input$guestemail),">"),
#       to = "<[email protected]>",
#       subject = "Wedding RSVP",
#       body = message,
#       smtp = list(host.name = "smtp.gmail.com", port = 25, 
#                   user.name = "[email protected]",
#                   passwd = gmail_password, ssl = TRUE),
#       authenticate = TRUE,
#       send = TRUE)
#   })
  
  guestresponse <- reactive({
    data.frame(
      coming = paste(input$coming,collapse = ", "),
      language = paste(input$language,collapse = ", "),
      kidscoming = paste(input$kidscoming,collapse = ", "),
      guestemail = paste(input$guestemail,collapse = ", "),
      guestmessage = paste(input$guestmessage,collapse = ", ")
  )
  })
  
  observeEvent(input$submit, {
    gs_add_row(
      wedding_responses_google, 
      input = guestresponse(),
      ws = 1,
      verbose = TRUE)
  })
  
  observe({
    if (is.null(input$submit) || input$submit == 0){return()}
    output$outText <- renderText({
      "Your response has been recorded, please check your emails"
    })
  })
  
  
})