1;;; 2;;; file/filter.scm - utility to build filter programs 3;;; 4;;; Copyright (c) 2000-2020 Shiro Kawai <shiro@acm.org> 5;;; 6;;; Redistribution and use in source and binary forms, with or without 7;;; modification, are permitted provided that the following conditions 8;;; are met: 9;;; 10;;; 1. Redistributions of source code must retain the above copyright 11;;; notice, this list of conditions and the following disclaimer. 12;;; 13;;; 2. Redistributions in binary form must reproduce the above copyright 14;;; notice, this list of conditions and the following disclaimer in the 15;;; documentation and/or other materials provided with the distribution. 16;;; 17;;; 3. Neither the name of the authors nor the names of its contributors 18;;; may be used to endorse or promote products derived from this 19;;; software without specific prior written permission. 20;;; 21;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 22;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 23;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 24;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 25;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 26;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED 27;;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 28;;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 29;;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 30;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 31;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 32;;; 33 34;;; This module provides utilities for a common pattern in 35;;; filter-type commands, that is, to take an input, to process 36;;; the content, and to write the result. The common occurring 37;;; pattern is: 38;;; 39;;; - input may be a specified file, or stdin. 40;;; - output may be a specified file, or stdout. 41;;; - output may be a temporary file, which will be renamed 42;;; upon completion of the processing. 43;;; - output file may be removed when an error occurs in the processing. 44;;; 45 46(define-module file.filter 47 (use srfi-13) 48 (use file.util) 49 (export file-filter file-filter-fold file-filter-map file-filter-for-each)) 50(select-module file.filter) 51 52(define (file-filter proc :key 53 (input (current-input-port)) 54 (output (current-output-port)) 55 (temporary-file #f) 56 (keep-output? #f) 57 (leave-unchanged #f)) 58 59 (define (process-with-output oport) 60 (cond 61 [(input-port? input) (proc input oport)] 62 [(string? input) (call-with-input-file input (cut proc <> oport))] 63 [else (error "input must be either an input port or a file name, but got" 64 input)])) 65 66 (define (process-with-tempfile ofile tmpf) 67 (let1 tempfile (cond [(string-prefix? "/" tmpf) tmpf] 68 [(string-prefix? "./" tmpf) tmpf] 69 [(string-prefix? "../" tmpf) tmpf] 70 [else (build-path (sys-dirname ofile) tmpf)]) 71 (receive (tport tfile) (sys-mkstemp tempfile) 72 (guard (e [else (unless keep-output? (sys-unlink tfile)) 73 (raise e)]) 74 (begin0 (process-with-output tport) 75 (close-output-port tport) 76 (if (rename-ok? tfile ofile) 77 (sys-rename tfile ofile) 78 (sys-unlink tfile))))))) 79 80 (define (rename-ok? tfile ofile) 81 (or (not leave-unchanged) 82 (not (file-is-readable? ofile)) 83 (and (file-is-readable? ofile) 84 (file-is-readable? tfile) 85 (not (file-equal? tfile ofile))))) 86 87 (cond 88 [(output-port? output) (process-with-output output)] 89 [(string? output) 90 (cond [(string? temporary-file) 91 (process-with-tempfile output temporary-file)] 92 [(eq? temporary-file #t) 93 (process-with-tempfile output #"~(sys-basename output).tmp")] 94 [(not temporary-file) 95 (guard (e [else (unless keep-output? (sys-unlink output)) 96 (raise e)]) 97 (call-with-output-file output process-with-output))] 98 [else (error "temporary-file must be a boolean or a string, but got" 99 temporary-file)])] 100 [else (error "output must be either an output port or a file name, but got" 101 output)])) 102 103 104(define (file-filter-fold proc seed 105 :key (reader read-line) :allow-other-keys keys) 106 (apply file-filter 107 (^[in out] (fold (^[elt seed] (proc elt seed out)) 108 seed (generator->lseq (cut reader in)))) 109 keys)) 110 111(define (file-filter-map proc :key (reader read-line) :allow-other-keys keys) 112 (apply file-filter 113 (^[in out] (map (^[elt] (proc elt out)) 114 (generator->lseq (cut reader in)))) 115 keys)) 116 117(define (file-filter-for-each proc 118 :key (reader read-line) :allow-other-keys keys) 119 (apply file-filter 120 (^[in out] (generator-for-each (cut proc <> out) (cut reader in))) 121 keys)) 122 123 124 125 126