Changeset 20270 in project

Timestamp:

09/12/10 22:01:12 (8 years ago)

Author:

alaric

Message:

ugarit: Fixed all the silly errors, and got mtime caching working!

Location:

release/4/ugarit/trunk

Files:

• ugarit-core.scm (modified) (4 diffs)
• ugarit.scm (modified) (4 diffs)

release/4/ugarit/trunk/ugarit-core.scm

@@ -2 +2 @@
         (open-archive
          archive?
+         archive-global-directory-rules
          archive-writable?
          archive-unlinkable?
@@ -579 +580 @@
           (if cache-result
               (if (= cached-mtime mtime)
-                  (values cached-hash #t) ; Found in cache! Woot!
+                  (begin
+                    #;(printf "Found ~a/~a in cache: ~a\n" file-path mtime cached-hash)
+                    (values cached-hash #t)) ; Found in cache! Woot!
                   (store-file-and-cache! mtime)) ; in cache, but mtime differs
               (store-file-and-cache! mtime))) ; not in cache
@@ -768 +771 @@
 ;; Returns the usual key and reused? values
 (define (store-directory! archive path)
-  (printf "TEST 1\n")
   (call-with-context
    (read-local-rules archive path)
    path
    (lambda ()
-     (printf "TEST 2\n")
      (check-archive-writable archive)
 
@@ -837 +838 @@
                                         ; WTF?
                            (printf "ERROR: I can't ascertain the type of ~A. Skipping it...\n" file-path))))))
-                 (directory path #t))
+                 (sort! (directory path #t) string<?))
 
        ((sexpr-stream-writer-finish! ssw))))))

release/4/ugarit/trunk/ugarit.scm

@@ -1 +1 @@
 (use ugarit-core)
+(use directory-rules)
 
 (use srfi-37)
@@ -133 +134 @@
   
          (match result
-            (("")
+            (()
                (explore-archive archive directory-key path quit-continuation))
             (("help")
@@ -251 +252 @@
 (match command-line
    (("snapshot" confpath tag fspath)
-      (let ((archive (open-archive
-         (with-input-from-file confpath read-file) *store-atime?* *store-ctime?*)))
+      (let* ((configuration (with-input-from-file confpath read-file))
+             (archive (open-archive configuration *store-atime?* *store-ctime?*)))
          
          (printf "Archiving ~A to tag ~A...\n" fspath tag)
          (define-values (dir-key dir-reused?)
-            (store-directory! archive fspath))
+            (call-with-context-support
+             (archive-global-directory-rules archive)
+             (lambda () (store-directory! archive fspath))))
          (printf "Root hash: ~A\n" dir-key)
          (let ((snapshot-key (tag-snapshot! archive tag dir-key dir-reused? (list
@@ -287 +290 @@
          (let ((type (archive-exists? archive key))
                (block (archive-get archive key)))
-               (printf "BLock with key ~A (type ~A) is ~A bytes:\n" key type (u8vector-length block))
+               (printf "Block with key ~A (type ~A) is ~A bytes:\n" key type (u8vector-length block))
                (write-u8vector block))