Problems with moving server...

Problems with moving server...

[David Kastrup]

[-- Attachment #1: Type: text/plain, Size: 1578 bytes --]


Hi,

after not getting any reply on the bug-gnus list, I asked Lars, and he
told me to post here.

Problem is that the stuff in gnus-move.el basically seems rotten.  For
example, the current code will infloop when an article in the `from'
server does not have a corresponding article with the same message id
on the `to' server: the second looking-at will in that case always
stare at the same point.

Anyway, it was probably not easy to encounter because the whole stuff
was as molasses-slow as to be indistinguishable from inflooping except
for quite small groups.

So I have rewritten the stuff to be efficient.  And it is really
efficient like anything.  The problem is that the input and output
data it tries to be working with does not seem to match the problem.
The article numbers corresponding to the message ids do not seem to
match the articles fetched.  Given the input data, it appears to do
what I expect when going through with edebug.  But the results of the
conversion do not work.

The conversion appears to be garbage-in, garbage-out.  Not good.  Now
I don't have enough of a clue about the data structures from news
servers and gnus internals to figure out just what the garbage part
here is.  If somebody could fix it soon, I'd be quite glad: service
for my old Usenet server runs out on the 31st, and their payment
conditions are such that I am not going to do that (it is not the
amount in question, it is basically a password-protected blanket
permission to my bank account).  I have a substitute, but I really
need to get this to work.

Thanks a lot.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 4363 bytes --]

--- gnus-move.el	08 Sep 2003 17:56:52 +0200	1.6
+++ gnus-move.el	21 Mar 2005 06:19:06 +0100	
@@ -63,7 +63,7 @@
   "Move group INFO from FROM-SERVER to TO-SERVER."
   (let ((group (gnus-info-group info))
 	to-active hashtb type mark marks
-	to-article to-reads to-marks article
+	to-article to-reads
 	act-articles)
     (gnus-message 7 "Translating %s..." group)
     (when (gnus-request-group group nil to-server)
@@ -98,17 +98,31 @@
 			       (gnus-uncompress-range
 				(gnus-active group))
 			       group from-server)))
-	  ;; Make it easier to map marks.
+	  ;; Make it easier to map marks.  Ok, this was basically an
+	  ;; inefficient piece of crapola.  What we do here is to map
+	  ;; article numbers and marks.  Marks are specified as
+	  ;; ranges.  It would be foolish to uncompress the ranges.
+	  ;; What we do instead is sorting the cars of the ranges and
+	  ;; the article numbers in sequence.  Then we work off the
+	  ;; sorted list.  Whenever we encounter a range, it is pushed
+	  ;; onto the active mark stack.  Whenever we encounter an
+	  ;; article, we go through the active mark stack, remove all
+	  ;; entries ending before the article itself, and mark the
+	  ;; article with all remaining marks.
 	  (let ((mark-lists (gnus-info-marks info))
 		ms type m)
 	    (while mark-lists
 	      (setq type (caar mark-lists)
-		    ms (gnus-uncompress-range (cdr (pop mark-lists))))
-	      (while ms
-		(if (setq m (assq (car ms) marks))
-		    (setcdr m (cons type (cdr m)))
-		  (push (list (car ms) type) marks))
-		(pop ms))))
+		    ms (cdr (pop mark-lists)))
+	      ;; ok, ms now is a range or range list.  We want to make
+	      ;; it a list.  gnus-range-normalize will not listify a
+	      ;; single number, so we do this by hand.
+	      (when (integerp (or (cdr-safe ms) ms))
+		(setq ms (list ms)))
+	      (while (setq m (pop ms))
+		(if (consp m)
+		    (push (cons (car m) (cons (cdr m) type)) marks)
+		  (push (cons m (cons m type)) marks)))))
 	  ;; Convert.
 	  (when (eq type 'headers)
 	    (nnvirtual-convert-headers))
@@ -123,40 +137,40 @@
 			 hashtb))
 	      ;; Add this article to the list of read articles.
 	      (push to-article to-reads)
-	      ;; See if there are any marks and then add them.
-	      (when (setq mark (assq (read (current-buffer)) marks))
-		(setq marks (delq mark marks))
-		(setcar mark to-article)
-		(push mark to-marks))
-	      (forward-line 1)))
+	      (push (cons (read (current-buffer)) to-article) marks))
+	    (forward-line 1))
 	  ;; Now we know what the read articles are and what the
-	  ;; article marks are.  We transform the information
-	  ;; into the Gnus info format.
+	  ;; article marks are.  We transform the information into the
+	  ;; Gnus info format.  Everything before the first
+	  ;; correspondence is marked read.
 	  (setq to-reads
-		(gnus-range-add
-		 (gnus-compress-sequence
-		  (and (setq to-reads (delq nil to-reads))
-		       (sort to-reads '<))
-		  t)
-		 (cons 1 (1- (car to-active)))))
+		(gnus-compress-sequence
+		 (sort to-reads '<)
+		 t))
+	  (if (consp (car to-reads))
+	      (setcar (car to-reads) 1)
+	    (setcar to-reads (cons 1 (car to-reads))))
 	  (gnus-info-set-read info to-reads)
 	  ;; Do the marks.  I'm sure y'all understand what's
 	  ;; going on down below, so I won't bother with any
 	  ;; further comments.  <duck>
+	  (setq marks (sort (nreverse marks) #'car-less-than-car))
 	  (let ((mlists gnus-article-mark-lists)
-		lists ms a)
+		lists a ma b)
 	    (while mlists
 	      (push (list (cdr (pop mlists))) lists))
-	    (while (setq ms (pop marks))
-	      (setq article (pop ms))
-	      (while ms
-		(setcdr (setq a (assq (pop ms) lists))
-			(cons article (cdr a)))))
+	    (while (setq mark (pop marks))
+	      (if (consp (cdr mark))
+		  (push (cons (cadr mark) (assq (cddr mark) lists)) a)
+		(while (setq ma (pop a))
+		  (unless (> (car mark) (car ma))
+		    (setcdr (cdr ma) (cons (cdr mark) (cddr ma)))
+		    (push ma b)))
+		(setq a b b nil)))
 	    (setq a lists)
-	    (while a
-	      (setcdr (car a) (gnus-compress-sequence
-			       (and (cdar a) (sort (cdar a) '<))))
-	      (pop a))
+	    (while (setq b (pop a))
+	      (setcdr b (gnus-compress-sequence
+			 (sort (cdr b) '<) t)))
 	    (gnus-info-set-marks info lists t)))))
     (gnus-message 7 "Translating %s...done" group)))
 

[-- Attachment #3: Type: text/plain, Size: 52 bytes --]



-- 
David Kastrup, Kriemhildstr. 15, 44793 Bochum