Random Bits of Open Code

Check-in [5326d1328c]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:fixed bunch of little bugs in sync
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:5326d1328c5486cd3a8182fdd300517394228973
User & Date: matt 2018-08-09 05:30:36
Context
2018-08-10
05:51
use defstruct instead of vector check-in: edddd653fd user: matt tags: trunk
2018-08-09
05:30
fixed bunch of little bugs in sync check-in: 5326d1328c user: matt tags: trunk
04:37
First pass on sync check-in: 11a07463f1 user: matt tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

a3d/testbox/a3d.scm became a symlink.

megatest_cgisetup/cgi-bin/models became a symlink.

megatest_cgisetup/cgi-bin/pages became a symlink.

Changes to multiapp/src/sync.scm.

20
21
22
23
24
25
26
27



28
29





30
31
32
33
34
35
36
..
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66

67
68
69
70
71

72
73
74

75
76
77
78
79
80
81
82

83
84
85
86
87

88
89

90
91
92
93
94
95

;; (pkts:pkt->alist pkt pktspec: pkt-spec)

(define (path->pktid path)
  (pathname-strip-extension
   (pathname-file path)))

(define (read-pkt-as-alist fname pkt-spec)



  (pkts:pkt->alist (with-input-from-file fname read-string) pktspec: pkt-spec))
  





;; for all pkts local but NOT del pkts
;;    if mine
;;       if not exists remote
;;           copy it to remote
;;    else
;;       if not exists remote
;;           remove from local
................................................................................
;;
;; returns success errmsg
(define (sync-all local remote user-id pkt-spec)
  (cond
   ((not (file-exists? local)) (values #f (conc "local pkts dir, " local ", not found")))
   ((not (file-exists? remote))(values #f (conc "remote pkts dir, " remote ", not found")))
   (else
    (let* ((process-paths (lambda (pths ht)
			    (map (lambda (p)
				   (hash-table-set! ht (path->pktid p) p))
				 pths)))
	   (local-pkts    (make-hash-table))  ;; pktuuid => path
	   (remote-pkts   (make-hash-table))  ;; pktuuid => path
	   (local-fnames  (glob (conc local "/*.pkt")))
	   (remote-fnames (glob (conc remote "/.pkt"))))
      (process-paths local-fnames local-pkts)
      (process-paths remote-fnames remote-pkts)
      ;; first process all locally known pkts
      (for-each
       (lambda (local-key)
	 ;; packet not in remote
	 (if (not (hash-table-exists? remote-pkts local-key))
	     (let* ((apkt   (read-pkt-as-alist (hash-table-ref local-pkts local-key) pkt-spec))

		    (owner  (alist-ref 'person apkt))
		    (ptype  (alist-ref 'T apkt))
		    (rawp   (alist-ref 'pkt apkt)))
	       (cond
		((equal? owner user-id) ;; my pkt, copy it to remote

		 (with-output-to-file (conc remote "/" local-key ".pkt")
		   (lambda ()(write rawp))))
		(else ;; file is now gone from remote and it is not mine

		 (delete-file (hash-table-ref local-pkts local-key)))))))
       (hash-table-keys local-pkts))
      ;; next process all remotely known pkts
      (for-each
       (lambda (remote-key)
	 (if (not (hash-table-exists? local-pkts remote-key))
	     ;; remote pkt not found locally
	     (let* ((apkt (read-pkt-as-alist (hash-table-ref remote-pkts remote-key) pkt-spec))

		    (owner (alist-ref 'person apkt))
		    (ptype (alist-ref 'T apkt))
		    (rawp  (alist-ref 'pkt apkt)))
	       (cond
		((equal? owner user-id)

		 (delete-file (hash-table-ref remote-pkts remote-key)))
		(else

		 (with-output-to-file (conc local "/" remote-key ".pkt")
		   (lambda ()
		     (write rawp))))))))
       (hash-table-keys remote-pkts))))))
	   
)







|
>
>
>
|
|
>
>
>
>
>







 







<
<
<
<
|


|







|
>

|
<


>

|

>







|
>

|
<


>


>


|



20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
..
52
53
54
55
56
57
58




59
60
61
62
63
64
65
66
67
68
69
70
71
72
73

74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91

92
93
94
95
96
97
98
99
100
101
102
103

;; (pkts:pkt->alist pkt pktspec: pkt-spec)

(define (path->pktid path)
  (pathname-strip-extension
   (pathname-file path)))

#;(define (read-pkt-as-alist fname pkt-spec)
  (pkts:pkt->alist  pktspec: pkt-spec))

(define (read-pkt fname)
  (with-input-from-file fname read-string))

(define (process-paths pths ht)
  (map (lambda (p)
	 (hash-table-set! ht (path->pktid p) p))
       pths))

;; for all pkts local but NOT del pkts
;;    if mine
;;       if not exists remote
;;           copy it to remote
;;    else
;;       if not exists remote
;;           remove from local
................................................................................
;;
;; returns success errmsg
(define (sync-all local remote user-id pkt-spec)
  (cond
   ((not (file-exists? local)) (values #f (conc "local pkts dir, " local ", not found")))
   ((not (file-exists? remote))(values #f (conc "remote pkts dir, " remote ", not found")))
   (else




    (let* ((local-pkts    (make-hash-table))  ;; pktuuid => path
	   (remote-pkts   (make-hash-table))  ;; pktuuid => path
	   (local-fnames  (glob (conc local "/*.pkt")))
	   (remote-fnames (glob (conc remote "/*.pkt"))))
      (process-paths local-fnames local-pkts)
      (process-paths remote-fnames remote-pkts)
      ;; first process all locally known pkts
      (for-each
       (lambda (local-key)
	 ;; packet not in remote
	 (if (not (hash-table-exists? remote-pkts local-key))
	     (let* ((pkt    (read-pkt (hash-table-ref local-pkts local-key)))
		    (apkt   (pkts:pkt->alist pkt pktspec: pkt-spec))
		    (owner  (alist-ref 'person apkt))
		    (ptype  (alist-ref 'T apkt)))

	       (cond
		((equal? owner user-id) ;; my pkt, copy it to remote
		 (print local-key " not found in remote, owner is " owner " copying to remote.")
		 (with-output-to-file (conc remote "/" local-key ".pkt")
		   (lambda ()(display pkt))))
		(else ;; file is now gone from remote and it is not mine
		 (print local-key " not found in remote, owner " owner " is not " user-id " removing from local.")
		 (delete-file (hash-table-ref local-pkts local-key)))))))
       (hash-table-keys local-pkts))
      ;; next process all remotely known pkts
      (for-each
       (lambda (remote-key)
	 (if (not (hash-table-exists? local-pkts remote-key))
	     ;; remote pkt not found locally
	     (let* ((pkt   (read-pkt (hash-table-ref remote-pkts remote-key)))
		    (apkt  (pkts:pkt->alist pkt pktspec: pkt-spec))
		    (owner (alist-ref 'person apkt))
		    (ptype (alist-ref 'T apkt)))

	       (cond
		((equal? owner user-id)
		 (print remote-key " not found in local, owner is " owner " so removing from remote.")
		 (delete-file (hash-table-ref remote-pkts remote-key)))
		(else
		 (print remote-key " not found in local, owner " owner " is not " user-id " copying to local.")
		 (with-output-to-file (conc local "/" remote-key ".pkt")
		   (lambda ()
		     (display pkt))))))))
       (hash-table-keys remote-pkts))))))
	   
)