1: ;; Rewrite "copyright" line of the source files to make it current.
    2: ;; This is a quick "throwaway" script.  It is grossly inefficient,
    3: ;; but it does the job.  An example of something you write in half
    4: ;; an hour to finish some chores.
    5: 
    6: (use file.util)
    7: (use util.match)
    8: (use srfi-19)
    9: 
   10: (define (usage)
   11:   (print "Usage: gosh copyrewrite.scm <directory> <author> <email>")
   12:   (exit 0))
   13: 
   14: (define (main args)
   15:   (match (cdr args)
   16:     ((dir author email)
   17:      (directory-fold dir
   18:                      (lambda (path seed)
   19:                        (when (#/\.(c|h|scm|stub)$/ path)
   20:                          (check-file path author email)))
   21:                      #f))
   22:     (_ (usage)))
   23:   0)
   24: 
   25: (define (check-file path author email)
   26:   (define check-rx
   27:     (string->regexp #`"[cC]opyright\\s*\\([cC]\\)\\s*(\\d+)(-\\d+)?\\s+,|author|"))
   28:   (define current-year (date-year (current-date)))
   29:   (define (file->string-list+ path)
   30:     (call-with-input-file path
   31:       (lambda (in)
   32:         (unwind-protect
   33:             (port->string-list (open-coding-aware-port in))
   34:           (close-input-port in)))))
   35:   (define (rewrite line)
   36:     (let* ((m (check-rx line))
   37:            (start-year (x->integer (m 1)))
   38:            (years (if (= start-year current-year)
   39:                     start-year
   40:                     #`",|start-year|-,|current-year|")))
   41:       #`",(m 'before)Copyright (c) ,years  ,author  <,|email|>"))
   42:   
   43:   (and-let* ((input   (file->string-list+ path))
   44:              (matched (find check-rx input)))
   45:     (print "Rewriting " path "...")
   46:     (receive (out tmp) (sys-mkstemp path)
   47:       (for-each (lambda (line)
   48:                   (display (if (eq? line matched) (rewrite line) line) out)
   49:                   (newline out))
   50:                 input)
   51:       (close-output-port out)
   52:       (replace-file path tmp))))
   53: 
   54: (define (replace-file path tmp)
   55:   (sys-chmod tmp (file-perm path))
   56:   (sys-rename tmp path))
   57: 
   58: 
   59: 
   60: 
   61: