lisp/gnus/nnweb.el

0 ;;; nnweb.el --- retrieving articles via web search engines
46 (nnoo-declare nnweb)
48 (defvoo nnweb-directory (nnheader-concat gnus-directory "nnweb/")
49   "Where nnweb will save its files.")
51 (defvoo nnweb-type 'google
53 Valid types include `google', `dejanews', and `gmane'.")
55 (defvar nnweb-type-definition
59      (article . nnweb-google-wash-article)
60      (reference . identity)
61      (map . nnweb-google-create-mapping)
62      (search . nnweb-google-search)
65      (identifier . nnweb-google-identity))
69      (article . nnweb-google-wash-article)
70      (reference . identity)
71      (map . nnweb-google-create-mapping)
72      (search . nnweb-google-search)
75      (identifier . nnweb-google-identity))
76     (gmane
77      (article . nnweb-gmane-wash-article)
78      (id . "http://gmane.org/view.php?group=%s")
79      (reference . identity)
80      (map . nnweb-gmane-create-mapping)
81      (search . nnweb-gmane-search)
82      (address . "http://search.gmane.org/nov.php")
83      (identifier . nnweb-gmane-identity)))
86 (defvoo nnweb-search nil
89 (defvoo nnweb-max-hits 999
92 (defvoo nnweb-ephemeral-p nil
93   "Whether this nnweb server is ephemeral.")
97 (defvoo nnweb-articles nil)
98 (defvoo nnweb-buffer nil)
99 (defvoo nnweb-group-alist nil)
100 (defvoo nnweb-group nil)
101 (defvoo nnweb-hashtb nil)
105 (nnoo-define-basics nnweb)
107 (deffoo nnweb-retrieve-headers (articles &optional group server fetch-old)
108   (nnweb-possibly-change-server group server)
115 	  (when (setq header (cadr (assq article nnweb-articles)))
119 (deffoo nnweb-request-scan (&optional group server)
120   (nnweb-possibly-change-server group server)
121   (if nnweb-ephemeral-p
122       (setq nnweb-hashtb (gnus-make-hashtable 4095))
123     (unless nnweb-articles
124       (nnweb-read-overview group)))
125   (funcall (nnweb-definition 'map))
126   (unless nnweb-ephemeral-p
127     (nnweb-write-active)
128     (nnweb-write-overview group)))
130 (deffoo nnweb-request-group (group &optional server dont-check)
131   (nnweb-possibly-change-server group server)
132   (unless (or nnweb-ephemeral-p
134 	      nnweb-articles)
135     (nnweb-read-overview group))
137    ((not nnweb-articles)
138     (nnheader-report 'nnweb "No matching articles"))
140     (let ((active (if nnweb-ephemeral-p
141 		      (cons (caar nnweb-articles)
142 			    (caar (last nnweb-articles)))
143 		    (cadr (assoc group nnweb-group-alist)))))
144       (nnheader-report 'nnweb "Opened group %s" group)
146        "211 %d %d %d %s\n" (length nnweb-articles)
149 (deffoo nnweb-close-group (group &optional server)
150   (nnweb-possibly-change-server group server)
151   (when (gnus-buffer-live-p nnweb-buffer)
153       (set-buffer nnweb-buffer)
155       (kill-buffer nnweb-buffer)))
158 (deffoo nnweb-request-article (article &optional group server buffer)
159   (nnweb-possibly-change-server group server)
162     (let* ((header (cadr (assq article nnweb-articles)))
168 		     (nnweb-definition 'id t)
169 		     (let ((fetch (nnweb-definition 'id))
178 			 (if (nnweb-definition 'reference t)
180 				   (funcall (nnweb-definition
183 	  (funcall (nnweb-definition 'article)))
184 	(nnheader-report 'nnweb "Fetched article %s" article)
187 (deffoo nnweb-close-server (&optional server)
188   (when (and (nnweb-server-opened server)
189 	     (gnus-buffer-live-p nnweb-buffer))
191       (set-buffer nnweb-buffer)
193       (kill-buffer nnweb-buffer)))
194   (nnoo-close-server 'nnweb server))
196 (deffoo nnweb-request-list (&optional server)
197   (nnweb-possibly-change-server nil server)
200     (nnmail-generate-active (list (assoc server nnweb-group-alist)))
203 (deffoo nnweb-request-update-info (group info &optional server)
204   (nnweb-possibly-change-server group server))
206 (deffoo nnweb-asynchronous-p ()
209 (deffoo nnweb-request-create-group (group &optional server args)
210   (nnweb-possibly-change-server nil server)
211   (nnweb-request-delete-group group)
212   (push `(,group ,(cons 1 0)) nnweb-group-alist)
213   (nnweb-write-active)
216 (deffoo nnweb-request-delete-group (group &optional force server)
217   (nnweb-possibly-change-server group server)
218   (gnus-pull group nnweb-group-alist t)
219   (nnweb-write-active)
220   (gnus-delete-file (nnweb-overview-file group))
223 (nnoo-define-skeleton nnweb)
227 (defun nnweb-read-overview (group)
229   (when (file-exists-p (nnweb-overview-file group))
231       (nnheader-insert-file-contents (nnweb-overview-file group))
239 		nnweb-articles)
240 	  (nnweb-set-hashtb header (car nnweb-articles)))))))
242 (defun nnweb-write-overview (group)
244   (with-temp-file (nnweb-overview-file group)
245     (let ((articles nnweb-articles))
249 (defun nnweb-set-hashtb (header data)
250   (gnus-sethash (nnweb-identifier (mail-header-xref header))
251 		data nnweb-hashtb))
253 (defun nnweb-get-hashtb (url)
254   (gnus-gethash (nnweb-identifier url) nnweb-hashtb))
256 (defun nnweb-identifier (ident)
257   (funcall (nnweb-definition 'identifier) ident))
259 (defun nnweb-overview-file (group)
261   (nnheader-concat nnweb-directory group ".overview"))
263 (defun nnweb-write-active ()
265   (gnus-make-directory nnweb-directory)
266   (with-temp-file (nnheader-concat nnweb-directory "active")
267     (prin1 `(setq nnweb-group-alist ',nnweb-group-alist) (current-buffer))))
269 (defun nnweb-read-active ()
271   (load (nnheader-concat nnweb-directory "active") t t t))
273 (defun nnweb-definition (type &optional noerror)
275   (let ((def (cdr (assq type (assq nnweb-type nnweb-type-definition)))))
281 (defun nnweb-possibly-change-server (&optional group server)
283     (unless (nnweb-server-opened server)
284       (nnweb-open-server server))
285     (nnweb-init server))
286   (unless nnweb-group-alist
287     (nnweb-read-active))
288   (unless nnweb-hashtb
289     (setq nnweb-hashtb (gnus-make-hashtable 4095)))
291     (setq nnweb-group group)))
293 (defun nnweb-init (server)
295   (unless (gnus-buffer-live-p nnweb-buffer)
296     (setq nnweb-buffer
300 	       (format " *nnweb %s %s %s*"
301 		       nnweb-type nnweb-search server))
308 (defun nnweb-google-wash-article ()
333 (defun nnweb-google-parse-1 (&optional Message-ID)
337 	(active (cadr (assoc nnweb-group nnweb-group-alist)))
341       (push (list nnweb-group (setq active (cons 1 0)))
342 	    nnweb-group-alist))
354 		 (nnweb-definition 'result) Newsgroups mid))
382       (unless (nnweb-get-hashtb url)
393 	(nnweb-set-hashtb (cadar map) (car map))))
396 (defun nnweb-google-reference (id)
397   (let ((map (nnweb-google-parse-1 id)) header)
398     (setq nnweb-articles
399 	  (nconc nnweb-articles map))
405 (defun nnweb-google-create-mapping ()
408     (set-buffer nnweb-buffer)
411     (when (funcall (nnweb-definition 'search) nnweb-search)
415 	    (setq nnweb-articles
416 		  (nconc nnweb-articles (nnweb-google-parse-1)))
423 		    (>= i nnweb-max-hits))
426 	      (setq more (concat (nnweb-definition 'base) (match-string 1)))
433 	  (setq nnweb-articles
434 		(sort nnweb-articles 'car-less-than-car))))))
436 (defun nnweb-google-search (search)
439     (nnweb-definition 'address)
444 		  (min 100 nnweb-max-hits)))
453 (defun nnweb-google-identity (url)
460 ;;; gmane.org
462 (defun nnweb-gmane-create-mapping ()
465     (set-buffer nnweb-buffer)
467 	  (active (or (cadr (assoc nnweb-group nnweb-group-alist))
472       (when (funcall (nnweb-definition 'search) nnweb-search)
487 		   (format "http://article.gmane.org/%s/%s/raw"
491 		;; Add host part to gmane-encrypted addresses
494 					(concat from "public.gmane.org")))
499 		(unless (nnweb-get-hashtb (mail-header-xref header))
502 		  (nnweb-set-hashtb (cadar map) (car map))))))
505       (setq nnweb-articles
506 	    (sort (nconc nnweb-articles map) 'car-less-than-car)))))
508 (defun nnweb-gmane-wash-article ()
519 (defun nnweb-gmane-search (search)
522     (nnweb-definition 'address)
526        ("HITSPERPAGE" . ,(number-to-string nnweb-max-hits))))))
532 (defun nnweb-gmane-identity (url)
542 (defun nnweb-insert-html (parse)
557     (mapcar 'nnweb-insert-html (nth 2 parse))
560 (defun nnweb-parse-find (type parse &optional maxdepth)
563     (nnweb-parse-find-1 type parse maxdepth)))
565 (defun nnweb-parse-find-1 (type contents maxdepth)
574 	    (nnweb-parse-find-1 type element
577 (defun nnweb-parse-find-all (type parse)
580     (nnweb-parse-find-all-1 type parse)))
582 (defun nnweb-parse-find-all-1 (type contents)
591 		    (nconc result (nnweb-parse-find-all-1 type element))))))))
594 (defvar nnweb-text)
595 (defun nnweb-text (parse)
597   (let ((nnweb-text nil))
598     (nnweb-text-1 parse)
599     (nreverse nnweb-text)))
601 (defun nnweb-text-1 (contents)
604 	(push element nnweb-text)
607 	(nnweb-text-1 element)))))
609 (provide 'nnweb)
612 ;;; nnweb.el ends here