scheme shell
about
download
support
resources
docu
links
 
scsh.net

Offline Cvs Update

Doing `cvs -q -n update' offline in scsh

submitted by AndreasBernauer

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:


OfflineCvsUpdate - raw wiki source | code snippets archive