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