fixed "ref to user that DNE" bug
[kspaans/nntp-to-dot] / connect.ss
1 #lang scheme
2
3 (require net/nntp)
4 (require "ref-helper.ss")
5
6 ;; A first try with connecting to the newsgroup and downloading some posts
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8
9 ;; Data structure to capture interactions on the newsgroup.
10 ;;  Want to have FROM and TO fields. Ideally TO should be a list of
11 ;;   people who the from has interacted with. Or perhaps use a hash table?
12 ;;   Yes, want constant insert time for new users (read: node), and then
13 ;;   value can be a list of other users that this user has interacted with.
14 ;;  Should I differentiate between interactions in FROM and TO?
15 ;;  ^^^^^^^^^ I don't think I can. Especailly since I can make it an
16 ;;   undirected graph.
17
18 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
19 (define users (make-hash))
20 (define mids (make-hash))
21 (define httest (make-hash))
22 (define refers (make-hash))
23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24 (define dotfile (open-output-file "cs136-trial.dot" #:exists 'truncate))
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26
27 (fprintf dotfile "digraph cs136 {\n")
28 (fprintf dotfile "// Trial run starting at: ~a\n" (current-seconds))
29
30 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
31
32 (define uwnews (connect-to-server "news.uwaterloo.ca"))
33 (define-values (total first last) (open-news-group uwnews "uw.cs.cs136"))
34 (printf "~a : ~a : ~a~n~n" total first last)
35
36 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
37
38 (define from-regexp (make-desired-header "From"))
39 (define mid-regexp (make-desired-header "Message-ID"))
40 (define ref-regexp (make-desired-header "References"))
41 (define subj-regexp (make-desired-header "Subject"))
42
43 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
44
45 ;; read-all: int int newsgroup -> void
46 ;; recurse over all possible message "numbers" from the newsgroup
47 ;;   I wonder what will happen with the messages that slrn doesn't let
48 ;;   me read?
49 (define (read-all first last newsd)
50   (cond
51     [(= first last) (printf "^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^\n")]
52     [else (let [(message (message-getter uwnews first (list from-regexp subj-regexp mid-regexp ref-regexp)))]
53             (cond
54               [(boolean? message) (void)]
55               [else (for-each (lambda (header) (printf "~a~n" header))
56                               message)])
57             (newline))
58           (read-all (+ first 1) last newsd)]))
59
60 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
61 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
62 ;; nntp-map: operation newsgroup -> void
63 ;; maps some operation across each newsgroup post
64 ;;;(define (nntp-map op newsd)
65 ;;;  (let-values ([(total first-id last-id) (open-news-group newsd "uw.cs.cs136")])
66 ;;;    (op newsd
67 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
68 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
69
70
71 ;-------------------------
72 ;-------------------------
73 ;;; Want to put the message ID into the hash table with some kind of other unique ID
74 ;;; and then match references against the message ID to discover threads.
75 ;;; Directed edges will lead _away_ from the original post (towards follow-ups)
76 ;-------------------------
77 ;-------------------------
78
79 ;; look at head of the first few messages
80 (define (thread-print first last newsd)
81   (cond
82     [(= first last) (printf "****************\n")]
83     [else (local ((define mesg-from (message-getter uwnews first
84                                                     (list from-regexp
85                                                           mid-regexp
86                                                           ref-regexp
87                                                           subj-regexp))))
88             (cond
89               [(and (not (boolean? mesg-from)) (> (length mesg-from) 3))
90                (printf "From: ~a~nSubj: ~a~nMID:  ~a~nRefs: ~a~n~n"
91                        (car mesg-from) (cadr mesg-from) (caddr mesg-from) (get-refs (cadddr mesg-from)))]
92               [(not (boolean? mesg-from))
93                (printf "From: ~a~nSubj: ~a~nMID:  ~a~n~n"
94                        (car mesg-from) (cadr mesg-from) (caddr mesg-from))]))
95           (thread-print (+ first 1) last newsd)]))
96
97 (define (thread-hash first last newsd)
98   (cond
99     [(= first last) (printf "@@@@@@@@@@@@@@@@\n")]
100     [else (local [(define mesg-from (message-getter uwnews first
101                                                     (list mid-regexp  ; Ugh, the order coming out of this function
102                                                           from-regexp ; depends on what's in the headers, not the
103                                                           ref-regexp  ; order I have here. Usually From, Subj, MID, Refs
104                                                           subj-regexp)))
105                   (define node-id (make-dot-id))]
106             (cond
107               [(and (not (boolean? mesg-from)) (> (length mesg-from) 2))
108                (let [(result (map (lambda (x) (hash-ref refers x #f))
109                                   (get-refs (caddr mesg-from))))
110                      (mesg-ID (get-refs (caddr mesg-from)))]
111                  (cond
112                    [(boolean? (car result))
113                     (printf "----~nInserting MID(~a) into hash table.~n" (car mesg-ID))
114                       (fprintf dotfile "// Node ~a\n    ~a;\n" mesg-ID node-id)
115                       (hash-set! refers (car mesg-ID) node-id)]
116                    [else (printf "MIDs already in hash table?~n    >>~a<<~n" (caddr mesg-from))]))
117                  ;(if (> (length (car mesg-ID)) 1)
118                  ;    (printf "Exciting, more than one reference!~n")
119                  ;    (void)))
120                (cond [(> (length mesg-from) 3)
121                       (printf "Checking References to find threading...~n")
122                       (let* [(Refs (get-refs (cadddr mesg-from)))
123                              (hRef (hash-ref refers (car Refs) #f))]
124                         (printf "Refs:     ~a~n" Refs)
125                         (printf "          Is it in the table? ~a~n~n" hRef)
126                         (if (boolean? hRef) (void) ; (printf "          Nope.~n~n")
127                             (fprintf dotfile "    ~a -> ~a;\n" hRef node-id)))]
128                      [else ;(printf "Headers:\t ~a~n~n" mesg-from)])]
129                        (for-each (lambda (z) (printf "\t~a~n" z)) mesg-from)
130                        (newline)])]
131               [(not (boolean? mesg-from))
132                (printf "Pooppoop!~n")
133                (printf "From: ~a~nSubj: ~a~nMID:  ~a~n~n"
134                        (car mesg-from) (cadr mesg-from) (caddr mesg-from))]))
135           (thread-hash (+ first 1) last newsd)]))
136
137 ;(thread-print first (+ first 20) uwnews)
138 ;(thread-hash first (+ first 100) uwnews)
139 ;; Want better threading now. Use the second pair in the references line
140
141
142 ;; userrel: User relations: who talked to whom on the newsgroup?
143 ;; Store usernames (email addressses) and their message-ids in a hash table
144 ;; for retreival and matching later.
145 (define (userrel first last newsd)
146   (cond
147     [(= first last) (void)]
148     [else
149      (local [(define mesg-from
150                      (message-getter uwnews first
151                                      (list from-regexp  ; Ugh, the order coming out of this function
152                                            mid-regexp ; depends on what's in the headers, not the
153                                            ref-regexp)))  ; order I have here. Usually From, Subj, MID, Refs
154              (define node-id (make-dot-id))]
155        (cond
156          [(and (not (boolean? mesg-from)) (= (length mesg-from) 3))
157           (printf "--> ~a~n" (caddr mesg-from))
158           (printf " `-> Using ~a~n" (car (get-refs (caddr mesg-from))))
159           (let [(exists (hash-ref mids (car (get-refs (caddr mesg-from))) #f))
160                 (postee (hash-ref users (car mesg-from) #f))]
161             (cond
162               [(boolean? exists) (printf " `-> Uhhh, ref to post that DNE?~n")
163                                  (printf "  `-> ~a :: ~a~n~n" (car mesg-from) node-id)]
164               [(boolean? postee) ;(printf " `-> Uhhh, ref to user that DNE?~n")
165                                  (printf "  |`-> ~a :: ~a~n" (car mesg-from) node-id)
166                                  (printf "  `-> ~a~n~n" exists)
167                                  (ins-mid-u mids (car (get-refs (cadr mesg-from)))
168                                                  (list (car mesg-from) node-id))
169                                  (hash-set! users (car mesg-from) node-id)
170                                  (fprintf dotfile "~a //[label=\"~a\"];\n" node-id (car mesg-from))
171                                  (fprintf dotfile "~a -> ~a;\n" node-id (cadr exists))]
172               [else (printf "  |`-> ~a :: ~a~n" (car mesg-from) postee)
173                     (printf "  `-> ~a~n~n" exists)
174                     (fprintf dotfile "~a -> ~a;\n" postee (cadr exists))]))
175           (userrel (+ 1 first) last newsd)]
176          [(and (not (boolean? mesg-from)) (= (length mesg-from) 2))
177           ;; Only From and MID? It's a first post.
178           (printf "--> New Post:~n")
179           (printf " `-> ~a :: ~a~n" (car mesg-from) node-id)
180           (printf " `-> MID:  ~a~n~n" (car (get-refs (cadr mesg-from))))
181           ;; Save a key->val: MID -> '(From node-ID)
182           (ins-mid-u mids (car (get-refs (cadr mesg-from)))
183                            (list (car mesg-from) node-id))
184           ;; Save a key->val: From -> node-ID
185           (let [(uresult (hash-ref users (car mesg-from) #f))]
186             (cond
187               [(boolean? uresult)
188                (hash-set! users (car mesg-from) node-id)
189                (fprintf dotfile "~a //[label=\"~a\"];\n" node-id (car mesg-from))]))
190           (userrel (+ 1 first) last newsd)]
191          [else (userrel (+ 1 first) last newsd)]))]))
192
193 (read-all first (+ 10 first) uwnews)
194 (userrel first (+ 10 first) uwnews)
195
196 ;(begin
197 ;  (hash-map users (lambda (x y) (printf "~a]]] ~a~n~n" x y)))
198 ;  "_ _ _")
199 ;(begin
200 ;  (hash-map mids (lambda (x y) (printf "~a]]] ~a~n~n" x y)))
201 ;  "_ _ _")
202
203 ;(read-all first last uwnews)
204 ;(read-all first (+ first 1000) uwnews)
205 (fprintf dotfile "// Trial run finished at: ~a\n}\n" (current-seconds))
206
207 (close-output-port dotfile)
208 (disconnect-from-server uwnews)
209 ;(display "Disconnected.\n")