#lang scheme/base ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; FILE.plt - file, path, and atomic file operation utilities ;; ;; ;; Bonzai Lab, LLC. All rights reserved. ;; ;; Licensed under LGPL. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; atomic.ss - provides atomic file saving operation (save/rename) wrappers ;; yc 9/21/2009 - first version ;; yc 10/2/2009 - fix the flush-output bug (return 0 instead of void now) (require (planet bzlib/base) (planet bzlib/port/port) "path.ss" "base.ss" "file.ss" scheme/file (planet bzlib/os) ) ;; what does this do? ;; 1 - create the temp file. ;; 2 - write to the temp file... ;; 3 - when closing the temp file - we want the file to then be renamed to the original ;; file... ;; is there a filter somewhere here? ;; 1 - write the port to the actual underlying file... ;; when it is closed - ;; THIS IS NOT GUARANTEED TO WORK ON WINDOWS... (define (open-output-atomic-file path) (let* ((temp (make-temporary-file ".gzlib-temp.~a" #f (parent-path path))) (out (open-output-file temp #:exists 'replace))) (make-output-port path always-evt (lambda (bytes-out start end block? break?) (if (= start end) (begin (flush-output out) 0) (write-bytes bytes-out out start end))) (lambda () (begin0 (close-output-port out) (+:windows (rename-file temp path) ;; this line can still fail in windows... (rename temp path #t)) ))))) (define call-with-output-atomic-file (make-call-with-output-port open-output-atomic-file path)) (provide/contract (open-output-atomic-file (-> path-string? output-port?)) (call-with-output-atomic-file (-> path-string? (-> output-port? any) any)) )