# Module UI
#' @title mod_linkedin_ui and mod_linkedin_server
#' @description A shiny Module.
#'
#' @param id shiny id
#' @param input internal
#' @param output internal
#' @param session internal
#'
#' @rdname mod_linkedin
#'
#' @keywords internal
#' @export
#' @importFrom shiny NS tagList
mod_linkedin_ui <- function(id){
ns <- NS(id)
tagList(
fluidRow(
column(
width = 12,
fluidRow(
shinydashboardPlus::boxPlus(
title = "Participants", width = 12,
column(
12, DT::DTOutput(ns("dt_participants"))
),
enable_sidebar = TRUE,
sidebar_icon = "columns",
sidebar_title = "Add columns",
sidebar_width = 30,
sidebar_content = uiOutput(ns("select_attributes"))
)
)
),
column(
width = 6,
fluidRow(
box(
width = 12,
div(
style = "display: inline-block;",
uiOutput(ns("ui_search_button"))
),
div(
style = "display: inline-block;",
uiOutput(ns("ui_search_suffix"))
)
),
box(
title = "Invitation text", width = 12,
selectInput(
ns("invitation_text_language"),
label = "Select language",
choices = c("fr", "en")
),
br(),
uiOutput(ns("ui_invitation_text")),
uiOutput(ns("ui_clipbutton_invitation_text"))
)
)
),
column(
width = 6,
fluidRow(
box(
title = "Survey text", width = 12,
selectInput(
ns("survey_text_language"),
label = "Select language",
choices = c("fr", "en")
),
br(),
uiOutput(ns("ui_survey_text")),
uiOutput(ns("ui_clipbutton_survey_text"))
)
)
)
)
)
}
# Module Server
#' @rdname mod_linkedin
#' @export
#' @keywords internal
mod_linkedin_server <- function(input, output, session, rv){
ns <- session$ns
output$select_attributes <- renderUI({
selected <- rv$df_linkedin %>%
dplyr::filter(.data$key == "dt_attributes") %>%
tidyr::separate_rows(.data$value, sep = ";") %>%
dplyr::pull(.data$value)
shinyWidgets::pickerInput(
ns("picker_select_attributes"),
label = "Additional fields",
choices = rv$df_participants_attributes$description,
selected = selected,
multiple = TRUE,
options = list(
"showTick" = TRUE,
"actions-box" = TRUE,
"dropdown-align-right" = TRUE
),
choicesOpt = list(
subtext = paste("- ", rv$df_participants_attributes$attribute))
)
})
output$dt_participants <- DT::renderDT({
rv$df_participants_filter() %>%
dplyr::select(.data$token, .data$firstname, .data$lastname, .data$optout, .data$completed, input[["picker_select_attributes"]]) %>%
DT::datatable(
selection = list(mode = 'single', selected = 1),
rownames = FALSE,
options = list(
dom = 'rftp',
scrollY = '20vh'
)
)
})
observeEvent(input$picker_select_attributes, ignoreNULL = FALSE, ignoreInit = TRUE, {
impexp::sqlite_execute_sql(
golem::get_golem_options("sqlite_base"),
glue::glue("UPDATE linkedin SET value = \"{paste0(input$picker_select_attributes, collapse = ';')}\" WHERE key = \"dt_attributes\";")
)
rv$df_linkedin <- impexp::sqlite_import(golem::get_golem_options("sqlite_base"), "linkedin")
})
proxy <- DT::dataTableProxy("dt_participants")
observeEvent(input$dt_participants_search, ignoreInit = TRUE, {
req(input$dt_participants_rows_current)
DT::selectRows(proxy, input$dt_participants_rows_current[1])
})
output$ui_search_button <- renderUI({
req(input$dt_participants_rows_selected)
linkedin <- rv$df_participants_filter() %>%
dplyr::filter(dplyr::row_number() == input$dt_participants_rows_selected)
rv$linkedin_search_suffix_text <- rv$df_linkedin %>%
dplyr::filter(.data$key == "search_text_input") %>%
dplyr::pull(.data$value)
actionButton(
ns("button_search"),
"Search",
icon = icon("search"),
onclick = paste0("window.open('", paste0("https://www.linkedin.com/search/results/all/?keywords=", linkedin$firstname, "%20", linkedin$lastname, "%20", input$search_suffix_text), "', '_blank')")
)
})
output$ui_search_suffix <- renderUI({
req(input$dt_participants_rows_selected)
rv$linkedin_search_suffix_text <- impexp::sqlite_import(
golem::get_golem_options("sqlite_base"),
"linkedin"
) %>%
dplyr::filter(.data$key == "search_text_input") %>%
dplyr::pull(.data$value)
textInput(
ns("search_suffix_text"),
label = NULL,
value = isolate(rv$linkedin_search_suffix_text),
placeholder = "Search suffix (for example, a city to filter results)"
)
})
observeEvent(input$dt_participants_rows_selected, {
req(input$dt_participants_rows_selected)
if (!is.null(input$search_suffix_text)) {
updateTextInput(
session,
"search_suffix_text",
value = rv$linkedin_search_suffix_text
)
}
if (!is.null(input$invitation_text)) {
updateTextAreaInput(
session,
"invitation_text",
value = rv$linkedin_invitation_text
)
}
if (!is.null(input$survey_text)) {
updateTextAreaInput(
session,
"survey_text",
value = rv$linkedin_survey_text
)
}
})
observeEvent(input$search_suffix_text, {
req(input$search_suffix_text != rv$linkedin_search_suffix_text)
rv$linkedin_search_suffix_text <- input$search_suffix_text
impexp::sqlite_execute_sql(
golem::get_golem_options("sqlite_base"),
glue::glue("UPDATE linkedin SET value = \"{input$search_suffix_text}\" WHERE key = \"search_text_input\";")
)
})
output$ui_invitation_text <- renderUI({
req(
input$dt_participants_rows_selected,
input$invitation_text_language
)
rv$linkedin_invitation_text <- impexp::sqlite_import(
golem::get_golem_options("sqlite_base"),
"linkedin"
) %>%
dplyr::filter(.data$key == glue::glue("invitation_text_{input$invitation_text_language}")) %>%
dplyr::pull(.data$value)
tagList(
column(
width = 10,
textAreaInput(
ns("invitation_text"),
label = NULL,
height = "140px",
value = isolate(rv$linkedin_invitation_text),
placeholder = "My invitation text"
),
div(
style = "display: inline-block; vertical-align: top;",
fileInput(ns("import_invitation_text"), label = NULL, buttonLabel = "Import invitation text")
),
div(
style = "display: inline-block; vertical-align: top;",
downloadButton(ns("export_invitation_text"), "Export invitation text", icon = icon("file-export"))
)
)
)
})
output$ui_clipbutton_invitation_text <- renderUI({
req(
input$dt_participants_rows_selected,
input$invitation_text
)
df_linkedin_fiter <- rv$df_participants_filter() %>%
dplyr::filter(dplyr::row_number() == input$dt_participants_rows_selected)
clipButton_text <- input$invitation_text %>%
survey.admin::escape_space_glue(
rv$df_participants_attributes %>%
tidyr::separate_rows(.data$survey_id, sep = ";") %>%
dplyr::filter(.data$survey_id == df_linkedin_fiter$survey_id)
) %>%
glue::glue_data(.x = df_linkedin_fiter) %>%
glue::glue_data(.x = df_linkedin_fiter) %>%
iconv(from = "UTF-8")
tagList(
column(
width = 2,
rclipboard::rclipButton(ns("copy_invitation_text"), HTML("Copy<br/>invitation<br/>text"), clipButton_text, icon("clipboard"))
)
)
})
observeEvent(input$invitation_text, {
req(input$invitation_text != rv$linkedin_invitation_text)
rv$linkedin_invitation_text <- input$invitation_text
impexp::sqlite_execute_sql(
golem::get_golem_options("sqlite_base"),
glue::glue("DELETE FROM linkedin WHERE key = \"invitation_text_{input$invitation_text_language}\";")
)
impexp::sqlite_append_rows(
golem::get_golem_options("sqlite_base"),
dplyr::tibble(
key = glue::glue("invitation_text_{input$invitation_text_language}"),
value = input$invitation_text
),
"linkedin"
)
})
observeEvent(input$import_invitation_text, {
req(
input$import_invitation_text,
input$invitation_text_language
)
invitation_text <- input$import_invitation_text$datapath %>%
readLines(encoding = "UTF-8") %>%
paste(collapse = "\n")
rv$linkedin_invitation_text <- invitation_text
updateTextAreaInput(
session,
"invitation_text",
value = invitation_text
)
impexp::sqlite_execute_sql(
golem::get_golem_options("sqlite_base"),
glue::glue("DELETE FROM linkedin WHERE key = \"invitation_text_{input$invitation_text_language}\";")
)
impexp::sqlite_append_rows(
golem::get_golem_options("sqlite_base"),
dplyr::tibble(
key = glue::glue("invitation_text_{input$invitation_text_language}"),
value = invitation_text
),
"linkedin"
)
})
output$export_invitation_text <- downloadHandler(
filename = function() {
"invitation_text.txt"
},
content = function(con) {
input$invitation_text %>%
writeLines(con, useBytes = TRUE)
}
)
output$ui_survey_text <- renderUI({
req(
input$dt_participants_rows_selected,
input$survey_text_language
)
rv$linkedin_survey_text <- impexp::sqlite_import(
golem::get_golem_options("sqlite_base"),
"linkedin"
) %>%
dplyr::filter(.data$key == glue::glue("survey_text_{input$survey_text_language}")) %>%
dplyr::pull(.data$value)
tagList(
column(
width = 10,
textAreaInput(
ns("survey_text"),
label = NULL,
height = "230px",
value = isolate(rv$linkedin_survey_text),
placeholder = "My survey text"
),
div(
style = "display: inline-block; vertical-align: top;",
fileInput(ns("import_survey_text"), label = NULL, buttonLabel = "Import survey text")
),
div(
style = "display: inline-block; vertical-align: top;",
downloadButton(ns("export_survey_text"), "Export survey text", icon = icon("file-export"))
)
)
)
})
output$ui_clipbutton_survey_text <- renderUI({
req(
input$dt_participants_rows_selected,
input$survey_text
)
df_linkedin_fiter <- rv$df_participants_filter() %>%
dplyr::filter(dplyr::row_number() == input$dt_participants_rows_selected)
clipButton_text <- input$survey_text %>%
survey.admin::escape_space_glue(
rv$df_participants_attributes %>%
tidyr::separate_rows(.data$survey_id, sep = ";") %>%
dplyr::filter(.data$survey_id == df_linkedin_fiter$survey_id)
) %>%
glue::glue_data(.x = df_linkedin_fiter) %>%
glue::glue_data(.x = df_linkedin_fiter) %>%
iconv(from = "UTF-8")
tagList(
column(
width = 2,
rclipboard::rclipButton(ns("copy_survey_text"), HTML("Copy<br/>survey<br/>text"), clipButton_text, icon("clipboard"))
)
)
})
observeEvent(input$survey_text, {
req(input$survey_text != rv$linkedin_survey_text)
rv$linkedin_survey_text <- input$survey_text
impexp::sqlite_execute_sql(
golem::get_golem_options("sqlite_base"),
glue::glue("DELETE FROM linkedin WHERE key = \"survey_text_{input$survey_text_language}\";")
)
impexp::sqlite_append_rows(
golem::get_golem_options("sqlite_base"),
dplyr::tibble(
key = glue::glue("survey_text_{input$survey_text_language}"),
value = input$survey_text
),
"linkedin"
)
})
observeEvent(input$import_survey_text, {
req(
input$import_survey_text,
input$survey_text_language
)
survey_text <- input$import_survey_text$datapath %>%
readLines(encoding = "UTF-8") %>%
paste(collapse = "\n")
rv$linkedin_survey_text <- survey_text
updateTextAreaInput(
session,
"survey_text",
value = survey_text
)
impexp::sqlite_execute_sql(
golem::get_golem_options("sqlite_base"),
glue::glue("DELETE FROM linkedin WHERE key = \"survey_text_{input$survey_text_language}\";")
)
impexp::sqlite_append_rows(
golem::get_golem_options("sqlite_base"),
dplyr::tibble(
key = glue::glue("survey_text_{input$survey_text_language}"),
value = survey_text
),
"linkedin"
)
})
output$export_survey_text <- downloadHandler(
filename = function() {
"survey_text.txt"
},
content = function(con) {
input$survey_text %>%
writeLines(con, useBytes = TRUE)
}
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.