My ISP goes down several times the week and sometimes sf.net does so,
too. Furthermore, the connection is sometimes kind of slow. So I wrote
a scsh code, that does the 'cvs -q -n update' command for me offline,
i.e. it lists all files that are modified, up-to-date or unknown to
the CVS repository, whose entries are saved in the CVS subdirectory
without the need of being online. The script examines the
subdirectories recursively, too.
This script works faster than the cvs-command-pendant for me. It
contains a small "hack" for the pathname printing.
#!/bin/sh
exec scsh -dm -o cvs-mod -e main -s "$0" "$@" #2>/dev/null
!#
(define-structure cvs-mod
(export main)
(open scsh
scheme
sort
srfi-1)
(begin
;; Tells which files are modified vs. the CVS repository.
;; It just looks at the timestamps in the CVS subdirectory.
(define entry-parser (suffix-splitter "/" 5))
(define CVS-flag car)
(define CVS-file-name cadr)
(define CVS-version caddr)
(define CVS-time cadddr)
;(define (CVS-unknown a) (car (cddddr a)))
(define (CVS-directory? file-entry)
(string=? "D" (CVS-flag file-entry)))
(define (main . req)
(set! starting-cwd (cwd))
(process-files "." (read-entries "."))
(show-results *unknown* "?")
(show-results *modified* "M")
(show-results *updating* "U"))
(define (show-results list sign)
(for-each (lambda (elem)
(format #t "~a ~a~%" sign elem))
(sort-list list
(let ((splitter (infix-splitter "/")))
(lambda (path1 path2)
(let ((parts1 (length (splitter path1)))
(parts2 (length (splitter path2))))
(cond
((< parts1 parts2) #t)
((= parts1 parts2)
(string<? path1 path2))
((> parts1 parts2) #f))))))))
(define (read-entries path)
(let ((CVS-directory (string-append (expand-file-name path) "/CVS")))
(if (file-directory? CVS-directory)
(let ((Entries-file (string-append CVS-directory "/Entries")))
(if (file-readable? Entries-file)
(close-after (open-input-file Entries-file)
(lambda (input)
(with-current-input-port input
(let loop ((line (read-line))
(result '()))
(if (eof-object? line)
result
;; In the Entries file at the end of a CVS tree,
;; the last line is "D". I don't know, why CVS
;; does this, but it does.
(if (string=? "D" line)
result
(loop (read-line)
(cons (entry-parser line)
result))))))))
(error "File Entries not found." Entries-file)))
(error "Directory CVS not found." CVS-directory))))
(define (process-files currentdir cvs-file-list)
(with-cwd currentdir
(let ((directories (filter CVS-directory? cvs-file-list))
(files (delete-list (append (apply append (map glob standard-ignore-files))
(ignore-files ".cvsignore"))
(directory-files))))
;; process files/directories
(let ((file-not-found (check-cvs-files cvs-file-list)))
(for-each (lambda (not-found)
(add-file! *updating* not-found))
file-not-found)
(let ((remaining-files (delete-list
(append file-not-found
(map CVS-file-name cvs-file-list))
files)))
(for-each (lambda (remaining)
(add-file! *unknown* remaining))
remaining-files)))
;; go deeper into directories
(for-each (lambda (directory)
(process-files directory (read-entries directory)))
(map CVS-file-name directories)))))
(define (check-cvs-files cvs-file-list)
(filter-map
(lambda (cvs-file)
(let ((file-name (CVS-file-name cvs-file))
(CVS-time (CVS-time cvs-file)))
(if (file-exists? file-name)
(let ((file-mod-time (file-last-mod file-name)))
(if (and (not (CVS-directory? cvs-file))
(not (string=? (format-date "~c" (date file-mod-time "UTC0"))
CVS-time)))
(add-file! *modified* file-name))
#f)
file-name)))
cvs-file-list))
(define (relative-file-name file-name relative-directory)
(let ((full-file-name (absolute-file-name file-name))
(dir-length (string-length relative-directory)))
(if (string=? (substring full-file-name 0 dir-length)
relative-directory)
(substring full-file-name (+ 1 dir-length) (string-length full-file-name))
;; Didn't found matching part, so just be sure to return something valid.
full-file-name)))
(define (ignore-files file-name)
(if (file-exists? file-name)
(call-with-input-file file-name
(lambda (port)
(let* ((reader (field-reader))
(result (awk (reader port) (raw file-patterns) ((ignore '()))
(#t (append (apply append (map glob file-patterns))
ignore)))))
(close port)
result)))
'()))
(define (delete-list to-delete-list initial-list)
(fold (lambda (del res)
(delete del res))
initial-list
to-delete-list))
;; as from cvs info
(define standard-ignore-files
'("RCS" "SCCS" "CVS" "CVS.adm"
"RCSLOG" "cvslog.*"
"tags" "TAGS"
".make.state" ".nse_depinfo"
"*~" "#*" ".#*" ",*" "_$*" "*$" "*.old" "*.bak" "*.BAK" "*.orig" "*.rej" ".del-*"
"*.a" "*.olb" "*.o" "*.obj" "*.so" "*.exe"
"*.Z" "*.elc" "*.ln"
"core"))
(define-syntax add-file!
(syntax-rules ()
((add-file! list file-name)
(set! list (cons (relative-file-name file-name starting-cwd) list)))))
(define starting-cwd #f)
(define *updating* '())
(define *modified* '())
(define *unknown* '())
))
;; EOF
;;; Local Variables:
;;; mode:scheme
;;; End:
