Rework media management to use metadata.
This commit is contained in:
Feufochmar
parent
a02208ed74
commit
c62053d28b
|
|
@ -0,0 +1,123 @@
|
|||
#lang racket/base
|
||||
|
||||
(require
|
||||
"stored-objects.rkt"
|
||||
"user.rkt"
|
||||
; Formatting
|
||||
(prefix-in scrib: scribble/reader)
|
||||
)
|
||||
|
||||
(provide
|
||||
; Accessors
|
||||
media-name media-file media-type media-author media-date media-licence media-public?
|
||||
; Operations
|
||||
new-media update-media remove-media
|
||||
get-media-by-name get-media-by-file get-all-medias get-public-medias
|
||||
; Init repo
|
||||
media-init-repository
|
||||
)
|
||||
|
||||
; Media metadata structure
|
||||
(stored-class notepadmedia
|
||||
(name : string?) ; Name of the media, used as shortcut in notes (@media[]{}).
|
||||
(file : string?) ; file path of the media
|
||||
(type : string?) ; type of media
|
||||
(author : integer?) ; author of last update, id of user
|
||||
(date : integer?) ; date of last update
|
||||
(licence : string?) ; Licence of the media
|
||||
(public : boolean?) ; Media publicly listed ?
|
||||
)
|
||||
|
||||
; Repo initialization
|
||||
(define (media-init-repository repo)
|
||||
(init-repository repo
|
||||
notepadmedia))
|
||||
|
||||
; Accessors
|
||||
(define media-name notepadmedia-name)
|
||||
(define media-file notepadmedia-file)
|
||||
(define media-type notepadmedia-type)
|
||||
(define (media-author nt)
|
||||
(define author (get-user-by-id (notepadmedia-author nt)))
|
||||
(and author (user-pseudo author)))
|
||||
(define (media-date nt)
|
||||
(define dt (seconds->date (notepadmedia-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 media-licence notepadmedia-licence)
|
||||
(define media-public? notepadmedia-public)
|
||||
|
||||
; Media Operations
|
||||
|
||||
; New media
|
||||
(define (new-media
|
||||
#:name name
|
||||
#:file file
|
||||
#:type type
|
||||
#:author author
|
||||
#:licence (licence #f)
|
||||
#:public? (public? #f))
|
||||
(within-transaction (class-repository notepadmedia)
|
||||
(define md (instanciate notepadmedia))
|
||||
(set-notepadmedia-name! md name)
|
||||
(set-notepadmedia-file! md file)
|
||||
(set-notepadmedia-type! md type)
|
||||
(set-notepadmedia-author! md (instance-identifier author))
|
||||
(set-notepadmedia-date! md (current-seconds))
|
||||
(set-notepadmedia-licence! md licence)
|
||||
(set-notepadmedia-public! md public?)
|
||||
(save-instance md)
|
||||
md))
|
||||
|
||||
; Update media. If md is #f, create a new media.
|
||||
(define (update-media md
|
||||
#:name name
|
||||
#:file file
|
||||
#:type type
|
||||
#:author author
|
||||
#:licence (licence #f)
|
||||
#:public? (public? #f)
|
||||
)
|
||||
(within-transaction (class-repository notepadmedia)
|
||||
(define new-md (or md (instanciate notepadmedia)))
|
||||
(set-notepadmedia-name! new-md name)
|
||||
(set-notepadmedia-file! new-md file)
|
||||
(set-notepadmedia-type! new-md type)
|
||||
(set-notepadmedia-author! new-md (instance-identifier author))
|
||||
(set-notepadmedia-date! new-md (current-seconds))
|
||||
(set-notepadmedia-licence! new-md licence)
|
||||
(set-notepadmedia-public! new-md public?)
|
||||
(save-instance new-md)
|
||||
new-md))
|
||||
|
||||
; Remove a media
|
||||
(define (remove-media md)
|
||||
(within-transaction (class-repository notepadmedia)
|
||||
; Remove media
|
||||
(delete-instance md)))
|
||||
|
||||
; Find by name
|
||||
(define (get-media-by-name name)
|
||||
(define medias (find-instances notepadmedia `((name . ,name))))
|
||||
(and (not (null? medias))
|
||||
(car medias)))
|
||||
|
||||
; Find by file
|
||||
(define (get-media-by-file file)
|
||||
(define medias (find-instances notepadmedia `((file . ,file))))
|
||||
(and (not (null? medias))
|
||||
(car medias)))
|
||||
|
||||
; Get all medias
|
||||
(define (get-all-medias)
|
||||
(list-instances notepadmedia))
|
||||
|
||||
; Get all public medias
|
||||
(define (get-public-medias)
|
||||
(find-instances notepadmedia '((public . #t))))
|
||||
|
|
@ -4,15 +4,14 @@
|
|||
(provide
|
||||
make-notepad
|
||||
; Media operations
|
||||
notepad-list-media notepad-has-media?
|
||||
notepad-media-type notepad-new-media
|
||||
notepad-move-media notepad-delete-media
|
||||
notepad-new-media notepad-update-media notepad-delete-media
|
||||
)
|
||||
|
||||
(require
|
||||
racket/port
|
||||
racket/string
|
||||
"notes.rkt"
|
||||
"media.rkt"
|
||||
"user.rkt"
|
||||
"stored-objects.rkt"
|
||||
)
|
||||
|
|
@ -41,6 +40,7 @@
|
|||
(define repo (open-repository 'sqlite3 repo-path))
|
||||
(user-init-repository repo)
|
||||
(note-init-repository repo)
|
||||
(media-init-repository repo)
|
||||
(notepad
|
||||
dir
|
||||
repo))
|
||||
|
|
@ -49,42 +49,70 @@
|
|||
(define (notepad-media-dir np)
|
||||
(string-append (notepad-directory np) "/media"))
|
||||
|
||||
|
||||
; List all media
|
||||
(define (notepad-list-media np)
|
||||
(map path->string (directory-list (notepad-media-dir np))))
|
||||
|
||||
; Does the notepad has a given media ?
|
||||
(define (notepad-has-media? np media)
|
||||
(and media (file-exists? (string-append (notepad-media-dir np) "/" media))))
|
||||
|
||||
; Get the type of media
|
||||
; Return 'image, 'other or #f
|
||||
(define (notepad-media-type np media)
|
||||
(cond
|
||||
( (ormap (lambda (x) (string-suffix? media x)) '(".png" ".jpg" ".gif" ".jpeg" ".svg"))
|
||||
'image)
|
||||
"image")
|
||||
( #t
|
||||
'other)))
|
||||
"other")))
|
||||
|
||||
; Save a media
|
||||
; Takes a filename and an input stream
|
||||
(define (notepad-new-media np filename in)
|
||||
(define filepath (string-append (notepad-media-dir np) "/" filename))
|
||||
(define (notepad-new-media np
|
||||
#:path path
|
||||
#:input-stream in
|
||||
#:name name
|
||||
#:author author
|
||||
#:public? public?)
|
||||
(define filepath (string-append (notepad-media-dir np) "/" path))
|
||||
(call-with-output-file
|
||||
filepath
|
||||
(lambda (out)
|
||||
(copy-port in out)
|
||||
(close-input-port in))
|
||||
(close-input-port in)
|
||||
(new-media
|
||||
#:name name
|
||||
#:file path
|
||||
#:type (notepad-media-type np path)
|
||||
#:author author
|
||||
#:public? public?))
|
||||
#:exists 'truncate/replace))
|
||||
|
||||
; Move a media
|
||||
(define (notepad-move-media np media filename)
|
||||
(define media-dir (notepad-media-dir np))
|
||||
(rename-file-or-directory
|
||||
(string-append media-dir "/" media)
|
||||
(string-append media-dir "/" filename)))
|
||||
; Update a media - return #t if there is no error
|
||||
(define (notepad-update-media np media
|
||||
#:path path
|
||||
#:name name
|
||||
#:author author
|
||||
#:public? public?)
|
||||
(cond
|
||||
( (or (not path)
|
||||
(and path (equal? "" path) (string-contains? path "/"))
|
||||
(not name)
|
||||
(and name (equal? "" name)))
|
||||
; Return KO
|
||||
#f)
|
||||
( #t
|
||||
; Move file
|
||||
(when (not (equal? path (media-file media)))
|
||||
(define media-dir (notepad-media-dir np))
|
||||
(rename-file-or-directory
|
||||
(string-append media-dir "/" (media-file media))
|
||||
(string-append media-dir "/" path)))
|
||||
; Update metadata
|
||||
(update-media media
|
||||
#:name name
|
||||
#:file path
|
||||
#:type (media-type media)
|
||||
#:author author
|
||||
#:public? public?)
|
||||
; Return OK
|
||||
#t)))
|
||||
|
||||
; Remove a media
|
||||
(define (notepad-delete-media np media)
|
||||
(delete-file (string-append (notepad-media-dir np) "/" media)))
|
||||
; Delete file
|
||||
(delete-file (string-append (notepad-media-dir np) "/" (media-file media)))
|
||||
; Delete metadata
|
||||
(remove-media media))
|
||||
|
|
|
|||
|
|
@ -8,6 +8,7 @@
|
|||
"../notepad/notepad.rkt"
|
||||
"../notepad/user.rkt"
|
||||
"../notepad/notes.rkt"
|
||||
"../notepad/media.rkt"
|
||||
"../../configuration.rkt"
|
||||
web-server/http/redirect
|
||||
web-server/http/request-structs
|
||||
|
|
@ -79,6 +80,12 @@
|
|||
(content . (article ,(caddr err)))
|
||||
)))
|
||||
|
||||
; Concat a lock to the name if not public
|
||||
(define (displayed-name name public?)
|
||||
(string-append
|
||||
(if public? "" "🔒︎ ")
|
||||
name))
|
||||
|
||||
; Notepad pages
|
||||
|
||||
; Link to a note with a given name
|
||||
|
|
@ -104,12 +111,11 @@
|
|||
(define notes (if connected-usr (get-all-notes) (get-public-notes)))
|
||||
`(article
|
||||
,@(if (null? notes)
|
||||
'("Pas de notes.")
|
||||
'("Pas de note.")
|
||||
(map
|
||||
(lambda (n)
|
||||
`(div (a ((href ,(note-link 'show (note-name n))))
|
||||
,(if (note-public? n) "" "🔒︎ ")
|
||||
,(note-title n))))
|
||||
,(displayed-name (note-title n) (note-public? n)))))
|
||||
notes))
|
||||
,@(if connected-usr
|
||||
'((hr)
|
||||
|
|
@ -128,7 +134,7 @@
|
|||
(cond
|
||||
( (and note (or (note-public? note) connected-usr))
|
||||
( (pages:template
|
||||
#:title (note-title note)
|
||||
#:title (displayed-name (note-title note) (note-public? note))
|
||||
#:author (note-author note)
|
||||
#:date (note-date note)
|
||||
#:content
|
||||
|
|
@ -343,13 +349,14 @@
|
|||
#:content
|
||||
(lambda (param)
|
||||
(define connected-usr (get-user param))
|
||||
(define files (notepad-list-media notepad))
|
||||
(define files (if connected-usr (get-all-medias) (get-public-medias)))
|
||||
`(article
|
||||
,@(if (null? files)
|
||||
'("Pas de fichiers.")
|
||||
'("Pas de fichier.")
|
||||
(map
|
||||
(lambda (x)
|
||||
`(div (a ((href ,(media-link 'show x))) ,x)))
|
||||
(lambda (n)
|
||||
`(div (a ((href ,(media-link 'show (media-file n))))
|
||||
,(displayed-name (media-name n) (media-public? n)))))
|
||||
files))
|
||||
,@(if connected-usr
|
||||
'((hr)
|
||||
|
|
@ -362,25 +369,27 @@
|
|||
; Show a given media of the notepad.
|
||||
(define (pages:notepad:media-show param)
|
||||
(define connected-usr (get-user param))
|
||||
(define media (weblet-parameter-ref param 'media #f))
|
||||
(define direct-link (media-link 'get media))
|
||||
(define file (weblet-parameter-ref param 'media #f))
|
||||
(define direct-link (media-link 'get file))
|
||||
(define media (get-media-by-file file))
|
||||
(cond
|
||||
( (notepad-has-media? notepad media)
|
||||
( media
|
||||
( (pages:template
|
||||
#:title (string-append "Fichier: " media)
|
||||
#:author "feuforeve.fr"
|
||||
#:title (displayed-name (media-name media) (media-public? media))
|
||||
#:author (media-author media)
|
||||
#:date (media-date media)
|
||||
#:content
|
||||
`(article
|
||||
,@(case (notepad-media-type notepad media)
|
||||
( (image)
|
||||
,@(case (media-type media)
|
||||
( ("image")
|
||||
`((a ((href ,direct-link)) (img ((src ,direct-link)(class "image-preview"))))(br)))
|
||||
( else
|
||||
'()))
|
||||
(a ((href ,direct-link)) "Lien vers le fichier")
|
||||
,@(if connected-usr
|
||||
`((hr)
|
||||
(a ((href ,(media-link 'edit media))) "Éditer") " — "
|
||||
(a ((href ,(media-link 'delete media))) "Supprimer"))
|
||||
(a ((href ,(media-link 'edit file))) "Éditer") " — "
|
||||
(a ((href ,(media-link 'delete file))) "Supprimer"))
|
||||
'())
|
||||
))
|
||||
param))
|
||||
|
|
@ -414,22 +423,33 @@
|
|||
(form ((action "/media/new")
|
||||
(method "post")
|
||||
(enctype "multipart/form-data"))
|
||||
(label ((for "filename")) "Fichier à ajouter") (br)
|
||||
(input ((id "filename")(name "filename")(type "file"))) (br)
|
||||
(label ((for "filepath")) "Fichier à ajouter") (br)
|
||||
(input ((id "filepath")(name "filepath")(type "file"))) (br)
|
||||
(label ((for "filename")) "Nom du fichier") (br)
|
||||
(input ((id "filename")(name "filename")(type "text"))) (br)
|
||||
(label ((for "filepublic")) "Public")
|
||||
(input ((id "filepublic")(name "filepublic")(type "checkbox")(value "on"))) (br)
|
||||
(input ((type "submit")
|
||||
(value "Ajouter le fichier")))
|
||||
)))
|
||||
param))
|
||||
( (and connected-usr (eq? method 'post))
|
||||
(define filepath (weblet-parameter-ref param 'filepath #f))
|
||||
(define in (and filepath (weblet-parameter-file-port-ref param 'filepath)))
|
||||
(define filename (weblet-parameter-ref param 'filename #f))
|
||||
(define in (and filename (weblet-parameter-file-port-ref param 'filename)))
|
||||
(define filepublic (equal? "on" (weblet-parameter-ref param 'filepublic #f)))
|
||||
; Save file
|
||||
(cond
|
||||
( (and filename in)
|
||||
(notepad-new-media notepad filename in)
|
||||
( (and filepath in filename)
|
||||
(notepad-new-media notepad
|
||||
#:path filepath
|
||||
#:input-stream in
|
||||
#:name filename
|
||||
#:author connected-usr
|
||||
#:public? filepublic)
|
||||
; Redirect
|
||||
(redirect-to
|
||||
(media-link 'show filename)
|
||||
(media-link 'show filepath)
|
||||
see-other))
|
||||
( #t
|
||||
; Redirect: upload failed
|
||||
|
|
@ -447,11 +467,11 @@
|
|||
(define (pages:notepad:media-edit param)
|
||||
(define connected-usr (get-user param))
|
||||
(define method (weblet-parameter-method param))
|
||||
(define media (weblet-parameter-ref param 'media #f))
|
||||
(define has-media? (notepad-has-media? notepad media))
|
||||
(define file (weblet-parameter-ref param 'media #f))
|
||||
(define media (get-media-by-file file))
|
||||
(define failed? (equal? "t" (weblet-parameter-ref param 'error #f)))
|
||||
(cond
|
||||
( (and has-media? connected-usr (eq? method 'get))
|
||||
( (and media connected-usr (eq? method 'get))
|
||||
; User connected, get method : edit media form
|
||||
( (pages:template
|
||||
#:title "Éditer un fichier"
|
||||
|
|
@ -460,32 +480,42 @@
|
|||
; Display the page as a form
|
||||
`(article
|
||||
,@(if failed?
|
||||
'("Erreur lors du renommage du fichier. Le nom doit être valide." (br))
|
||||
'("Erreur lors du renommage du fichier. Le chemin doit être valide." (br))
|
||||
'())
|
||||
(form ((action ,(media-link 'edit media))
|
||||
(method "post"))
|
||||
(label ((for "filename")) "Nom du fichier") " "
|
||||
(input ((id "filename")(name "filename")(type "text")(value ,media))) (br)
|
||||
(input ((type "submit")
|
||||
(value "Renommer le fichier")))
|
||||
(form
|
||||
((action ,(media-link 'edit file))(method "post"))
|
||||
(label ((for "filepath")) "Chemin du fichier") " "
|
||||
(input ((id "filepath")(name "filepath")(type "text")(value ,file))) (br)
|
||||
(label ((for "filename")) "Nom du fichier") " "
|
||||
(input ((id "filename")(name "filename")(type "text")(value ,(media-name media)))) (br)
|
||||
(label ((for "filepublic")) "Public")
|
||||
(input ((id "filepublic")(name "filepublic")(type "checkbox")(value "on")
|
||||
,@(if (media-public? media) '((checked "true")) '()))) (br)
|
||||
(input ((type "submit")
|
||||
(value "Mettre à jour le fichier")))
|
||||
)))
|
||||
param))
|
||||
( (and has-media? connected-usr (eq? method 'post))
|
||||
( (and media connected-usr (eq? method 'post))
|
||||
(define filepath (weblet-parameter-ref param 'filepath #f))
|
||||
(define filename (weblet-parameter-ref param 'filename #f))
|
||||
(cond
|
||||
( (and filename (not (equal? filename "")) (not (equal? filename media)))
|
||||
; Move file
|
||||
(notepad-move-media notepad media filename)
|
||||
; Redirectuser-check-password
|
||||
(redirect-to
|
||||
(media-link 'show filename)
|
||||
see-other))
|
||||
( #t
|
||||
; Redirect: operation failed
|
||||
(redirect-to
|
||||
(media-link 'edit media "?error=t")
|
||||
see-other))))
|
||||
( has-media?
|
||||
(define filepublic (equal? "on" (weblet-parameter-ref param 'filepublic #f)))
|
||||
; Move file
|
||||
(define ok?
|
||||
(notepad-update-media notepad media
|
||||
#:path filepath
|
||||
#:name filename
|
||||
#:author connected-usr
|
||||
#:public? filepublic))
|
||||
(if ok?
|
||||
; Redirect to show
|
||||
(redirect-to
|
||||
(media-link 'show filepath)
|
||||
see-other)
|
||||
; Redirect: operation failed
|
||||
(redirect-to
|
||||
(media-link 'edit file "?error=t")
|
||||
see-other)))
|
||||
( media
|
||||
; Not allowed
|
||||
(pages:notepad:error param 'unauthorized))
|
||||
( #t
|
||||
|
|
@ -499,33 +529,33 @@
|
|||
(define (pages:notepad:media-delete param)
|
||||
(define connected-usr (get-user param))
|
||||
(define method (weblet-parameter-method param))
|
||||
(define media (weblet-parameter-ref param 'media #f))
|
||||
(define has-media? (notepad-has-media? notepad media))
|
||||
(define file (weblet-parameter-ref param 'media #f))
|
||||
(define media (get-media-by-file file))
|
||||
(cond
|
||||
( (and has-media? connected-usr (eq? method 'get))
|
||||
( (and media connected-usr (eq? method 'get))
|
||||
; Method get => ask for confirmation
|
||||
( (pages:template
|
||||
#:title (string-append "Suppression du fichier " media)
|
||||
#:title (string-append "Suppression de " (media-name media))
|
||||
#:author (user-name connected-usr)
|
||||
#:content
|
||||
`(article
|
||||
(form ((action ,(media-link 'delete media))
|
||||
(form ((action ,(media-link 'delete file))
|
||||
(method "post"))
|
||||
(h3 "Supprimer le fichier " ,media " ? ")
|
||||
(h3 "Supprimer " ,(media-name media) " ? ")
|
||||
"Cette action est irréversible." (br)
|
||||
(input ((type "submit")
|
||||
(value "Oui, supprimer le fichier")))
|
||||
(input ((type "submit")(formaction ,(media-link 'show media))
|
||||
(input ((type "submit")(formaction ,(media-link 'show file))
|
||||
(formmethod "get")(value "Non, garder le fichier")))
|
||||
)))
|
||||
param))
|
||||
( (and has-media? connected-usr (eq? method 'post))
|
||||
( (and media connected-usr (eq? method 'post))
|
||||
; Method post => remove
|
||||
(notepad-delete-media notepad media)
|
||||
(redirect-to
|
||||
"/media/list"
|
||||
see-other))
|
||||
( has-media?
|
||||
( media
|
||||
; Unauthorized
|
||||
(pages:notepad:error param 'unauthorized))
|
||||
( #t
|
||||
|
|
|
|||
Loading…
Reference in New Issue