Move the notes into the database. Also, escape the names when building links.
This commit is contained in:
Feufochmar
parent
74982f6973
commit
14e0267b50
|
|
@ -3,18 +3,10 @@
|
|||
; Notepad application
|
||||
(provide
|
||||
make-notepad
|
||||
; Notes operations
|
||||
notepad-list-notes notepad-has-note?
|
||||
notepad-raw-note notepad-formatted-note
|
||||
notepad-update-note notepad-delete-note
|
||||
; Media operations
|
||||
notepad-list-media notepad-has-media?
|
||||
notepad-media-type notepad-new-media
|
||||
notepad-move-media notepad-delete-media
|
||||
; User operations
|
||||
|
||||
; Format a note
|
||||
notepad-format
|
||||
)
|
||||
|
||||
(require
|
||||
|
|
@ -23,20 +15,19 @@
|
|||
"notes.rkt"
|
||||
"user.rkt"
|
||||
"stored-objects.rkt"
|
||||
(prefix-in scrib: scribble/reader)
|
||||
)
|
||||
|
||||
; Definition of a notepad
|
||||
; A notepad is described by a directory containing the following elements :
|
||||
; - a 'notepad.db' file, containing the notepad sqlite database
|
||||
; - a 'notes' directory, containing the contents of the notes
|
||||
; - a 'media' directory, containing files uploaded by the notepad authors
|
||||
|
||||
; The sqlite database contains :
|
||||
; - a table of users
|
||||
; - a table of cookies, to manage edition of notepad
|
||||
; - a table of note metadata
|
||||
; - a table of media metadata
|
||||
; - a table of notes
|
||||
; - a table of media
|
||||
; - a table of parent/child relations for notes and media
|
||||
|
||||
; Notepad structure
|
||||
(struct notepad
|
||||
|
|
@ -49,148 +40,15 @@
|
|||
(define repo-path (string-append dir "/notepad.db"))
|
||||
(define repo (open-repository 'sqlite3 repo-path))
|
||||
(user-init-repository repo)
|
||||
(note-init-repository repo)
|
||||
(notepad
|
||||
dir
|
||||
repo))
|
||||
|
||||
; Note directory
|
||||
(define (notepad-notes-dir np)
|
||||
(string-append (notepad-directory np) "/notes"))
|
||||
|
||||
; Media directory
|
||||
(define (notepad-media-dir np)
|
||||
(string-append (notepad-directory np) "/media"))
|
||||
|
||||
; List all notes
|
||||
; Return a list of all notes. Each note is a string.
|
||||
(define (notepad-list-notes np)
|
||||
(map path->string (directory-list (notepad-notes-dir np))))
|
||||
|
||||
; Note file path
|
||||
(define (notepad-note-path np note)
|
||||
(string-append (notepad-notes-dir np) "/" note))
|
||||
|
||||
; Does the notepad has a given note ?
|
||||
(define (notepad-has-note? np note)
|
||||
(and note (file-exists? (notepad-note-path np note))))
|
||||
|
||||
; Return a note under its raw format
|
||||
; Return #f if the note does not exists.
|
||||
(define (notepad-raw-note np note)
|
||||
(and (notepad-has-note? np note)
|
||||
(port->string (open-input-file (notepad-note-path np note)))))
|
||||
|
||||
; Return a note in a formatted representation. Return a metadata table.
|
||||
; Return #f if the note does not exists.
|
||||
(define (notepad-formatted-note np note)
|
||||
(and (notepad-has-note? np note)
|
||||
(call-with-input-file (notepad-note-path np note)
|
||||
notepad-format)))
|
||||
|
||||
; Format a raw note input stream into an hash containing metadata and content
|
||||
(define (notepad-format in)
|
||||
; Metadata
|
||||
(define metadata (make-hash))
|
||||
; Recursive parsing function
|
||||
(define (collect parsed)
|
||||
; Recursively apply the parsing:
|
||||
; - filter out #f values (metadata tags)
|
||||
; - Two successive "\n" (i.e a blank line) are replaced by a '(br)
|
||||
(define (recur lst)
|
||||
(filter
|
||||
values
|
||||
(map
|
||||
(lambda (x) (collect x))
|
||||
(reverse
|
||||
(foldl
|
||||
(lambda (val res)
|
||||
(if (and (not (null? res))
|
||||
(equal? "\n" val)
|
||||
(equal? "\n" (car res)))
|
||||
(cons '(br) res)
|
||||
(cons val res)))
|
||||
'()
|
||||
lst)))))
|
||||
; Parse and transform the content
|
||||
(cond
|
||||
; Not a list => output as is
|
||||
((not (list? parsed)) parsed)
|
||||
(#t
|
||||
(case (car parsed)
|
||||
; @title{Title} : metadata: title of the page
|
||||
; @author{Author} : metadata: author of the page
|
||||
; @date{Date} : metadata: date of the page
|
||||
((title author date)
|
||||
(hash-set! metadata (car parsed) (apply string-append (cdr parsed)))
|
||||
#f)
|
||||
; @link[path]{Text} : content: link to another page
|
||||
((link)
|
||||
`(a ((href ,(symbol->string (cadr parsed))))
|
||||
,@(recur (cddr parsed))))
|
||||
; @image[path]{Alt text} : content: image
|
||||
((image)
|
||||
(define alt (apply string-append (cddr parsed)))
|
||||
`(img ((src ,(symbol->string (cadr parsed)))
|
||||
(alt ,alt)
|
||||
(title ,alt))))
|
||||
; @strong{Text} : content : strong
|
||||
; @str{Text} : content : strong
|
||||
((strong str)
|
||||
`(strong ,@(recur (cdr parsed))))
|
||||
; @emphase{Text} : content : emphase
|
||||
; @emp{Text} : content : emphase
|
||||
((emphase emp)
|
||||
`(em ,@(recur (cdr parsed))))
|
||||
; @section{Text} : content : title and start of section
|
||||
((section)
|
||||
`(h2 ,@(recur (cdr parsed))))
|
||||
; @subsection{Text} : content : title and start of subsection
|
||||
((subsection)
|
||||
`(h3 ,@(recur (cdr parsed))))
|
||||
; @subsubsection{Text} : content : title and start of subsubsection
|
||||
((subsubsection)
|
||||
`(h4 ,@(recur (cdr parsed))))
|
||||
; @paragraph[justify]{Text} : content : paragraph with an optional justification
|
||||
; @para[justify]{Text} : content : paragraph with an optional justification
|
||||
((paragraph para)
|
||||
(if (not (null? (cdr parsed)))
|
||||
(case (cadr parsed)
|
||||
((left) `(p ((style "text-align: left;")) ,@(recur (cddr parsed))))
|
||||
((right) `(p ((style "text-align: right;")) ,@(recur (cddr parsed))))
|
||||
((center centered) `(p ((style "text-align: center;")) ,@(recur (cddr parsed))))
|
||||
(else `(p ,@(recur (cdr parsed)))))
|
||||
#f))
|
||||
; Other kind of lists: recurse on them
|
||||
(else
|
||||
(recur parsed))
|
||||
))))
|
||||
; Parse
|
||||
(hash-set!
|
||||
metadata
|
||||
'content
|
||||
(collect
|
||||
(scrib:read-inside in)))
|
||||
metadata)
|
||||
|
||||
; Update a note. If note and new-note are different, the note is renamed.
|
||||
(define (notepad-update-note np note new-note new-content)
|
||||
(define old-file (and note (notepad-note-path np note)))
|
||||
(define new-file (notepad-note-path np new-note))
|
||||
; Save page to file
|
||||
(call-with-output-file
|
||||
new-file
|
||||
(lambda (out)
|
||||
(display new-content out))
|
||||
#:exists 'truncate/replace)
|
||||
; Name has changed ? If yes, remove the old page
|
||||
(when (and old-file (file-exists? old-file) (not (equal? old-file new-file)))
|
||||
(delete-file old-file)))
|
||||
|
||||
; Delete a note
|
||||
(define (notepad-delete-note np note)
|
||||
(define file (notepad-note-path np note))
|
||||
(when (file-exists? file)
|
||||
(delete-file file)))
|
||||
|
||||
; List all media
|
||||
(define (notepad-list-media np)
|
||||
|
|
|
|||
|
|
@ -1 +1,189 @@
|
|||
#lang racket/base
|
||||
|
||||
(require
|
||||
"stored-objects.rkt"
|
||||
"user.rkt"
|
||||
; Formatting
|
||||
(prefix-in scrib: scribble/reader)
|
||||
)
|
||||
|
||||
(provide
|
||||
; Accessors
|
||||
note-name note-title note-author note-date note-content note-licence note-public?
|
||||
; Operations
|
||||
new-note update-note remove-note
|
||||
get-note-by-name get-all-notes
|
||||
format-note
|
||||
; Init repo
|
||||
note-init-repository
|
||||
)
|
||||
|
||||
; Note structure
|
||||
(stored-class notepadnote
|
||||
(name : string?) ; Name of the note, used for the URI (metadata)
|
||||
(title : string?) ; title of note (metadata)
|
||||
(author : integer?) ; author of last update (metadata), id of user
|
||||
(content : string?) ; content of the note (raw format)
|
||||
(date : integer?) ; date of last update (metadata)
|
||||
(licence : string?) ; Licence of the note (metadata)
|
||||
(public : boolean?) ; Public note ? (metadata)
|
||||
)
|
||||
|
||||
; Repo initialization
|
||||
(define (note-init-repository repo)
|
||||
(init-repository repo
|
||||
notepadnote))
|
||||
|
||||
; Accessors
|
||||
(define note-name notepadnote-name)
|
||||
(define note-title notepadnote-title)
|
||||
(define (note-author nt)
|
||||
(define author (get-user-by-id (notepadnote-author nt)))
|
||||
(and author (user-pseudo author)))
|
||||
(define (note-date nt)
|
||||
(define dt (seconds->date (notepadnote-date nt)))
|
||||
(define (add-zero x)
|
||||
(if (< x 10)
|
||||
(string-append "0" (number->string x))
|
||||
x))
|
||||
(format "~a-~a-~a"
|
||||
(date-year dt)
|
||||
(add-zero (date-month dt))
|
||||
(add-zero (date-day dt))))
|
||||
(define note-content notepadnote-content)
|
||||
(define note-licence notepadnote-licence)
|
||||
(define note-public? notepadnote-public)
|
||||
|
||||
; Note Operations
|
||||
|
||||
; New note
|
||||
(define (new-note
|
||||
#:name name
|
||||
#:title title
|
||||
#:author author
|
||||
#:content content
|
||||
#:licence (licence #f)
|
||||
#:public? (public? #f))
|
||||
(within-transaction (class-repository notepadnote)
|
||||
(define nt (instanciate notepadnote))
|
||||
(set-notepadnote-name! nt name)
|
||||
(set-notepadnote-title! nt title)
|
||||
(set-notepadnote-author! nt (instance-identifier author))
|
||||
(set-notepadnote-content! nt content)
|
||||
(set-notepadnote-date! nt (current-seconds))
|
||||
(set-notepadnote-licence! nt licence)
|
||||
(set-notepadnote-public! nt public?)
|
||||
(save-instance nt)
|
||||
nt))
|
||||
|
||||
; Update note. If nt is #f, create a new note.
|
||||
(define (update-note nt
|
||||
#:name name
|
||||
#:title title
|
||||
#:author author
|
||||
#:content content
|
||||
#:licence (licence #f)
|
||||
#:public? (public? #f)
|
||||
)
|
||||
(within-transaction (class-repository notepadnote)
|
||||
(define new-nt (or nt (instanciate notepadnote)))
|
||||
(set-notepadnote-name! new-nt name)
|
||||
(set-notepadnote-title! new-nt title)
|
||||
(set-notepadnote-author! new-nt (instance-identifier author))
|
||||
(set-notepadnote-content! new-nt content)
|
||||
(set-notepadnote-date! new-nt (current-seconds))
|
||||
(set-notepadnote-licence! new-nt licence)
|
||||
(set-notepadnote-public! new-nt public?)
|
||||
(save-instance new-nt)
|
||||
new-nt))
|
||||
|
||||
; Remove a note
|
||||
(define (remove-note nt)
|
||||
(within-transaction (class-repository notepadnote)
|
||||
; Remove note
|
||||
(delete-instance nt)))
|
||||
|
||||
; Find by name
|
||||
(define (get-note-by-name name)
|
||||
(define notes (find-instances notepadnote `((name . ,name))))
|
||||
(and (not (null? notes))
|
||||
(car notes)))
|
||||
|
||||
; Get all notes
|
||||
(define (get-all-notes)
|
||||
(list-instances notepadnote))
|
||||
|
||||
; Format a note
|
||||
(define (format-note nt)
|
||||
; Recursive parsing function
|
||||
(define (collect parsed)
|
||||
; Recursively apply the parsing:
|
||||
; - filter out #f values
|
||||
; - Two successive "\n" (i.e a blank line) are replaced by a '(br)
|
||||
(define (recur lst)
|
||||
(filter
|
||||
values
|
||||
(map
|
||||
(lambda (x) (collect x))
|
||||
(reverse
|
||||
(foldl
|
||||
(lambda (val res)
|
||||
(if (and (not (null? res))
|
||||
(equal? "\n" val)
|
||||
(equal? "\n" (car res)))
|
||||
(cons '(br) res)
|
||||
(cons val res)))
|
||||
'()
|
||||
lst)))))
|
||||
; Parse and transform the content
|
||||
(cond
|
||||
; Not a list => output as is
|
||||
((not (list? parsed)) parsed)
|
||||
(#t
|
||||
(case (car parsed)
|
||||
; @link[path]{Text} : content: link to another page
|
||||
((link)
|
||||
`(a ((href ,(symbol->string (cadr parsed))))
|
||||
,@(recur (cddr parsed))))
|
||||
; @image[path]{Alt text} : content: image
|
||||
((image)
|
||||
(define alt (apply string-append (cddr parsed)))
|
||||
`(img ((src ,(symbol->string (cadr parsed)))
|
||||
(alt ,alt)
|
||||
(title ,alt))))
|
||||
; @strong{Text} : content : strong
|
||||
; @str{Text} : content : strong
|
||||
((strong str)
|
||||
`(strong ,@(recur (cdr parsed))))
|
||||
; @emphase{Text} : content : emphase
|
||||
; @emp{Text} : content : emphase
|
||||
((emphase emp)
|
||||
`(em ,@(recur (cdr parsed))))
|
||||
; @section{Text} : content : title and start of section
|
||||
((section)
|
||||
`(h2 ,@(recur (cdr parsed))))
|
||||
; @subsection{Text} : content : title and start of subsection
|
||||
((subsection)
|
||||
`(h3 ,@(recur (cdr parsed))))
|
||||
; @subsubsection{Text} : content : title and start of subsubsection
|
||||
((subsubsection)
|
||||
`(h4 ,@(recur (cdr parsed))))
|
||||
; @paragraph[justify]{Text} : content : paragraph with an optional justification
|
||||
; @para[justify]{Text} : content : paragraph with an optional justification
|
||||
((paragraph para)
|
||||
(if (not (null? (cdr parsed)))
|
||||
(case (cadr parsed)
|
||||
((left) `(p ((style "text-align: left;")) ,@(recur (cddr parsed))))
|
||||
((right) `(p ((style "text-align: right;")) ,@(recur (cddr parsed))))
|
||||
((center centered) `(p ((style "text-align: center;")) ,@(recur (cddr parsed))))
|
||||
(else `(p ,@(recur (cdr parsed)))))
|
||||
#f))
|
||||
; Other kind of lists: recurse on them
|
||||
(else
|
||||
(recur parsed))
|
||||
))))
|
||||
;
|
||||
(collect
|
||||
(scrib:read-inside
|
||||
(open-input-string
|
||||
(notepadnote-content nt)))))
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@
|
|||
(provide
|
||||
user-init-repository
|
||||
hash-password
|
||||
new-user get-user-by-name update-user-info remove-user get-all-users
|
||||
new-user get-user-by-id get-user-by-name update-user-info remove-user get-all-users
|
||||
user-name user-pseudo user-about user-icon user-check-password
|
||||
same-user?
|
||||
new-usercookie update-usercookie-by-value remove-usercookie-by-value remove-expired-usercookies
|
||||
|
|
|
|||
|
|
@ -7,9 +7,11 @@
|
|||
"../webcontainer/weblet-parameter.rkt"
|
||||
"../notepad/notepad.rkt"
|
||||
"../notepad/user.rkt"
|
||||
"../notepad/notes.rkt"
|
||||
web-server/http/redirect
|
||||
web-server/http/request-structs
|
||||
net/cookies/server
|
||||
net/uri-codec
|
||||
)
|
||||
|
||||
(provide
|
||||
|
|
@ -79,6 +81,18 @@
|
|||
)))
|
||||
|
||||
; Notepad pages
|
||||
|
||||
; Link to a note with a given name
|
||||
(define (note-link type name . args)
|
||||
(string-append
|
||||
(case type
|
||||
((show) "/notes/show/")
|
||||
((edit) "/notes/edit/")
|
||||
((delete) "/notes/delete/")
|
||||
(else ""))
|
||||
(uri-encode name)
|
||||
(apply string-append args)))
|
||||
|
||||
; /notes/list
|
||||
; Lists all the pages of the notepad.
|
||||
(define pages:notepad:page-list
|
||||
|
|
@ -90,13 +104,13 @@
|
|||
(define connected-usr (get-user param))
|
||||
(define secured? (check-secured? param))
|
||||
(define can-edit? (and connected-usr secured?))
|
||||
(define notes (notepad-list-notes notepad))
|
||||
(define notes (get-all-notes))
|
||||
`(article
|
||||
,@(if (null? notes)
|
||||
'("Pas de notes.")
|
||||
(map
|
||||
(lambda (x)
|
||||
`(div (a ((href ,(string-append "/notes/show/" x))) ,x)))
|
||||
(lambda (n)
|
||||
`(div (a ((href ,(note-link 'show (note-name n)))) ,(note-title n))))
|
||||
notes))
|
||||
,@(if can-edit?
|
||||
'((hr)
|
||||
|
|
@ -113,26 +127,27 @@
|
|||
(define secured? (check-secured? param))
|
||||
(define can-edit? (and connected-usr secured?))
|
||||
(define page (weblet-parameter-ref param 'page #f))
|
||||
(define page-metadata (notepad-formatted-note notepad page))
|
||||
(define note (get-note-by-name page))
|
||||
(cond
|
||||
( page-metadata
|
||||
( note
|
||||
( (pages:template
|
||||
#:title (hash-ref page-metadata 'title "Sans titre")
|
||||
#:author (hash-ref page-metadata 'author "feuforeve.fr")
|
||||
#:title (note-title note)
|
||||
#:author (note-author note)
|
||||
#:date (note-date note)
|
||||
#:content
|
||||
`(article
|
||||
,@(hash-ref page-metadata 'content "")
|
||||
,@(format-note note)
|
||||
,@(if can-edit?
|
||||
`((hr)
|
||||
(a ((href ,(string-append "/notes/edit/" page))) "Éditer") " — "
|
||||
(a ((href ,(string-append "/notes/delete/" page))) "Supprimer"))
|
||||
(a ((href ,(note-link 'edit page))) "Éditer") " — "
|
||||
(a ((href ,(note-link 'delete page))) "Supprimer"))
|
||||
'())
|
||||
))
|
||||
param))
|
||||
( can-edit?
|
||||
; Page does not exists, but user can edit => redirect to page creation
|
||||
(redirect-to
|
||||
(string-append "/notes/edit/" page)
|
||||
(note-link 'edit page)
|
||||
see-other))
|
||||
( #t
|
||||
(pages:notepad:error param 'not-found))))
|
||||
|
|
@ -146,43 +161,63 @@
|
|||
(define secured? (check-secured? param))
|
||||
(define method (weblet-parameter-method param))
|
||||
(define page (weblet-parameter-ref param 'page #f))
|
||||
(define page-raw-data (notepad-raw-note notepad page))
|
||||
(define note (get-note-by-name page))
|
||||
(define err? (equal? "t" (weblet-parameter-ref param 'error #f)))
|
||||
(cond
|
||||
( (and connected-usr secured? (eq? method 'get))
|
||||
; User connected, get method : read the page
|
||||
(define content (or page-raw-data ""))
|
||||
(define page-name (or page "nouvelle.note"))
|
||||
(define title (or (and note (note-title note)) ""))
|
||||
(define content (or (and note (note-content note)) ""))
|
||||
(define page-name (or page "SansNom"))
|
||||
( (pages:template
|
||||
#:title (string-append "Édition de la page '" page-name "'")
|
||||
#:title (string-append "Édition de la note '" page-name "'")
|
||||
#:author (user-name connected-usr)
|
||||
#:content
|
||||
; Display the page as a form
|
||||
`(article
|
||||
(form ((action ,(string-append "/notes/edit/" page-name))
|
||||
,(if err?
|
||||
'(p "Erreur: le nom de la page ne peut être vide.")
|
||||
"")
|
||||
(form ((action ,(note-link 'edit page-name))
|
||||
(method "post"))
|
||||
(label ((for "pagename")) "Nom de la note") (br)
|
||||
(input ((id "pagename")(name "pagename")(type "text")(value ,page-name))) (br)
|
||||
(label ((for "pagetitle")) "Titre de la note") (br)
|
||||
(input ((id "pagetitle")(name "pagetitle")(type "text")(value ,title))) (br)
|
||||
(label ((for "pagecontent")) "Contenu de la note") (br)
|
||||
(textarea ((rows "10")(cols "80")(id "pagecontent")(name "pagecontent"))
|
||||
,content) (br)
|
||||
(input ((type "submit")
|
||||
(value "Sauver et quitter l'édition")))
|
||||
(input ((type "submit")(formaction ,(string-append "/notes/edit/" page-name "?continue=t"))
|
||||
(input ((type "submit")(formaction ,(note-link 'edit page-name "?continue=t"))
|
||||
(value "Sauver et continuer l'édition")))
|
||||
)))
|
||||
param))
|
||||
( (and page connected-usr secured? (eq? method 'post))
|
||||
(define continue? (equal? "t" (weblet-parameter-ref param 'continue #f)))
|
||||
(define page-name (weblet-parameter-ref param 'pagename #f))
|
||||
(define new-page-content (weblet-parameter-ref param 'pagecontent #f))
|
||||
(define new-page-name (or (and (not (equal? "" page-name)) page-name)
|
||||
(define new-note-title (weblet-parameter-ref param 'pagetitle #f))
|
||||
(define new-note-content (weblet-parameter-ref param 'pagecontent #f))
|
||||
(define new-note-name (or (and (not (equal? "" page-name)) page-name)
|
||||
page))
|
||||
; Save page
|
||||
(notepad-update-note notepad page new-page-name new-page-content)
|
||||
; Redirect
|
||||
(redirect-to
|
||||
(string-append (if continue? "/notes/edit/" "/notes/show/") new-page-name)
|
||||
see-other))
|
||||
; Check validity
|
||||
(cond
|
||||
( (and new-note-name (not (equal? new-note-name "")))
|
||||
; Save page
|
||||
(update-note note
|
||||
#:name new-note-name
|
||||
#:title new-note-title
|
||||
#:content new-note-content
|
||||
#:author connected-usr)
|
||||
; Redirect
|
||||
(redirect-to
|
||||
(note-link (if continue? 'edit 'show) new-note-name)
|
||||
see-other))
|
||||
( #t
|
||||
; Error: redirect to edit
|
||||
(redirect-to
|
||||
(note-link 'edit page "?error=t")
|
||||
see-other))))
|
||||
( page
|
||||
; Edition is not allowed
|
||||
(pages:notepad:error param 'unauthorized))
|
||||
|
|
@ -199,39 +234,53 @@
|
|||
(define secured? (check-secured? param))
|
||||
(define method (weblet-parameter-method param))
|
||||
(define page (weblet-parameter-ref param 'page #f))
|
||||
(define has-page? (notepad-has-note? notepad page))
|
||||
(define note (get-note-by-name page))
|
||||
(cond
|
||||
( (and has-page? connected-usr secured? (eq? method 'get))
|
||||
( (and note connected-usr secured? (eq? method 'get))
|
||||
; Method get => ask for confirmation
|
||||
( (pages:template
|
||||
#:title (string-append "Suppression de la page " page)
|
||||
#:author (user-name connected-usr)
|
||||
#:content
|
||||
`(article
|
||||
(form ((action ,(string-append "/notes/delete/" page))
|
||||
(method "post"))
|
||||
(form ((action ,(note-link 'delete page))
|
||||
(method "post"))
|
||||
(h3 "Supprimer la page " ,page " ? ")
|
||||
"Cette action est irréversible." (br)
|
||||
(input ((type "submit")
|
||||
(value "Oui, supprimer la page")))
|
||||
(input ((type "submit")(formaction ,(string-append "/notes/show/" page))
|
||||
(input ((type "submit")(formaction ,(note-link 'show page))
|
||||
(formmethod "get")(value "Non, garder la page")))
|
||||
)))
|
||||
param))
|
||||
( (and has-page? connected-usr secured? (eq? method 'post))
|
||||
( (and note connected-usr secured? (eq? method 'post))
|
||||
; Method post => remove
|
||||
(notepad-delete-note notepad page)
|
||||
(remove-note note)
|
||||
; Redirect
|
||||
(redirect-to
|
||||
"/notes/list"
|
||||
see-other))
|
||||
( has-page?
|
||||
( note
|
||||
; Unauthorized
|
||||
(pages:notepad:error param 'unauthorized))
|
||||
( #t
|
||||
; No such page
|
||||
(pages:notepad:error param 'not-found))))
|
||||
|
||||
; Media
|
||||
|
||||
; Link to a media with a given name
|
||||
(define (media-link type name . args)
|
||||
(string-append
|
||||
(case type
|
||||
((get) "/media/get/")
|
||||
((show) "/media/show/")
|
||||
((edit) "/media/edit/")
|
||||
((delete) "/media/delete/")
|
||||
(else ""))
|
||||
(uri-encode name)
|
||||
(apply string-append args)))
|
||||
|
||||
; /media/list
|
||||
; Lists all medias of the notepad.
|
||||
(define pages:notepad:media-list
|
||||
|
|
@ -249,7 +298,7 @@
|
|||
'("Pas de fichiers.")
|
||||
(map
|
||||
(lambda (x)
|
||||
`(div (a ((href ,(string-append "/media/show/" x))) ,x)))
|
||||
`(div (a ((href ,(media-link 'show x))) ,x)))
|
||||
files))
|
||||
,@(if can-edit?
|
||||
'((hr)
|
||||
|
|
@ -265,7 +314,7 @@
|
|||
(define secured? (check-secured? param))
|
||||
(define can-edit? (and connected-usr secured?))
|
||||
(define media (weblet-parameter-ref param 'media #f))
|
||||
(define direct-link (string-append "/media/get/" media))
|
||||
(define direct-link (media-link 'get media))
|
||||
(cond
|
||||
( (notepad-has-media? notepad media)
|
||||
( (pages:template
|
||||
|
|
@ -281,8 +330,8 @@
|
|||
(a ((href ,direct-link)) "Lien vers le fichier")
|
||||
,@(if can-edit?
|
||||
`((hr)
|
||||
(a ((href ,(string-append "/media/edit/" media))) "Éditer") " — "
|
||||
(a ((href ,(string-append "/media/delete/" media))) "Supprimer"))
|
||||
(a ((href ,(media-link 'edit media))) "Éditer") " — "
|
||||
(a ((href ,(media-link 'delete media))) "Supprimer"))
|
||||
'())
|
||||
))
|
||||
param))
|
||||
|
|
@ -332,7 +381,7 @@
|
|||
(notepad-new-media notepad filename in)
|
||||
; Redirect
|
||||
(redirect-to
|
||||
(string-append "/media/show/" filename)
|
||||
(media-link 'show filename)
|
||||
see-other))
|
||||
( #t
|
||||
; Redirect: upload failed
|
||||
|
|
@ -366,7 +415,7 @@
|
|||
,@(if failed?
|
||||
'("Erreur lors du renommage du fichier. Le nom doit être valide." (br))
|
||||
'())
|
||||
(form ((action ,(string-append "/media/edit/" media))
|
||||
(form ((action ,(media-link 'edit media))
|
||||
(method "post"))
|
||||
(label ((for "filename")) "Nom du fichier") " "
|
||||
(input ((id "filename")(name "filename")(type "text")(value ,media))) (br)
|
||||
|
|
@ -382,12 +431,12 @@
|
|||
(notepad-move-media notepad media filename)
|
||||
; Redirectuser-check-password
|
||||
(redirect-to
|
||||
(string-append "/media/show/" filename)
|
||||
(media-link 'show filename)
|
||||
see-other))
|
||||
( #t
|
||||
; Redirect: operation failed
|
||||
(redirect-to
|
||||
(string-append "/media/edit/" media "?error=t")
|
||||
(media-link 'edit media "?error=t")
|
||||
see-other))))
|
||||
( has-media?
|
||||
; Not allowed
|
||||
|
|
@ -396,7 +445,6 @@
|
|||
; Not found
|
||||
(pages:notepad:error param 'not-found))))
|
||||
|
||||
|
||||
; /media/delete/xxx
|
||||
; Remove an existing media. User must be logged in.
|
||||
; Get => ask confirmation
|
||||
|
|
@ -415,13 +463,13 @@
|
|||
#:author (user-name connected-usr)
|
||||
#:content
|
||||
`(article
|
||||
(form ((action ,(string-append "/media/delete/" media))
|
||||
(form ((action ,(media-link 'delete media))
|
||||
(method "post"))
|
||||
(h3 "Supprimer le fichier " ,media " ? ")
|
||||
"Cette action est irréversible." (br)
|
||||
(input ((type "submit")
|
||||
(value "Oui, supprimer le fichier")))
|
||||
(input ((type "submit")(formaction ,(string-append "/media/show/" media))
|
||||
(input ((type "submit")(formaction ,(media-link 'show media))
|
||||
(formmethod "get")(value "Non, garder le fichier")))
|
||||
)))
|
||||
param))
|
||||
|
|
@ -438,6 +486,18 @@
|
|||
; No such page
|
||||
(pages:notepad:error param 'not-found))))
|
||||
|
||||
; User
|
||||
; Link to a user with a given name
|
||||
(define (user-link type name . args)
|
||||
(string-append
|
||||
(case type
|
||||
((show) "/user/show/")
|
||||
((edit) "/user/edit/")
|
||||
((login) "/user/login/")
|
||||
(else ""))
|
||||
(uri-encode name)
|
||||
(apply string-append args)))
|
||||
|
||||
; /user/list
|
||||
; Lists all the users of the notepad.
|
||||
(define pages:notepad:user-list
|
||||
|
|
@ -452,7 +512,7 @@
|
|||
`(article
|
||||
,@(map
|
||||
(lambda (u)
|
||||
`(div (a ((href ,(string-append "/user/show/" (user-name u)))) ,(user-pseudo u))))
|
||||
`(div (a ((href ,(user-link 'show (user-name u)))) ,(user-pseudo u))))
|
||||
users))))
|
||||
))
|
||||
|
||||
|
|
@ -473,7 +533,7 @@
|
|||
(content . (article
|
||||
,(cond
|
||||
( edition-possible?
|
||||
`(form ((action ,(string-append "/user/edit/" (user-name usr)))
|
||||
`(form ((action ,(user-link 'edit (user-name usr)))
|
||||
(method "post"))
|
||||
(label ((for "pseudo")) "Pseudo") " "
|
||||
(input ((name "pseudo")(id "pseudo")(type "text")(value ,(user-pseudo usr)))) (br)
|
||||
|
|
@ -488,7 +548,7 @@
|
|||
(hr)
|
||||
,(cond
|
||||
( (and secured? (not connected-usr))
|
||||
`(p (a ((href ,(string-append "/user/login/" (user-name usr))))
|
||||
`(p (a ((href ,(user-link 'login (user-name usr))))
|
||||
"Se connecter en tant que " ,(user-pseudo usr))))
|
||||
( (and secured? edition-possible?)
|
||||
`(p (a ((href ,(string-append "/user/logout")))
|
||||
|
|
@ -545,7 +605,7 @@
|
|||
,(if (equal? incorrect "t")
|
||||
"Vous n'avez pas dit le mot magique."
|
||||
"")
|
||||
(form ((action ,(string-append "/user/login/" (user-name usr)))
|
||||
(form ((action ,(user-link 'login (user-name usr)))
|
||||
(method "post"))
|
||||
(label ((for "pass")) "Mot de passe") " "
|
||||
(input ((id "pass")(name "pass")(type "password")(required "true"))) (br)
|
||||
|
|
@ -563,7 +623,7 @@
|
|||
; Password OK, set cookie and redirect to /user/show/xxx
|
||||
(define usercookie (new-usercookie usr))
|
||||
(redirect-to
|
||||
(string-append "/user/show/" (user-name usr))
|
||||
(user-link 'show (user-name usr))
|
||||
see-other
|
||||
#:headers (list
|
||||
(make-header
|
||||
|
|
@ -581,7 +641,7 @@
|
|||
( usr
|
||||
; KO, redirect to /user/login/xxx?incorrect=t
|
||||
(redirect-to
|
||||
(string-append "/user/login/" (user-name usr) "?incorrect=t")
|
||||
(user-link 'login (user-name usr) "?incorrect=t")
|
||||
see-other))
|
||||
(#t
|
||||
(pages:notepad:error param 'not-found))))
|
||||
|
|
@ -603,7 +663,7 @@
|
|||
(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))
|
||||
(user-link 'show (user-name usr))
|
||||
see-other))
|
||||
(#t
|
||||
(pages:notepad:error param 'not-found))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue