Cleanup: moved major functions into their own modules
[kspaans/nntp-to-dot] / thread.ss
1 ;; Copyright (C) 2009  Kyle Spaans
2 ;;  this program is distributed under the GPL v2 or (at your option)
3 ;;  any later version.
4
5 ;; Detect and work with threads of messages in the newsgroup.
6
7 #lang scheme
8
9 (require "common.ss")
10
11 (provide thread-print thread-hash)
12
13 (define refers (make-hash))
14
15 ;-------------------------
16 ;-------------------------
17 ;;; Want to put the message ID into the hash table with some kind of other unique ID
18 ;;; and then match references against the message ID to discover threads.
19 ;;; Directed edges will lead _away_ from the original post (towards follow-ups)
20 ;-------------------------
21 ;-------------------------
22
23 ;; look at head of the first few messages
24 (define (thread-print first last newsd)
25   (cond
26     [(= first last) (printf "****************\n")]
27     [else (local ((define mesg-from (message-getter newsd first
28                                                     (list from-regexp
29                                                           mid-regexp
30                                                           ref-regexp
31                                                           subj-regexp))))
32             (cond
33               [(and (not (boolean? mesg-from)) (> (length mesg-from) 3))
34                (printf "From: ~a~nSubj: ~a~nMID:  ~a~nRefs: ~a~n~n"
35                        (car mesg-from) (cadr mesg-from) (caddr mesg-from) (get-refs (cadddr mesg-from)))]
36               [(not (boolean? mesg-from))
37                (printf "From: ~a~nSubj: ~a~nMID:  ~a~n~n"
38                        (car mesg-from) (cadr mesg-from) (caddr mesg-from))]))
39           (thread-print (+ first 1) last newsd)]))
40
41 (define (thread-hash first last newsd dotfile)
42   (cond
43     [(= first last) (printf "@@@@@@@@@@@@@@@@\n")]
44     [else (local [(define mesg-from (message-getter newsd first
45                                                     (list mid-regexp  ; Ugh, the order coming out of this function
46                                                           from-regexp ; depends on what's in the headers, not the
47                                                           ref-regexp  ; order I have here. Usually From, Subj, MID, Refs
48                                                           subj-regexp)))
49                   (define node-id (make-dot-id))]
50             (cond
51               [(and (not (boolean? mesg-from)) (> (length mesg-from) 2))
52                (let [(result (map (lambda (x) (hash-ref refers x #f))
53                                   (get-refs (caddr mesg-from))))
54                      (mesg-ID (get-refs (caddr mesg-from)))]
55                  (cond
56                    [(boolean? (car result))
57                     (printf "----~nInserting MID(~a) into hash table.~n" (car mesg-ID))
58                       (fprintf dotfile "// Node ~a\n    ~a;\n" mesg-ID node-id)
59                       (hash-set! refers (car mesg-ID) node-id)]
60                    [else (printf "MIDs already in hash table?~n    >>~a<<~n" (caddr mesg-from))]))
61                  ;(if (> (length (car mesg-ID)) 1)
62                  ;    (printf "Exciting, more than one reference!~n")
63                  ;    (void)))
64                (cond [(> (length mesg-from) 3)
65                       (printf "Checking References to find threading...~n")
66                       (let* [(Refs (get-refs (cadddr mesg-from)))
67                              (hRef (hash-ref refers (car Refs) #f))]
68                         (printf "Refs:     ~a~n" Refs)
69                         (printf "          Is it in the table? ~a~n~n" hRef)
70                         (if (boolean? hRef) (void) ; (printf "          Nope.~n~n")
71                             (fprintf dotfile "    ~a -> ~a;\n" hRef node-id)))]
72                      [else ;(printf "Headers:\t ~a~n~n" mesg-from)])]
73                        (for-each (lambda (z) (printf "\t~a~n" z)) mesg-from)
74                        (newline)])]
75               [(not (boolean? mesg-from))
76                (printf "Pooppoop!~n")
77                (printf "From: ~a~nSubj: ~a~nMID:  ~a~n~n"
78                        (car mesg-from) (cadr mesg-from) (caddr mesg-from))]))
79           (thread-hash (+ first 1) last newsd)]))