Megatest

Diff
Login

Differences From Artifact [886fe6d514]:

To Artifact [04050a3f4c]:


140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
			   (map pair-car->symbol e))
			  (aref (aref data "payload") "timeline"))) ;; extract the timeline alists
	 ;;(timeline   (aref (aref data "payload") "timeline")) ;; extract the timeline alists
	 (start-flag #f)
	 (end-flag   #f))
    ;; now we have all needed data as a list of alists in time order, extract the
    ;; messages for given branch starting at start-tag and ending at end-tag
    (reverse ;; return results oldest to newest
     (filter
      (lambda (x) x)
      (map
       (lambda (entry)
	 (let ((tags (aref entry 'tags)))
	   (if (or (not tags) ;; eh?
		   (not (list? tags)))







|







140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
			   (map pair-car->symbol e))
			  (aref (aref data "payload") "timeline"))) ;; extract the timeline alists
	 ;;(timeline   (aref (aref data "payload") "timeline")) ;; extract the timeline alists
	 (start-flag #f)
	 (end-flag   #f))
    ;; now we have all needed data as a list of alists in time order, extract the
    ;; messages for given branch starting at start-tag and ending at end-tag
    ;; (reverse ;; return results oldest to newest
     (filter
      (lambda (x) x)
      (map
       (lambda (entry)
	 (let ((tags (aref entry 'tags)))
	   (if (or (not tags) ;; eh?
		   (not (list? tags)))
174
175
176
177
178
179
180
181
182
183
184

185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205




206
207
208
209
210
211
212
213
214
215
216
217
218


219
220
221
222
223
224
225
				      (append entry (list (cons 'action 'copy)
							  (cons 'dest   #f)
							  (cons 'mode   'auto)))
				      #f)))
			 (if (member end-tag tags)(set! end-flag #t))
			 res))
		     #f)))))
       (reverse timeline))))))

(define (run-cmd-file cmdfile new-branch-name dest-node)
  (let* ((data (with-input-from-file cmdfile read)))

    (print "fossil set autosync 0")
    (print "fossil branch new "new-branch-name" "dest-node)
    (print "fossil co "new-branch-name)
    (for-each
     (lambda (node)
       (let* ((timestamp (alist-ref 'timestamp node))
	      (comment   (alist-ref 'comment   node))
	      (user      (alist-ref 'user      node))
	      (uuid      (alist-ref 'uuid      node))
	      (action    (alist-ref 'action    node))
	      (dest      (alist-ref 'dest      node))
	      (mode      (alist-ref 'mode      node))
	      (tags      (alist-ref 'tags      node))
	      (remtags   (if (list? tags)(cdr tags)'()))
	      (comfile   (conc "/tmp/"(current-user-name)"-"uuid"-comment.txt")))
	 (print "\nfossil merge --cherrypick "uuid)
	 (with-output-to-file comfile
	   (lambda ()
	     (print comment)
	     (print "From: "uuid)
	     (print "User: "user)))




	 (print "fossil commit -M "comfile)))
     data)
    (print "## fossil set autosync 1")))

(define (process-fossil branch start-tag end-tag)
  (print-rows
   (extract-history branch start-tag end-tag)))

(define usage "Usage: fslutil cmd [...]
  tlsum branch start-tag end-tag 
             : generate a timeline summary
               use - for tags to indicate n/a
               (i.e. get all)


  run cmdfile new-branch-name dest-node
             : migrate the nodes from cmdfile to dest-node
               using branch name new-branch-name
")

(define (main)
  (match







|


|
>

|
|


















>
>
>
>
|












>
>







174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
				      (append entry (list (cons 'action 'copy)
							  (cons 'dest   #f)
							  (cons 'mode   'auto)))
				      #f)))
			 (if (member end-tag tags)(set! end-flag #t))
			 res))
		     #f)))))
       (reverse timeline))))) ;; )

(define (run-cmd-file cmdfile new-branch-name dest-node)
  (let* ((data (with-input-from-file cmdfile read))
	 (first-commit #t))
    (print "fossil set autosync 0")
    ;; (print "fossil branch new "new-branch-name" "dest-node" --private")
    (print "fossil co "dest-node)
    (for-each
     (lambda (node)
       (let* ((timestamp (alist-ref 'timestamp node))
	      (comment   (alist-ref 'comment   node))
	      (user      (alist-ref 'user      node))
	      (uuid      (alist-ref 'uuid      node))
	      (action    (alist-ref 'action    node))
	      (dest      (alist-ref 'dest      node))
	      (mode      (alist-ref 'mode      node))
	      (tags      (alist-ref 'tags      node))
	      (remtags   (if (list? tags)(cdr tags)'()))
	      (comfile   (conc "/tmp/"(current-user-name)"-"uuid"-comment.txt")))
	 (print "\nfossil merge --cherrypick "uuid)
	 (with-output-to-file comfile
	   (lambda ()
	     (print comment)
	     (print "From: "uuid)
	     (print "User: "user)))
	 (if first-commit
	     (begin
	       (print "fossil commit -M "comfile" --branch "new-branch-name" --private")
	       (set! first-commit #f))
	       (print "fossil commit -M "comfile))))
     data)
    (print "## fossil set autosync 1")))

(define (process-fossil branch start-tag end-tag)
  (print-rows
   (extract-history branch start-tag end-tag)))

(define usage "Usage: fslutil cmd [...]
  tlsum branch start-tag end-tag 
             : generate a timeline summary
               use - for tags to indicate n/a
               (i.e. get all)
  branchdat branch start-tag end-tag
             : dump branch data for the run command (below)
  run cmdfile new-branch-name dest-node
             : migrate the nodes from cmdfile to dest-node
               using branch name new-branch-name
")

(define (main)
  (match