vegashacker / leftparen
watch download tarball
public
Forks8Right
Watchers18Right
Description: An easy way to make web apps (in PLT Scheme)
Homepage: http://blog.leftparen.com
Clone URL: git://github.com/vegashacker/leftparen.git
Click here to lend your support to: leftparen and make a donation at www.pledgie.com !
leftparen / files.scm
100644 25 lines (19 sloc) 0.973 kb
raw blame history 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

#lang scheme/base
 
(require (file "util.scm")
         (file "web-support.scm")
         "settings.scm")
 
(provide save-uploaded-file-and-return-filename!)
 
(declare-setting *PATH_TO_UPLOADED_FILES* (build-path (current-directory) "uploaded-files"))
 
(define (save-uploaded-file-and-return-filename! file-data)
  (let* ((filename (fresh-filename-id (binding/string:file-filename file-data)))
         (raw-file-bytes (binding/string:file-content file-data))
         (fport (open-output-file (build-path (setting *PATH_TO_UPLOADED_FILES*) filename)
                                  #:exists 'error)))
    (write-bytes raw-file-bytes fport)
    (close-output-port fport)
    filename))
 
(define (fresh-filename-id filename #:id-length (id-length 5))
  (let ((try (string-append (random-key-string id-length) "-" filename)))
    (if (file-exists? (build-path (setting *PATH_TO_UPLOADED_FILES*) try))
        (fresh-filename-id filename #:id-length id-length)
        try)))