2020-12-12 12:38:54 +01:00
library ( shiny )
library ( magrittr )
library ( ggplot2 )
library ( plotly )
library ( DT )
2020-12-19 23:13:44 +01:00
library ( rjson )
2020-12-14 13:47:03 +01:00
connection <- source ( " connection_module.R" , encoding = " utf-8" )
2020-12-12 12:38:54 +01:00
registerUI <- function ( id ) {
ns <- NS ( id )
fluidPage (
2020-12-14 13:47:03 +01:00
useShinyjs ( ) ,
2020-12-12 12:38:54 +01:00
tags $ head (
2020-12-14 13:47:03 +01:00
tags $ script ( src = " message-handler.js" ) ,
2020-12-12 12:38:54 +01:00
tags $ style ( HTML ( "
@ import url ( ' //fonts.googleapis.com/css?family=Lobster|Cabin:400,700' ) ;
@ import url ( ' //fonts.googleapis.com/css2?family=Fjalla+One' ) ;
" ) ) ) ,
theme = " style.css" ,
# App title ----
2020-12-14 13:47:03 +01:00
uiOutput ( " regform" ) ,
fluidRow (
column ( 12 ,
tags $ span ( " © Copyright Wszystkie prawa zastrzeżone." ) ) %>% tagAppendAttributes ( id = ' column-copyright' ) ,
) %>% tagAppendAttributes ( id = ' row-footer' )
)
}
registerServer <- function ( input , output , session ) {
2020-12-28 16:04:02 +01:00
2020-12-14 13:47:03 +01:00
result <- reactiveValues ( name = NULL , surname = NULL , mail = NULL , age = NULL , gender = NULL , login = NULL , pass = NULL , permission = NULL )
status <- reactiveValues ( status = NULL , first = TRUE )
observe ( {
if ( ( ( session $ clientData ) $ url_hash == " #!/register" ) & ( ! is.null ( input $ token ) & length ( input $ token ) > 0 ) ) {
2020-12-20 15:46:02 +01:00
2020-12-14 13:47:03 +01:00
shinyjs :: runjs ( ' window.location.replace(\'/#!/home\');' )
}
} )
getStatus <- eventReactive ( input $ submit , {
result $ name <- input $ name
result $ surname <- input $ surname
result $ mail <- input $ mail
2020-12-19 23:13:44 +01:00
result $ datebirth <- input $ age
2020-12-14 13:47:03 +01:00
result $ gender <- input $ gender
2020-12-19 23:13:44 +01:00
result $ login <- input $ username
result $ password <- input $ haslo
2020-12-14 13:47:03 +01:00
result $ permission <- input $ permission
reg <- c ( grepl ( " ^[A-Z][a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{2,15}$" , result $ name ) ,
grepl ( " ^[A-Z][a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{2,20}$" , result $ surname ) ,
grepl ( " ^[a-z]+[0-9]*@([a-z]{2,10}\\.)+[a-z]{2,5}$" , result $ mail ) ,
grepl ( " ^([a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]+[0-9\\-\\_]*){5,20}$" , result $ username ) ,
2020-12-19 23:13:44 +01:00
grepl ( " ^([a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{5,}[0-9]{5,}[a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż0-9]*)+$" , result $ password ) )
2020-12-14 13:47:03 +01:00
if ( all ( reg ) & all ( result $ permission == c ( 1 , 2 ) ) ) {
2020-12-20 15:46:02 +01:00
2020-12-19 23:13:44 +01:00
status $ first = FALSE
to_send = list ( name = result $ name ,
surname = result $ surname ,
email = result $ mail ,
datebirth = result $ datebirth ,
gender = result $ gender ,
login = result $ login ,
password = result $ password ,
roleDTO = " IND" )
r <- httr :: POST ( " http://localhost:8080/api/register" , body = to_send , encode = ' json' )
2020-12-20 15:46:02 +01:00
2020-12-19 23:13:44 +01:00
if ( r $ status_code == 200 ) {
status $ status = TRUE
} else {
status $ status = FALSE
}
2020-12-14 13:47:03 +01:00
} else {
status $ status = FALSE
}
2020-12-19 23:13:44 +01:00
status $ status
2020-12-14 13:47:03 +01:00
} )
output $ regform <- renderUI ( {
if ( status $ first == TRUE ) {
2020-12-12 12:38:54 +01:00
fluidRow ( column ( 12 ,
wellPanel (
textInput ( " name" , label = strong ( " Imie" ) ) ,
uiOutput ( " name" ) ,
textInput ( " surname" , label = strong ( " Nazwisko" ) ) ,
2020-12-14 13:47:03 +01:00
uiOutput ( " surname" ) ,
2020-12-12 12:38:54 +01:00
textInput ( " mail" , label = strong ( " Adres email" ) ) ,
2020-12-14 13:47:03 +01:00
uiOutput ( " mail" ) ,
2020-12-12 12:38:54 +01:00
dateInput ( " age" , label = strong ( " Data urodzenia" ) , value = " 1970-01-01" ) ,
2020-12-14 13:47:03 +01:00
2020-12-12 12:38:54 +01:00
selectInput ( " gender" , label = strong ( " Plec" ) ,
choices = list ( " Żenska" = 0 , " Meska" = 1 ) ,
selected = 0 ) ,
2020-12-14 13:47:03 +01:00
textInput ( " username" , label = strong ( " Login" ) ) ,
uiOutput ( " username" ) ,
passwordInput ( " haslo" , label = strong ( " Haslo" ) ) ,
uiOutput ( " haslo" ) ,
2020-12-12 12:38:54 +01:00
checkboxGroupInput ( " permission" , label = strong ( " Wyrażam zgode" ) ,
choices = list ( " Wyrażam zgode na przetwarzanie moich danych osobowych. *" = 1 , " Oswiadczam ze jestem swiadom ze aplikacja TakeCareApp to narzedzie wspierajace diagnostyke i nie moze w pelni zastapic konsultacji medycznej z lekarzem. * " = 2 ) ,
2020-12-14 13:47:03 +01:00
) ,
uiOutput ( " permission" ) ,
actionButton ( " submit" , " Zarejestruj" ) ,
uiOutput ( " btnResponse" , style = " color:yellow;" )
2020-12-12 12:38:54 +01:00
) ) %>% tagAppendAttributes ( id = ' column-login' )
2020-12-14 13:47:03 +01:00
) %>% tagAppendAttributes ( id = ' row-register' )
} else if ( status $ status == FALSE ) {
fluidRow ( column ( 12 ,
wellPanel (
textInput ( " name" , label = strong ( " Imie" ) ) ,
uiOutput ( " name" ) ,
textInput ( " surname" , label = strong ( " Nazwisko" ) ) ,
uiOutput ( " surname" ) ,
textInput ( " mail" , label = strong ( " Adres email" ) ) ,
uiOutput ( " mail" ) ,
dateInput ( " age" , label = strong ( " Data urodzenia" ) , value = " 1970-01-01" ) ,
selectInput ( " gender" , label = strong ( " Plec" ) ,
choices = list ( " Żenska" = 0 , " Meska" = 1 ) ,
selected = 0 ) ,
textInput ( " username" , label = strong ( " Login" ) ) ,
uiOutput ( " username" ) ,
passwordInput ( " haslo" , label = strong ( " Haslo" ) ) ,
uiOutput ( " haslo" ) ,
checkboxGroupInput ( " permission" , label = strong ( " Wyrażam zgode" ) ,
choices = list ( " Wyrażam zgode na przetwarzanie moich danych osobowych. *" = 1 , " Oswiadczam ze jestem swiadom ze aplikacja TakeCareApp to narzedzie wspierajace diagnostyke i nie moze w pelni zastapic konsultacji medycznej z lekarzem. * " = 2 ) ,
) ,
uiOutput ( " permission" ) ,
actionButton ( " submit" , " Zarejestruj" ) ,
uiOutput ( " btnResponse" , style = " color:yellow;" )
) ) %>% tagAppendAttributes ( id = ' column-login' )
) %>% tagAppendAttributes ( id = ' row-register' )
} else {
delay ( 100 , shinyjs :: refresh ( ) )
}
2020-12-12 12:38:54 +01:00
2020-12-14 13:47:03 +01:00
} )
2020-12-12 12:38:54 +01:00
2020-12-14 13:47:03 +01:00
output $ btnResponse <- renderUI ( {
2020-12-12 12:38:54 +01:00
2020-12-14 13:47:03 +01:00
if ( getStatus ( ) == TRUE ) {
p ( " OK" , style = " color:white;text-align:center;" )
} else {
p ( " Uzytkownik istnieje lub wprowadzono bledne dane" , style = " color:yellow;text-align:center;" )
}
2020-12-19 23:13:44 +01:00
2020-12-12 12:38:54 +01:00
2020-12-14 13:47:03 +01:00
} )
output $ name <- renderUI ( {
s <- toString ( input $ name )
2020-12-12 12:38:54 +01:00
2020-12-14 13:47:03 +01:00
if ( s == " " | grepl ( " ^[A-Z][a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{2,15}$" , s ) == TRUE ) {
return ( )
} else {
p ( " Bład: Imie powinno zaczynac sie od wielkiej litery, zawierac jedynie litery i miec dlugosc od 3 do 15 znaków" , style = " color:yellow" )
}
2020-12-12 12:38:54 +01:00
2020-12-14 13:47:03 +01:00
} )
2020-12-12 12:38:54 +01:00
2020-12-14 13:47:03 +01:00
output $ surname <- renderUI ( {
s <- toString ( input $ surname )
if ( s == " " | grepl ( " ^[A-Z][a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{2,20}$" , s ) == TRUE ) {
return ( )
} else {
p ( " Bład: Nazwisko powinno zaczynac sie od wielkiej litery, zawierac jedynie litery i miec dlugosc od 3 do 15 znaków" , style = " color:yellow" )
}
} )
2020-12-12 12:38:54 +01:00
2020-12-14 13:47:03 +01:00
output $ mail <- renderUI ( {
s <- toString ( input $ mail )
2020-12-12 12:38:54 +01:00
2020-12-14 13:47:03 +01:00
if ( s == " " | grepl ( " ^[a-z]+[0-9]*@([a-z]{2,10}\\.)+[a-z]{2,5}$" , s ) == TRUE ) {
return ( )
} else {
p ( " Bład: Mail powinien miec budowe adres@nazwa.domena" , style = " color:yellow" )
}
2020-12-12 12:38:54 +01:00
} )
2020-12-14 13:47:03 +01:00
output $ username <- renderUI ( {
s <- toString ( input $ username )
if ( s == " " ) {
2020-12-12 12:38:54 +01:00
return ( )
} else {
2020-12-14 13:47:03 +01:00
tmps = s
number = findLogin ( tmps )
2020-12-12 12:38:54 +01:00
2020-12-14 13:47:03 +01:00
if ( ( grepl ( " ^([a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]+[0-9\\-\\_]*){5,20}$" , s ) == TRUE ) & number == 0 ) {
return ( )
} else if ( number != 0 ) {
p ( " Bład: Login jest zajety" , style = " color:yellow" )
} else {
p ( " Bład: Login powinien skladac si z liter i cyfr i miec dlugosc od 5 do 15 znaków" , style = " color:yellow" )
}
}
} )
output $ haslo <- renderUI ( {
s <- toString ( input $ haslo )
if ( s == " " | grepl ( " ^([a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż]{5,}[0-9]{5,}[a-zA-ZĄąĆćĘꣳŃńÓ󌜏źŻż0-9]*)+$" , s ) == TRUE ) {
return ( )
} else {
p ( " Bład: Haslo powinno skladac sie z co najmniej 5 liter i 5 cyfr od 10 znaków" , style = " color:yellow" )
}
} )
output $ permission <- renderUI ( {
s <- input $ permission
if ( is.null ( s ) ) {
p ( " Zaakceptuj warunki korzystania z serwisu" , style = " color:yellow" )
} else if ( all ( s == c ( 1 , 2 ) ) ) {
return ( )
} else {
p ( " Zaakceptuj warunki korzystania z serwisu" , style = " color:yellow" )
2020-12-12 12:38:54 +01:00
}
} )
}