Aliases and files recording.

members-base.scm

@@ -37,7 +37,9 @@
 	 (chicken pathname)
 	 (chicken file posix)
 	 (chicken file)
+	 (chicken format)
 	 testing
+	 utils
 	 dictionary)
 
  ;; Gets all files and symbolic links from given directory. The
@@ -52,20 +54,50 @@
 		(ffn (make-pathname dn fn)))
 	   (loop (cdr fns)
 		 (if (symbolic-link? ffn)
-		     (cons (cons fn (read-symbolic-link ffn)) rs)
+		     (cons (cons (string->symbol fn)
+				 (string->symbol (read-symbolic-link ffn)))
+			   rs)
 		     (if (regular-file? ffn)
-			 (cons fn rs)
+			 (cons (string->symbol fn) rs)
 			 rs)))))))
 
+ ;; Converts a list of symlinks and files in aforementioned format
+ ;; into a dictionary of regular files as keys with lists of symlinks
+ ;; as values. If the target file does not exist, adds 'error-0 symbol
+ ;; as the first alias to this list with the number increasing with
+ ;; each nonexistent file encountered. The error record is also
+ ;; generated for symlinks pointing outside of the directory.
  (define (files+symlinks->files-dictionary ls)
-   (let ((links (filter pair? ls))
+   (let* ((links (filter pair? ls))
-	 (files (filter string? ls)))
+	  (files (filter symbol? ls))
-     (print links)
+	  (fdict
-     (print files)))
+	   (let loop ((files files)
+		      (res (make-dict)))
+	     (if (null? files)
+		 res
+		 (loop (cdr files)
+		       (dict-set res (car files) '()))))))
+     (let loop ((links links)
+		(res fdict)
+		(errs 0))
+       (if (null? links)
+	   res
+	   (let* ((link (car links))
+		  (name (car link))
+		  (target (cdr link)))
+	     (if (dict-has-key? res target)
+		 (loop (cdr links)
+		       (dict-set res target (cons name (dict-ref res target)))
+		       errs)
+		 (loop (cdr links)
+		       (dict-set res target
+				 (list (string->symbol (sprintf "error-~A" errs))
+				       name))
+		       (+ errs 1))))))))
 
  (define (load-members dn)
    ;; get the directory contents
-   (files+symlinks->files-dictionary (get-files+symlinks dn))
+   (print (files+symlinks->files-dictionary (get-files+symlinks dn)))
    ;; filter all ids
    ;; resolve links (it might be unknown!)
    ;; load member files
@@ -74,6 +106,17 @@
  (define (members-base-tests!)
    (run-tests
     members-base
+    (test-equal? files+symlinks->files-dictionary
+		 (files+symlinks->files-dictionary
+		  '(joe (2803 . joe)))
+		 '((joe 2803)))
+    (test-equal? files+symlinks->files-dictionary
+		 (files+symlinks->files-dictionary
+		  '(joe
+		    (2803 . joe)
+		    (666 . nonexistent)))
+		 '((nonexistent error-0 666)
+		   (joe 2803)))
     ))
 
  )