Guest User

Untitled

a guest
Feb 20th, 2018
74
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.17 KB | None | 0 0
  1. (define-module file.filter
  2. (use srfi-11)
  3. (use srfi-13)
  4. (export file-filter)
  5. )
  6. (select-module file.filter)
  7.  
  8. (define (file-filter proc . options)
  9. (let-keywords options
  10. ((input (current-input-port))
  11. (output (current-output-port))
  12. (temporary-file #f)
  13. (keep-output? #f))
  14.  
  15. (define (process-with-output oport)
  16. (cond
  17. ((input-port? input) (proc input oport))
  18. ((string? input)
  19. (call-with-input-file input (lambda (iport) (proc iport oport))))
  20. (else
  21. (error "input must be either an input port or a file name, but got"
  22. input))))
  23.  
  24. (define (process-with-tempfile ofile)
  25. (let*-values (((tempfile) (cond ((string-prefix? "/" temporary-file)
  26. temporary-file)
  27. ((string-prefix? "./" temporary-file)
  28. temporary-file)
  29. ((string-prefix? "../" temporary-file)
  30. temporary-file)
  31. (else (string-append
  32. (sys-dirname ofile)
  33. "/"
  34. temporary-file))))
  35. ((tport tfile) (sys-mkstemp tempfile)))
  36. (guard (e
  37. (else
  38. (unless keep-output? (sys-unlink tfile))
  39. (raise e)))
  40. (receive r (process-with-output tport)
  41. (close-output-port tport)
  42. (sys-rename tfile ofile)
  43. (apply values r)))))
  44.  
  45. (cond
  46. ((output-port? output) (process-with-output output))
  47. ((string? output)
  48. (if temporary-file
  49. (process-with-tempfile output)
  50. (with-error-handler
  51. (lambda (e)
  52. (unless keep-output? (sys-unlink output))
  53. (raise e))
  54. (lambda ()
  55. (call-with-output-file output process-with-output)))))
  56. (else
  57. (error "output must be either an output port or a file name, but got"
  58. output)))
  59. )
  60. )
  61.  
  62. (provide "file/filter")
Add Comment
Please, Sign In to add comment