Cleanup: moved major functions into their own modules
[kspaans/nntp-to-dot] / userrel.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 ;; Graph the relationships between all users in the newsgroup, generate DOT
6 ;; code to represent them. Each unique user gets a node, and edges are drawn
7 ;; whenever a user replies to another user's message.
8
9 #lang scheme
10
11 (require "common.ss")
12
13 (provide userrel)
14
15 (define users (make-hash))
16 (define mids (make-hash))
17
18 ;; userrel: int int newsgroup ioport -> void
19 ;; User relations: who talked to whom on the newsgroup?
20 ;; Create a DOT file to graph the user interactions.
21 ;; Store usernames (email addressses) and their message-ids in a hash table
22 ;; for retreival and matching later.
23 (define (userrel first last newsd dotfile)
24   (fprintf dotfile "digraph cs136-userrel {\n")
25   (fprintf dotfile "// Run starting at: ~a\n" (current-seconds))
26   (fprintf dotfile "ranksep = 3\n")
27   ;(fprintf dotfile "nodesep = 1.0\n")
28   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
29   (cond
30     [(= first last) (void)]
31     [else
32      (local [(define mesg-from
33                      (message-getter newsd first
34                                      (list from-regexp  ; Ugh, the order coming out of this function
35                                            mid-regexp ; depends on what's in the headers, not the
36                                            ref-regexp)))  ; order I have here. Usually From, Subj, MID, Refs
37              (define node-id (make-dot-id))]
38        (cond
39          [(and (not (boolean? mesg-from)) (= (length mesg-from) 3))
40           (printf "--> ~a~n" (caddr mesg-from))
41           (printf " `-> Using ~a~n" (car (get-refs (caddr mesg-from))))
42                 ;; Supposedly I want to use the _last_ reference from the list in that header line.
43                 ;; since any reply has all references of message it replies to, plus MID.
44                 ;;  ---> helper function that traverses list and prints out threading as it goes by
45                 ;;  searching the hash table
46           (let [(exists (hash-ref mids (car (get-refs (caddr mesg-from))) #f))
47                 (poster (hash-ref users (car mesg-from) #f))]
48             (cond
49               [(boolean? exists) (printf " `-> Uhhh, ref to post that DNE?~n")
50                         ;; consider this just like the case where there is a new post:
51                         ;;  check to see if user already exists
52                         ;;  create node but not edge
53                                  (printf "  `-> ~a :: ~a~n~n" (car mesg-from) node-id)]
54               [(boolean? poster) ;(printf " `-> Uhhh, ref to user that DNE?~n")
55                                  (printf "  |`-> ~a :: ~a~n" (car mesg-from) node-id)
56                                  (printf "  `-> ~a~n~n" exists)
57                                  (ins-mid-u mids (car (get-refs (cadr mesg-from)))
58                                                  (list (car mesg-from) node-id))
59                                  (hash-set! users (car mesg-from) node-id)
60                                  (fprintf dotfile "~a //[label=\"~a\"];\n" node-id (car mesg-from))
61                                  (fprintf dotfile "~a -> ~a //[arrowhead=\"none\", style=\"invis\"];\n" node-id (cadr exists))]
62               [else (printf "  |`-> ~a :: ~a~n" (car mesg-from) poster)
63                     (printf "  `-> ~a~n~n" exists)
64                     (fprintf dotfile "~a -> ~a //[arrowhead=\"none\", style=\"invis\"];\n" poster (cadr exists))]))
65           (userrel (+ 1 first) last newsd)]
66          [(and (not (boolean? mesg-from)) (= (length mesg-from) 2))
67           ;; Only From and MID? It's a first post.
68           (printf "--> New Post:~n")
69           (printf " `-> ~a :: ~a~n" (car mesg-from) node-id)
70           (printf " `-> MID:  ~a~n~n" (car (get-refs (cadr mesg-from))))
71           (let [(uresult (hash-ref users (car mesg-from) #f))]
72             (cond
73               ;; If user does not already exist:
74               [(boolean? uresult)
75                ;; Save a key->val: MID -> '(From node-ID)
76                (ins-mid-u mids (car (get-refs (cadr mesg-from)))
77                                (list (car mesg-from) node-id))
78                ;; Save a key->val: From -> node-ID
79                (hash-set! users (car mesg-from) node-id)
80                (fprintf dotfile "~a //[label=\"~a\"];\n" node-id (car mesg-from))]
81               ;; Else only add the MID and existing node-ID to the hash table
82               [else (ins-mid-u mids (car (get-refs (cadr mesg-from)))
83                                     (list (car mesg-from) uresult))]))
84           (userrel (+ 1 first) last newsd)]
85          [else (userrel (+ 1 first) last newsd)]))])
86   (fprintf dotfile "// Run finished at: ~a\n}\n" (current-seconds)))