Feufochmar
/
feuforeve.v4
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Add user info edition.

This commit is contained in:
Feufochmar 2021-05-05 17:29:29 +02:00
parent 3ca823578c
commit 97ac116753
3 changed files with 48 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
main.rkt
View File

@ -86,6 +86,7 @@
("show/{name}" matching-weblet pages:notepad:user-show)
("login/{name}" matching-weblet pages:notepad:user-login)
("logout" weblet pages:notepad:user-logout)
("edit/{name}" matching-weblet pages:notepad:user-edit)
)
))
; Sitemap

2
src/notepad/user.rkt
View File

@ -80,7 +80,7 @@
#:icon [icon #f])
(within-transaction (class-repository user)
(and pseudo (set-user-pseudo! usr pseudo))
(and about (set-user-about! usr pseudo))
(and about (set-user-about! usr about))
(and icon (set-user-icon! usr icon))
(save-instance usr)
usr))

51
src/pages/notepad.rkt
View File

@ -20,6 +20,7 @@
pages:notepad:user-show
pages:notepad:user-login
pages:notepad:user-logout
pages:notepad:user-edit
)
; Notepad directory
@ -217,7 +218,11 @@
(lambda (param)
(define usr (get-user-by-name (weblet-parameter-ref param 'name #f)))
(define connected-usr (get-user-from-weblet-parameter param))
(define protocol (weblet-parameter-protocol param))
(define edition-possible?
(and usr connected-usr
(eq? (instance-identifier usr)
(instance-identifier connected-usr))))
(define secured? (check-secured? param))
(cond
(usr
(make-immutable-hash
@ -225,13 +230,26 @@
(title . ,(string-append "À propos de " (user-pseudo usr)))
(content . (article
(hr)
,(user-about usr)
,(cond
( edition-possible?
`(form ((action ,(string-append "/user/edit/" (user-name usr)))
(method "post"))
(label ((for "pseudo")) "Pseudo") " "
(input ((name "pseudo")(id "pseudo")(type "text")(value ,(user-pseudo usr)))) (br)
(label ((for "about")) "Présentation") (br)
(textarea ((rows "5")(cols "40")(id "about")(name "about"))
,(user-about usr)) (br)
(input ((type "submit")(value "Mettre à jour")))
))
(#t
(user-about usr)
))
(hr)
,(cond
( (and (or (eq? protocol 'https) dev?) (not connected-usr))
( (and secured? (not connected-usr))
`(p (a ((href ,(string-append "/user/login/" (user-name usr))))
"Se connecter en tant que " ,(user-pseudo usr))))
( (and (or (eq? protocol 'https) dev?) connected-usr)
( (and secured? edition-possible?)
`(p (a ((href ,(string-append "/user/logout")))
"Se déconnecter")))
( #t
@ -286,7 +304,8 @@
,(if (equal? incorrect "t")
"Vous n'avez pas dit le mot magique."
"")
(form ((action ,(string-append "/user/login/" (user-name usr)))(method "post"))
(form ((action ,(string-append "/user/login/" (user-name usr)))
(method "post"))
(label ((for "pass")) "Mot de passe") " "
(input ((id "pass")(name "pass")(type "password")(required "true"))) (br)
(input ((type "submit")(value "Se connecter")))
@ -316,6 +335,28 @@
; /user/edit/xxx
; Edit page for the user xxx. Must be logged in as user xxx.
; Post only, as it is used to update the /user/show/xxx
(define (pages:notepad:user-edit param)
(define usr (get-user-by-name (weblet-parameter-ref param 'name #f)))
(define connected-usr (get-user-from-weblet-parameter param))
(define edition-possible?
(and usr connected-usr
(eq? (instance-identifier usr)
(instance-identifier connected-usr))))
(define secured? (check-secured? param))
(define method (weblet-parameter-method param))
(cond
( (and edition-possible?
secured?
(eq? method 'post))
(define pseudo (weblet-parameter-ref param 'pseudo (user-pseudo usr)))
(define about (weblet-parameter-ref param 'about (user-about usr)))
(update-user-info usr #:pseudo pseudo #:about about)
(redirect-to
(string-append "/user/show/" (user-name usr))
see-other))
(#t
((pages:adaptable-template (not-found)) param))))
; /user/logout
; Logout page.