7. File Access

;; use (open-input-file filename) or (open filename O_RDONLY)

(define input (open-input-file "/usr/local/widgets/data"))
(let loop ((line (read-line input 'concat)))
  (cond ((not (eof-object? line))
         (if (string-match "blue" line)
           (display line))
         (loop (read-line input 'concat)))))
(close input)

;; Many I/O functions default to the logical STDIN/OUT

;; You can also explicitly get the standard ports with
;; [set-]current-{input,output,error}-port.

;; format takes a port as the first argument.  If #t is given, format
;; writes to stdout, if #f is given, format returns a string.

(let loop ((line (read-line)))     ; reads from stdin
  (cond ((not (eof-object? line))
         (if (not (string-match "[0-9]" line))
           ;; writes to stderr
           (display "No digit found.\n" (current-error-port))
           ;; writes to stdout
           (format #t "Read: ~A\n" line))
         (loop (read-line)))))

;; use open-output-file

(define logfile (open-output-file "/tmp/log"))

;; increasingly specific ways of closing ports (it's safe to close a
;; closed port)

(close logfile)                ; #t
(close-port logfile)           ; #f (already closed)
(close-output-port logfile)    ; unspecified

;; you can rebind standard ports with set-current-<foo>-port:

(let ((old-out (current-output-port)))
  (set-current-output-port logfile)
  (display "Countdown initiated ...\n")
  (set-current-output-port old-out)
  (display "You have 30 seconds to reach minimum safety distance.\n"))

;; or

(with-output-to-file logfile
  (lambda () (display "Countdown initiated ...\n")))
(display "You have 30 seconds to reach minimum safety distance.\n")

(define source (open-input-file path))
(define sink (open-output-file path))

(define source (open path O_RDONLY))
(define sink (open path O_WRONLY))

;;-----------------------------
(define port (open-input-file path))
(define port (open-file path "r"))
(define port (open path O_RDONLY))
;;-----------------------------
(define port (open-output-file path))
(define port (open-file path "w"))
(define port (open path (logior O_WRONLY O_TRUNC O_CREAT)))
;;-----------------------------
(define port (open path (logior O_WRONLY O_EXCL O_CREAT)))
;;-----------------------------
(define port (open-file path "a"))
(define port (open path (logior O_WRONLY O_APPEND O_CREAT)))
;;-----------------------------
(define port (open path (logior O_WRONLY O_APPEND)))
;;-----------------------------
(define port (open path O_RDWR))
;;-----------------------------
(define port (open-file path "r+"))
(define port (open path (logior O_RDWR O_CREAT)))
;;-----------------------------
(define port (open path (logior O_RDWR O_EXCL O_CREAT)))
;;-----------------------------

;; Nothing different needs to be done with Guile

(define expand-user
  (let ((rx (make-regexp "^\\~([^/]+)?")))
    (lambda (filename)
      (let ((m (regexp-exec rx filename)))
        (if m
          (string-append
           (if (match:substring m 1)
             (passwd:dir (getpwnam (match:substring m 1)))
             (or (getenv "HOME") (getenv "LOGDIR")
                 (passwd:dir (getpwuid (cuserid))) ""))
           (substring filename (match:end m)))
          filename)))))

(define port (open-file filename mode))  ; raise an exception on error

;; use catch to trap errors
(catch 'system-error ; the type of error thrown
  (lambda () (set! port (open-file filename mode))) ; thunk to try
  (lambda (key . args)  ; exception handler
    (let ((fmt (cadr args))
          (msg&path (caddr args)))
      (format (current-error-port) fmt (car msg&path) (cadr msg&path))
      (newline))))

;; use the POSIX tmpnam
(let ((name (tmpnam)))
  (call-with-output-file name
    (lambda (port)
      ;; ... output to port
      '())))

;; better to test and be sure you have exclusive access to the file
;; (temp file name will be available as (port-filename port))
(define (open-temp-file)
  (let loop ((name (tmpnam)))
    (catch 'system-error
      (lambda () (open name (logior O_RDWR O_CREAT O_EXCL)))
      (lambda (key . args) (loop (tmpnam))))))

;; or let mkstemp! do the work for you:
(define port (mkstemp! template-string-ending-in-XXXXXX))

(let* ((tmpl "/tmp/programXXXXXX")
       (port (mkstemp! tmpl)))
  ;; tmpl now contains the name of the temp file,
  ;; e.g. "/tmp/programhVoEzw"
  (do ((i 0 (1+ i)))
      ((= i 10))
    (format port "~A\n" i))
  (seek port 0 SEEK_SET)
  (display "Tmp file has:\n")
  (do ((line (read-line port 'concat) (read-line port 'concat)))
      ((eof-object? line))
    (display line))
  (close port))

;; string ports are ideal for this

(define DATA "
your data goes here
")

(call-with-input-string
 DATA
 (lambda (port)
   ;; ... process input from port
   '()))

;; or

(with-input-from-string DATA
  (lambda ()
    ;; ... stdin now comes from DATA
    '()))

;; to process lines of current-input-port:
(do ((line (read-line) (read-line)))
    ((eof-object? line))
  ;; ... do something with line
  '())

;; a general filter template:

(define (body)
  (do ((line (read-line) (read-line)))
      ((eof-object? line))
    (display line)
    (newline)))

(let ((args (cdr (command-line))))
  ;; ... handle options here
  (if (null? args)
    (body)     ; no args, just call body on stdin
    (for-each  ; otherwise, call body with stdin set to each arg in turn
     (lambda (file)
       (catch 'system-error
         (lambda ()
           (with-input-from-file file
             body))
         (lambda (key . args)
           (format (current-error-port) (cadr args) (caaddr args)
                   (car (cdaddr args)))
           (newline (current-error-port)))))
     args)))

;; example: count-chunks:
(use-modules (srfi srfi-1) (srfi srfi-13) (ice-9 format) (ice-9 regex))

;; also use directory-files from 9.5 and globbing functions from 9.6

;; can use (ice-9 getopt-long) described in chapter 15, or process
;; options by hand
(define opt-append 0)
(define opt-ignore-ints 0)
(define opt-nostdout 0)
(define opt-unbuffer 0)

(define args (cdr (command-line)))

(do ((opts args (cdr opts)))
    ((or (null? opts) (not (eq? (string-ref (car opts) 0) #\-)))
     (set! args opts))
  (let ((opt (car opts)))
    (cond ((string=? opt "-a") (set! opt-append (1+ opt-append)))
          ((string=? opt "-i") (set! opt-ignore-ints (1+ opt-ignore-ints)))
          ((string=? opt "-n") (set! opt-nostdout (1+ opt-nostdout)))
          ((string=? opt "-u") (set! opt-unbuffer (1+ opt-unbuffer)))
          (else (throw 'usage-error "Unexpected argument: ~A" opt)))))

;; default to all C source files
(if (null? args) (set! args (glob "*.[Cch]" ".")))

(define (find-login)
  (do ((line (read-line) (read-line)))
      ((eof-object? line))
    (cond ((string-match "login" line)
           (display line)
           (newline)))))

(define (lowercase)
  (do ((line (read-line) (read-line)))
      ((eof-object? line))
    (display (string-downcase line))
    (newline)))

(define (count-chunks)
  (do ((line (read-line) (read-line))
       (chunks 0))
      ((or (eof-object? line)
           (string=? line "__DATA__") (string=? line "__END__"))
       (format #t "Found ~A chunks\n" chunks))
    (let ((tokens
           (string-tokenize (string-take line (or (string-index line #\#)
                                                  (string-length line))))))
      (set! chunks (+ chunks (length tokens))))))

(if (null? args)
  (count-chunks)     ; or find-login, lowercase, etc.
  (for-each
   (lambda (file)
     (catch 'system-error
       (lambda ()
         (with-input-from-file file
           count-chunks))
       (lambda (key . args)
         (format (current-error-port) (cadr args) (caaddr args)
                 (car (cdaddr args)))
         (newline (current-error-port)))))
   args))

;; write changes to a temporary file then rename it
(with-input-from-file old
  (lambda ()
    (with-output-to-file new
      (lambda ()
        (do ((line (read-line) (read-line)))
            ((eof-object? line))
          ;; change line, then...
          (write-line line))))))
(rename-file old (string-append old ".orig"))
(rename-file new old)

;; no -i switch

;; open the file in read/write mode, slurp up the contents, modify it,
;; then write it back out:
(let ((p (open-file file "r+"))
      (lines '()))
  ;; read in lines
  (do ((line (read-line p) (read-line p)))
      ((eof-object? line))
    (set! lines (cons line lines)))
  ;; modify (reverse lines)
  (seek p 0 SEEK_SET)
  ;; write out lines
  (for-each (lambda (x) (write-line x p)) lines)
  ;; truncate the file
  (truncate-file p)
  (close p))

(let ((p (open-file "foo" "r+"))
      (lines '())
      (date (date->string (current-date))))
  (do ((line (read-line p 'concat) (read-line p 'concat)))
      ((eof-object? line))
    (set! lines (cons line lines)))
  (seek p 0 SEEK_SET)
  (for-each
   (lambda (x)
     (regexp-substitute/global p "DATE" x 'pre date 'post))
   (reverse lines))
  (truncate-file p)
  (close p))

(define p (open-file path "r+"))
(flock p LOCK_EX)
;; update the file, then...
(close p)

;; to increment a number in a file
(define p (open "numfile" (logior O_RDWR O_CREAT)))
(flock p LOCK_EX)
;; Now we have acquired the lock, it's safe for I/O
(let* ((obj (read p))
       (num (if (eof-object? obj) 0 obj)))
  (seek p 0 SEEK_SET)
  (truncate-file p)
  (write (1+ num) p)
  (newline p))
(close p)

;; use force-output
(force-output p)

;; flush all open ports
(flush-all-ports)

;; use select
(select inputs outputs exceptions seconds)
(select (list p1 p2 p3) '() '())

(let* ((nfound (select (list inport) '() '()))
       (inputs (car nfound)))
  (if (not (null? inputs))
      (let ((line (read-line inport)))
        (format #t "I read ~A\n" line))))

;; or use char-ready? if you only need a single character
(if (char-ready? p)
  (format #t "I read ~A\n" (read-char p)))

;; use the O_NONBLOCK option with open
(define modem (open "/dev/cua0" (logior O_RDWR O_NONBLOCK)))

;; or use fcntl if you already have a port
(let ((flags (fcntl p F_GETFD)))
  (fcntl p F_SETFD (logior flags O_NONBLOCK)))

;; use stat
(let ((buf (make-string (stat:size (stat p)))))
  (read-string!/partial buf input))

;; not needed - ports are first class objects

;; use for-each on the list of ports:
(for-each (lambda (p) (display stuff-to-print p)) port-list)

;; or, if you don't want to keep track of the port list and know you
;; want to print to all open output ports, you can use port-for-each:
(port-for-each (lambda (p) (if (output-port? p) (display stuff p))))

;; use fdopen:
(define p (fdopen num mode))
(define p (fdopen 3 "r"))

(define p (fdopen (string->number (getenv "MHCONTEXTFD")) "r"))
;; after processing
(close p)

;; ports are first class objects and can be aliased and passed around
;; like any other non-immediate variables:
(define alias original)
(define old-in (current-input-port))

;; or you can open two separate ports on the same file:
(define p1 (open-input-file path))
(define p2 (open-input-file path))

;; or use fdopen:
(define copy-of-p (fdopen (fileno p) mode))

(define old-out (current-output-port))
(define old-err (current-error-port))

(define new-out (open-output-file "/tmp/program.out"))

(set-current-output-port new-out)
(set-current-error-port new-out)

(system joe-random-program)

(close new-out)

(set-current-output-port old-out)
(set-current-error-port old-out)