fixed "ref to user that DNE" bug
[kspaans/nntp-to-dot] / ref-helper.ss
1 #lang scheme
2
3 (require net/nntp)
4
5 (provide message-getter get-refs make-dot-id ins-user-id ins-mid-u)
6
7 ;; message-getter: newsgroup_connector number regexp -> (union string false)
8 ;; Do the dirty work of reading the message header info from the newsgroup.
9 ;; Returns false if the article cannot be retreived, and a string otherwise.
10 (define (message-getter group article headers)
11   (with-handlers ([article-not-in-group? (lambda (x) #f)])
12     (extract-desired-headers (head-of-message group article)
13                              headers)))
14
15 ;; get-refs: string -> (listof string)
16 ;; Given an NNTP "References:" header line, will extract all Message-IDs in it
17 (define references-regexp #rx"<[^>]*>")
18 (define (get-refs refline)
19   (let [(ref-match (regexp-match references-regexp refline))]
20     (cond
21       [(boolean? ref-match) empty]
22       [else (cons (car ref-match)
23                   (get-refs (substring refline
24                                        ;; Need to only go to the last matching
25                                        ;; index so that we don't go out of range
26                                        (cdar (regexp-match-positions
27                                                references-regexp
28                                                refline)))))])))
29
30 ;; make-dot-id: void -> string
31 ;; Generates a unique dot ID every time it is called, side effect of
32 ;; incrementing an internal counter is used.
33 ;; Turns an integer (internal counter) into a string of uppercase
34 ;; letters
35 (define counter -1)
36 ;;;;
37 (define (num2list num first)
38   (cond [(and (not first) (zero? num)) '()]
39         [else (cons (+ 65 (modulo num 26))
40                     (num2list (quotient num 26) false))]))
41 (define (num2letters num first)
42   (list->string (reverse
43     (map integer->char (num2list num first)))))
44 (define make-dot-id
45   (lambda ()
46       (begin
47         (set! counter (+ 1 counter))
48         (num2letters counter true))))
49
50 ;; ins-user-id: hash-table string string -> void
51 ;; Inserts user information into a hash table. Takes the table, the username
52 ;; (email address) and a message-id. user is used as the key and MID the
53 ;; value. Each user can post multiple messages, therefore MIDs are stored
54 ;; in another hash table along with the (date/time/order/count?) of the post
55 (define (ins-user-id htable user mid)
56   (let [(uresult (hash-ref htable user #f))]
57     (if (boolean? uresult)
58         ;; New user, create hash with MID
59         (local [(define new-user-htable (make-hash))]
60           (hash-set! new-user-htable mid 0) ; user date instead?
61           (hash-set! htable user new-user-htable))
62         ;; Add MID to hash table (MIDs are assumed to be unique
63         (hash-set! uresult mid (hash-count uresult)))))
64
65 ;; ins-mid-u: hash-table string string -> void
66 ;; Inserts message-ID information into a hash table. Takes the table, the message-id
67 ;; and a username (email address). MID is used as the key and user the
68 ;; value. MIDs are unique, but multiple MIDS may have the same user value
69 (define (ins-mid-u htable mid user)
70   (let [(mresult (hash-ref htable mid #f))]
71     (if (boolean? mresult)
72         ;; New MID, associate with user
73         (hash-set! htable mid user)
74         ;; Mid already exists?
75         (error 'mid-collision))))