Threading works, make-dot-id is fixed, but starts at "B"?
[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 httest (make-hash))
21 (define refers (make-hash))
22 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
23 (define dotfile (open-output-file "cs136-trial.dot" #:exists 'truncate))
24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
25
26 (hash-set! users 'kspaans@csclub.uwaterloo.ca '())
27 (hash-set! users 'kspaans@csclub.uwaterloo.ca
28                        (cons 'nosane@user.com
29                              (hash-ref users 'kspaans@csclub.uwaterloo.ca)))
30
31 (fprintf dotfile "digraph cs136 {\n")
32 (fprintf dotfile "// Trial run starting at: ~a\n" (current-seconds))
33 ;; ^^^^ This is kind of tricky? Because I'll have to search the hashtable for each
34 ;;   value _while_ inserting it and adding to it... This seems indeal.
35 ;; Since hastables are mutable, maybe I can integrate getting they key into the
36 ;; whole process? I.E. search to make sure it's already there, and meanwhile
37 ;; save the value. If it's not already there, revert to adding the user.
38
39
40 ;(hash-for-each users (lambda (x y) (printf "~a~n" y)))
41
42 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
43
44 (define uwnews (connect-to-server "news.uwaterloo.ca"))
45
46 (define-values (total first last) (open-news-group uwnews "uw.cs.cs136"))
47
48 (printf "~a : ~a : ~a~n~n" total first last)
49
50
51 ;(for-each (lambda (x) (printf "~a~n" x)) (head-of-message uwnews 6038))
52
53 (define from-regexp (make-desired-header "From"))
54 (define mid-regexp (make-desired-header "Message-ID"))
55 (define ref-regexp (make-desired-header "References"))
56 (define subj-regexp (make-desired-header "Subject"))
57 ;(define from-and-mid (extract-desired-headers
58 ;                       (head-of-message uwnews 6038)
59 ;                       (list from-regexp mid-regexp)))
60
61 ;(printf "From:  ~a~nMID:   ~a~n~n" (car from-and-mid) (cadr from-and-mid))
62
63 ;; message-getter: newsgroup_connector number regexp -> (union string false)
64 ;; Do the dirty work of reading the message header info from the newsgroup.
65 ;; Returns false if the article cannot be retreived, and a string otherwise.
66 (define (message-getter group article headers)
67   (with-handlers ([article-not-in-group? (lambda (x) #f)])
68     (extract-desired-headers (head-of-message group article)
69                              headers)))
70
71 ;; read-all: int int newsgroup -> void
72 ;; recurse over all possible message "numbers" from the newsgroup
73 ;;   I wonder what will happen with the messages that slrn doesn't let
74 ;;   me read?
75 (define (read-all first last newsd)
76   (cond
77     [(= first last) (printf "^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^\n")]
78     ;;    ^^^^ Screw it, I'll just increment first as I recurse.
79     [else (local ((define mesg-from
80                           (message-getter uwnews first (list from-regexp))))
81           (cond [(not (boolean? mesg-from))
82                  (let ((in-table (hash-ref httest mesg-from #f)))
83                    (cond [(false? in-table) (hash-set! httest mesg-from 1)]
84                          [else (hash-set! httest mesg-from (+ 1 in-table))]))]))
85           (read-all (+ first 1) last newsd)]))
86
87 ;(printf "-------------------------------------------------------~n~n~n~n")
88
89 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
90 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
91 ;; nntp-map: operation newsgroup -> void
92 ;; maps some operation across each newsgroup post
93 ;;;(define (nntp-map op newsd)
94 ;;;  (let-values ([(total first-id last-id) (open-news-group newsd "uw.cs.cs136")])
95 ;;;    (op newsd
96 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
97 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
98
99
100 ;-------------------------
101 ;-------------------------
102 ;;; Want to put the message ID into the hash table with some kind of other unique ID
103 ;;; and then match references against the message ID to discover threads.
104 ;;; Directed edges will lead _away_ from the original post (towards follow-ups)
105 ;-------------------------
106 ;-------------------------
107
108 ;; look at head of the first few messages
109 (define (thread-print first last newsd)
110   (cond
111     [(= first last) (printf "****************\n")]
112     [else (local ((define mesg-from (message-getter uwnews first
113                                                     (list from-regexp
114                                                           mid-regexp
115                                                           ref-regexp
116                                                           subj-regexp))))
117             (cond
118               [(and (not (boolean? mesg-from)) (> (length mesg-from) 3))
119                (printf "From: ~a~nSubj: ~a~nMID:  ~a~nRefs: ~a~n~n"
120                        (car mesg-from) (cadr mesg-from) (caddr mesg-from) (get-refs (cadddr mesg-from)))]
121               [(not (boolean? mesg-from))
122                (printf "From: ~a~nSubj: ~a~nMID:  ~a~n~n"
123                        (car mesg-from) (cadr mesg-from) (caddr mesg-from))]))
124           (thread-print (+ first 1) last newsd)]))
125
126 (define (thread-hash first last newsd)
127   (cond
128     [(= first last) (printf "@@@@@@@@@@@@@@@@\n")]
129     [else (local [(define mesg-from (message-getter uwnews first
130                                                     (list mid-regexp  ; Ugh, the order coming out of this function
131                                                           from-regexp ; depends on what's in the headers, not the
132                                                           ref-regexp  ; order I have here. Usually From, Subj, MID, Refs
133                                                           subj-regexp)))
134                   (define node-id (make-dot-id))]
135             (cond
136               [(and (not (boolean? mesg-from)) (> (length mesg-from) 2))
137                (let [(result (map (lambda (x) (hash-ref refers x #f))
138                                   (get-refs (caddr mesg-from))))
139                      (mesg-ID (get-refs (caddr mesg-from)))]
140                  (cond
141                    [(boolean? (car result))
142                     (printf "----~nInserting MID(~a) into hash table.~n" (car mesg-ID))
143                     ;(let ([node-id (make-dot-id)])
144                       (fprintf dotfile "// Node ~a\n    ~a;\n" mesg-ID node-id)
145                       (hash-set! refers (car mesg-ID) node-id)];)]
146                    [else (printf "MIDs already in hash table?~n    >>~a<<~n" (caddr mesg-from))]))
147                (cond [(> (length mesg-from) 3)
148                       (printf "Checking References to find threading...~n")
149                       (let* [(Refs (get-refs (cadddr mesg-from)))
150                              (hRef (hash-ref refers (car Refs) #f))]
151                         (printf "Refs:     ~a~n" Refs)
152                         (printf "          Is it in the table? ~a~n" hRef)
153                         (if (boolean? hRef) (printf "        Nope.~n")
154                             (fprintf dotfile "    ~a -> ~a;\n" hRef node-id)))])
155                (printf "Headers:\t ~a~n~n" mesg-from)]
156                ;(printf "From: ~a~nSubj: ~a~nMID:  ~a~n~n"
157                ;        (car mesg-from) (cadr mesg-from) (caddr mesg-from))]
158               [(not (boolean? mesg-from))
159                (printf "Pooppoop!~n")
160                (printf "From: ~a~nSubj: ~a~nMID:  ~a~n~n"
161                        (car mesg-from) (cadr mesg-from) (caddr mesg-from))]))
162           (thread-hash (+ first 1) last newsd)]))
163
164 ;(thread-print first (+ first 20) uwnews)
165 (thread-hash first (+ first 100) uwnews)
166 ;refers
167
168
169 ;(read-all first last uwnews)
170 ;(read-all first (+ first 1000) uwnews)
171 (fprintf dotfile "// Trial run finished at: ~a\n}\n" (current-seconds))
172
173 (close-output-port dotfile)
174 (disconnect-from-server uwnews)
175 ;(display "Disconnected.\n")