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