Cleanup: moved major functions into their own modules cleanup
authorKyle Spaans <kspaans@student.math.uwaterloo.ca>
Fri, 17 Apr 2009 18:10:58 +0000 (14:10 -0400)
committerKyle Spaans <kspaans@student.math.uwaterloo.ca>
Fri, 17 Apr 2009 18:10:58 +0000 (14:10 -0400)
Major functions can now sit nicely in their own files/modules. Also
renamed connect.ss to nntp-to-dot.ss

common.ss [new file with mode: 0644]
connect.ss [deleted file]
nntp-to-dot.ss [new file with mode: 0644]
ppd.ss [new file with mode: 0644]
ref-helper.ss [deleted file]
thread.ss [new file with mode: 0644]
userrel.ss [new file with mode: 0644]

diff --git a/common.ss b/common.ss
new file mode 100644 (file)
index 0000000..1723255
--- /dev/null
+++ b/common.ss
@@ -0,0 +1,92 @@
+;; Copyright (C) 2009  Kyle Spaans
+;;  this program is distributed under the GPL v2 or (at your option)
+;;  any later version.
+
+;; Some common helper functions
+
+#lang scheme
+
+(require net/nntp)
+
+(provide message-getter get-refs make-dot-id ins-user-id ins-mid-u from-regexp
+         mid-regexp ref-regexp subj-regexp date-regexp)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define from-regexp (make-desired-header "From"))
+(define mid-regexp (make-desired-header "Message-ID"))
+(define ref-regexp (make-desired-header "References"))
+(define subj-regexp (make-desired-header "Subject"))
+(define date-regexp (make-desired-header "Date"))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; message-getter: newsgroup_connector number regexp -> (union string false)
+;; Do the dirty work of reading the message header info from the newsgroup.
+;; Returns false if the article cannot be retreived, and a string otherwise.
+(define (message-getter group article headers)
+  (with-handlers ([article-not-in-group? (lambda (x) #f)])
+    (extract-desired-headers (head-of-message group article)
+                             headers)))
+
+;; get-refs: string -> (listof string)
+;; Given an NNTP "References:" header line, will extract all Message-IDs in it
+(define references-regexp #rx"<[^>]*>")
+(define (get-refs refline)
+  (let [(ref-match (regexp-match references-regexp refline))]
+    (cond
+      [(boolean? ref-match) empty]
+      [else (cons (car ref-match)
+                  (get-refs (substring refline
+                                      ;; Need to only go to the last matching
+                                      ;; index so that we don't go out of range
+                                       (cdar (regexp-match-positions
+                                              references-regexp
+                                              refline)))))])))
+
+;; make-dot-id: void -> string
+;; Generates a unique dot ID every time it is called, side effect of
+;; incrementing an internal counter is used.
+;; Turns an integer (internal counter) into a string of uppercase
+;; letters
+(define counter -1)
+;;;;
+(define (num2list num first)
+  (cond [(and (not first) (zero? num)) '()]
+        [else (cons (+ 65 (modulo num 26))
+                    (num2list (quotient num 26) false))]))
+(define (num2letters num first)
+  (list->string (reverse
+    (map integer->char (num2list num first)))))
+(define make-dot-id
+  (lambda ()
+      (begin
+        (set! counter (+ 1 counter))
+        (num2letters counter true))))
+
+;; ins-user-id: hash-table string string -> void
+;; Inserts user information into a hash table. Takes the table, the username
+;; (email address) and a message-id. user is used as the key and MID the
+;; value. Each user can post multiple messages, therefore MIDs are stored
+;; in another hash table along with the (date/time/order/count?) of the post
+(define (ins-user-id htable user mid)
+  (let [(uresult (hash-ref htable user #f))]
+    (if (boolean? uresult)
+        ;; New user, create hash with MID
+        (local [(define new-user-htable (make-hash))]
+          (hash-set! new-user-htable mid 0) ; user date instead?
+          (hash-set! htable user new-user-htable))
+        ;; Add MID to hash table (MIDs are assumed to be unique
+       (hash-set! uresult mid (hash-count uresult)))))
+
+;; ins-mid-u: hash-table string string -> void
+;; Inserts message-ID information into a hash table. Takes the table, the message-id
+;; and a username (email address). MID is used as the key and user the
+;; value. MIDs are unique, but multiple MIDS may have the same user value
+(define (ins-mid-u htable mid user)
+  (let [(mresult (hash-ref htable mid #f))]
+    (if (boolean? mresult)
+        ;; New MID, associate with user
+        (hash-set! htable mid user)
+        ;; Mid already exists?
+       (error 'mid-collision))))
diff --git a/connect.ss b/connect.ss
deleted file mode 100644 (file)
index 380fef1..0000000
+++ /dev/null
@@ -1,286 +0,0 @@
-;; Copyright (C) 2009  Kyle Spaans
-;;  this program is distributed under the GPL v2 or (at your option)
-;;  any later version.
-
-#lang scheme
-
-(require net/nntp)
-(require srfi/19)
-(require "ref-helper.ss")
-
-(provide uwnews total first last read-all posts-per-day thread-print
-         thread-hash userrel)
-;; A first try with connecting to the newsgroup and downloading some posts
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; Data structure to capture interactions on the newsgroup.
-;;  Want to have FROM and TO fields. Ideally TO should be a list of
-;;   people who the from has interacted with. Or perhaps use a hash table?
-;;   Yes, want constant insert time for new users (read: node), and then
-;;   value can be a list of other users that this user has interacted with.
-;;  Should I differentiate between interactions in FROM and TO?
-;;  ^^^^^^^^^ I don't think I can. Especailly since I can make it an
-;;   undirected graph.
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define users (make-hash))
-(define mids (make-hash))
-(define httest (make-hash))
-(define refers (make-hash))
-(define dates (make-hash))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define dotfile (open-output-file "cs136-trial.dot" #:exists 'truncate))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(fprintf dotfile "digraph cs136 {\n")
-(fprintf dotfile "// Trial run starting at: ~a\n" (current-seconds))
-(fprintf dotfile "ranksep = 3\n")
-;(fprintf dotfile "nodesep = 1.0\n")
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define uwnews (connect-to-server "news.uwaterloo.ca"))
-(define-values (total first last) (open-news-group uwnews "uw.cs.cs136"))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(define from-regexp (make-desired-header "From"))
-(define mid-regexp (make-desired-header "Message-ID"))
-(define ref-regexp (make-desired-header "References"))
-(define subj-regexp (make-desired-header "Subject"))
-(define date-regexp (make-desired-header "Date"))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; read-all: int int newsgroup -> void
-;; recurse over all possible message "numbers" from the newsgroup
-(define (read-all first last newsd)
-  (cond
-    [(= first last) (printf "^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^\n")]
-    [else (let [(message (message-getter uwnews first (list from-regexp subj-regexp mid-regexp ref-regexp)))]
-            (cond
-              [(boolean? message) (void)]
-              [else (for-each (lambda (header) (printf "~a~n" header))
-                              message)])
-            (newline))
-          (read-all (+ first 1) last newsd)]))
-
-;; posts-per-day: int int newsgroup -> void
-;; Print out the number of posts per day on the newsgroup, in a format ready for
-;; gnuplot to plot.
-;; Date headers seem to be either 32,36,37 or 43 chars long
-;; --> Parse date, save to a list, For-each save $DAY into hash table with count
-(define date-list '())
-(define (posts-per-day first last newsd)
-  (cond
-    [(= first last) (dates-to-count date-list)]
-    [else (let [(message (message-getter newsd first (list date-regexp)))]
-            (cond
-              [(boolean? message) (void)]
-              [else ;(printf "~a~n~a~n" (string-length (car message)) (car message))
-               (let [(mlen (string-length (car message)))]
-               (cond
-                 [(= 32 mlen) (set! date-list (cons (string->date (substring (car message) 5) "~d ~b ~Y ~H:~M:~S ~z") date-list))]
-                 [(= 36 mlen) (set! date-list (cons (string->date (substring (car message) 5) "~a, ~d ~b ~Y ~H:~M:~S ~z") date-list))]
-                 [(= 37 mlen) (set! date-list (cons (string->date (substring (car message) 5) "~a, ~d ~b ~Y ~H:~M:~S ~z") date-list))]
-                 [(= 43 mlen) (set! date-list (cons (string->date (substring (car message) 5) "~a, ~d ~b ~Y ~H:~M:~S ~z") date-list))]))]))
-          (posts-per-day (+ first 1) last newsd)]))
-
-;; dates-to-count: (listof date) -> void
-;; Uses the global "dates" hash table to store counts (values) related to unique
-;; days (keys) that are built up using posts-per-day and stored in date-list
-(define (dates-to-count dlst)
-  (cond
-    [(empty? dlst) (hash-for-each dates (lambda (d c) (printf "~a ~a~n" d c)))]
-    [else
-     (letrec [(date (date->string (car dlst) "~D"))
-              (count (hash-ref dates date #f))]
-       (cond
-         [(boolean? count) (hash-set! dates date 1) (dates-to-count (cdr dlst))]
-         [else (hash-set! dates date (+ 1 count)) (dates-to-count (cdr dlst))]))]))
-
-#|    [else (let [(message (message-getter uwnews first (list date-regexp)))]
-            (cond
-              [(boolean? message) (void)]
-              [else (if (> (string-length (car message)) 32)
-                        (printf "~a~n"
-                            (substring (car message)
-                                       11
-                                       ;; Assume all date headers are nice and uniform
-                                       ;; use that date SRFI?
-                                       (- (string-length (car message)) 15)))
-                            ;first)
-                        (printf "~a~n"
-                            (substring (car message)
-                                       6
-                                       ;; Assume all date headers are nice and uniform
-                                       ;; use that date SRFI?
-                                       (- (string-length (car message)) 15))))]))
-                            ;first)
-          (posts-per-day (+ first 1) last newsd)]))
-|#
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; nntp-map: operation newsgroup -> void
-;; maps some operation across each newsgroup post
-;;;(define (nntp-map op newsd)
-;;;  (let-values ([(total first-id last-id) (open-news-group newsd "uw.cs.cs136")])
-;;;    (op newsd
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-;-------------------------
-;-------------------------
-;;; Want to put the message ID into the hash table with some kind of other unique ID
-;;; and then match references against the message ID to discover threads.
-;;; Directed edges will lead _away_ from the original post (towards follow-ups)
-;-------------------------
-;-------------------------
-
-;; look at head of the first few messages
-(define (thread-print first last newsd)
-  (cond
-    [(= first last) (printf "****************\n")]
-    [else (local ((define mesg-from (message-getter uwnews first
-                                                   (list from-regexp
-                                                         mid-regexp
-                                                         ref-regexp
-                                                         subj-regexp))))
-            (cond
-             [(and (not (boolean? mesg-from)) (> (length mesg-from) 3))
-               (printf "From: ~a~nSubj: ~a~nMID:  ~a~nRefs: ~a~n~n"
-                      (car mesg-from) (cadr mesg-from) (caddr mesg-from) (get-refs (cadddr mesg-from)))]
-              [(not (boolean? mesg-from))
-              (printf "From: ~a~nSubj: ~a~nMID:  ~a~n~n"
-                      (car mesg-from) (cadr mesg-from) (caddr mesg-from))]))
-          (thread-print (+ first 1) last newsd)]))
-
-(define (thread-hash first last newsd)
-  (cond
-    [(= first last) (printf "@@@@@@@@@@@@@@@@\n")]
-    [else (local [(define mesg-from (message-getter uwnews first
-                                                   (list mid-regexp  ; Ugh, the order coming out of this function
-                                                         from-regexp ; depends on what's in the headers, not the
-                                                         ref-regexp  ; order I have here. Usually From, Subj, MID, Refs
-                                                         subj-regexp)))
-                  (define node-id (make-dot-id))]
-            (cond
-             [(and (not (boolean? mesg-from)) (> (length mesg-from) 2))
-               (let [(result (map (lambda (x) (hash-ref refers x #f))
-                                  (get-refs (caddr mesg-from))))
-                     (mesg-ID (get-refs (caddr mesg-from)))]
-                 (cond
-                   [(boolean? (car result))
-                    (printf "----~nInserting MID(~a) into hash table.~n" (car mesg-ID))
-                      (fprintf dotfile "// Node ~a\n    ~a;\n" mesg-ID node-id)
-                      (hash-set! refers (car mesg-ID) node-id)]
-                   [else (printf "MIDs already in hash table?~n    >>~a<<~n" (caddr mesg-from))]))
-                 ;(if (> (length (car mesg-ID)) 1)
-                 ;    (printf "Exciting, more than one reference!~n")
-                 ;    (void)))
-               (cond [(> (length mesg-from) 3)
-                      (printf "Checking References to find threading...~n")
-                      (let* [(Refs (get-refs (cadddr mesg-from)))
-                             (hRef (hash-ref refers (car Refs) #f))]
-                        (printf "Refs:     ~a~n" Refs)
-                        (printf "          Is it in the table? ~a~n~n" hRef)
-                        (if (boolean? hRef) (void) ; (printf "          Nope.~n~n")
-                            (fprintf dotfile "    ~a -> ~a;\n" hRef node-id)))]
-                     [else ;(printf "Headers:\t ~a~n~n" mesg-from)])]
-                       (for-each (lambda (z) (printf "\t~a~n" z)) mesg-from)
-                       (newline)])]
-              [(not (boolean? mesg-from))
-               (printf "Pooppoop!~n")
-               (printf "From: ~a~nSubj: ~a~nMID:  ~a~n~n"
-                      (car mesg-from) (cadr mesg-from) (caddr mesg-from))]))
-          (thread-hash (+ first 1) last newsd)]))
-
-;(thread-print first (+ first 20) uwnews)
-;(thread-hash first (+ first 100) uwnews)
-;; Want better threading now. Use the second pair in the references line
-
-
-;; userrel: User relations: who talked to whom on the newsgroup?
-;; Store usernames (email addressses) and their message-ids in a hash table
-;; for retreival and matching later.
-(define (userrel first last newsd)
-  (cond
-    [(= first last) (void)]
-    [else
-     (local [(define mesg-from
-                     (message-getter uwnews first
-                                     (list from-regexp  ; Ugh, the order coming out of this function
-                                          mid-regexp ; depends on what's in the headers, not the
-                                          ref-regexp)))  ; order I have here. Usually From, Subj, MID, Refs
-             (define node-id (make-dot-id))]
-       (cond
-         [(and (not (boolean? mesg-from)) (= (length mesg-from) 3))
-          (printf "--> ~a~n" (caddr mesg-from))
-          (printf " `-> Using ~a~n" (car (get-refs (caddr mesg-from))))
-                ;; Supposedly I want to use the _last_ reference from the list in that header line.
-                ;; since any reply has all references of message it replies to, plus MID.
-                ;;  ---> helper function that traverses list and prints out threading as it goes by
-                ;;  searching the hash table
-          (let [(exists (hash-ref mids (car (get-refs (caddr mesg-from))) #f))
-                (poster (hash-ref users (car mesg-from) #f))]
-            (cond
-              [(boolean? exists) (printf " `-> Uhhh, ref to post that DNE?~n")
-                        ;; consider this just like the case where there is a new post:
-                        ;;  check to see if user already exists
-                        ;;  create node but not edge
-                                 (printf "  `-> ~a :: ~a~n~n" (car mesg-from) node-id)]
-              [(boolean? poster) ;(printf " `-> Uhhh, ref to user that DNE?~n")
-                                 (printf "  |`-> ~a :: ~a~n" (car mesg-from) node-id)
-                                 (printf "  `-> ~a~n~n" exists)
-                                 (ins-mid-u mids (car (get-refs (cadr mesg-from)))
-                                                 (list (car mesg-from) node-id))
-                                 (hash-set! users (car mesg-from) node-id)
-                                 (fprintf dotfile "~a //[label=\"~a\"];\n" node-id (car mesg-from))
-                                 (fprintf dotfile "~a -> ~a //[arrowhead=\"none\", style=\"invis\"];\n" node-id (cadr exists))]
-              [else (printf "  |`-> ~a :: ~a~n" (car mesg-from) poster)
-                    (printf "  `-> ~a~n~n" exists)
-                    (fprintf dotfile "~a -> ~a //[arrowhead=\"none\", style=\"invis\"];\n" poster (cadr exists))]))
-          (userrel (+ 1 first) last newsd)]
-         [(and (not (boolean? mesg-from)) (= (length mesg-from) 2))
-          ;; Only From and MID? It's a first post.
-          (printf "--> New Post:~n")
-          (printf " `-> ~a :: ~a~n" (car mesg-from) node-id)
-          (printf " `-> MID:  ~a~n~n" (car (get-refs (cadr mesg-from))))
-          (let [(uresult (hash-ref users (car mesg-from) #f))]
-            (cond
-              ;; If user does not already exist:
-              [(boolean? uresult)
-               ;; Save a key->val: MID -> '(From node-ID)
-               (ins-mid-u mids (car (get-refs (cadr mesg-from)))
-                               (list (car mesg-from) node-id))
-               ;; Save a key->val: From -> node-ID
-               (hash-set! users (car mesg-from) node-id)
-               (fprintf dotfile "~a //[label=\"~a\"];\n" node-id (car mesg-from))]
-              ;; Else only add the MID and existing node-ID to the hash table
-              [else (ins-mid-u mids (car (get-refs (cadr mesg-from)))
-                                    (list (car mesg-from) uresult))]))
-          (userrel (+ 1 first) last newsd)]
-         [else (userrel (+ 1 first) last newsd)]))]))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;(read-all first (+ 100 first) uwnews)
-;;(userrel first (+ 800 first) uwnews)
-
-;;(begin
-;;  (hash-map users (lambda (x y) (printf "~a]]] ~a~n~n" x y)))
-;;  "_ _ _")
-;;(begin
-;;  (hash-map mids (lambda (x y) (printf "~a]]] ~a~n~n" x y)))
-;;  "_ _ _")
-
-(posts-per-day first last uwnews)
-;;(read-all first last uwnews)
-;;(read-all first (+ first 1000) uwnews)
-
-
-(fprintf dotfile "// Trial run finished at: ~a\n}\n" (current-seconds))
-
-(close-output-port dotfile)
-(disconnect-from-server uwnews)
diff --git a/nntp-to-dot.ss b/nntp-to-dot.ss
new file mode 100644 (file)
index 0000000..02ff1cf
--- /dev/null
@@ -0,0 +1,81 @@
+;; Copyright (C) 2009  Kyle Spaans
+;;  this program is distributed under the GPL v2 or (at your option)
+;;  any later version.
+
+;; NNTP-TO-DOT - perform various analyses of a newsgroup, generate some
+;;               DOT code for plotting with graphviz
+;;  FEATURES:
+;; - Generate a graph depicting all interactions between users on the group
+;; - Count the number of posts made per day
+
+#lang scheme
+
+(require net/nntp)
+(require "common.ss")
+(require "userrel.ss")
+(require "thread.ss")
+(require "ppd.ss")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Data structure to capture interactions on the newsgroup.
+;;  Want to have FROM and TO fields. Ideally TO should be a list of
+;;   people who the from has interacted with. Or perhaps use a hash table?
+;;   Yes, want constant insert time for new users (read: node), and then
+;;   value can be a list of other users that this user has interacted with.
+;;  Should I differentiate between interactions in FROM and TO?
+;;  ^^^^^^^^^ I don't think I can. Especailly since I can make it an
+;;   undirected graph.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define dotfile (open-output-file "data/cs136-trial.dot" #:exists 'truncate))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define uwnews (connect-to-server "news.uwaterloo.ca"))
+(define-values (total first last) (open-news-group uwnews "uw.cs.cs136"))
+
+;; read-all: int int newsgroup -> void
+;; recurse over all possible message "numbers" from the newsgroup
+(define (read-all first last newsd)
+  (cond
+    [(= first last) (printf "^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^\n")]
+    [else (let [(message (message-getter uwnews first (list from-regexp subj-regexp mid-regexp ref-regexp)))]
+            (cond
+              [(boolean? message) (void)]
+              [else (for-each (lambda (header) (printf "~a~n" header))
+                              message)])
+            (newline))
+          (read-all (+ first 1) last newsd)]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; nntp-map: operation newsgroup (listof header-regexp) -> void
+;; maps some operation across each newsgroup post
+;;;(define (nntp-map op newsd hregexps)
+;;;  (let-values ([(total first-id last-id) (open-news-group newsd "uw.cs.cs136")])
+;;;    (op newsd
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;(read-all first (+ 100 first) uwnews)
+;;(userrel first (+ 800 first) uwnews dotfile)
+
+;;(begin
+;;  (hash-map users (lambda (x y) (printf "~a]]] ~a~n~n" x y)))
+;;  "_ _ _")
+;;(begin
+;;  (hash-map mids (lambda (x y) (printf "~a]]] ~a~n~n" x y)))
+;;  "_ _ _")
+
+;;(read-all first last uwnews)
+;;(read-all first (+ first 1000) uwnews)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; CODE TO EXECUTE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(posts-per-day first last uwnews)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(close-output-port dotfile)
+(disconnect-from-server uwnews)
diff --git a/ppd.ss b/ppd.ss
new file mode 100644 (file)
index 0000000..b53a739
--- /dev/null
+++ b/ppd.ss
@@ -0,0 +1,48 @@
+;; Copyright (C) 2009  Kyle Spaans
+;;  this program is distributed under the GPL v2 or (at your option)
+;;  any later version.
+
+;; Count the number of posts per day on the newsgroup
+
+#lang scheme
+
+(require srfi/19)
+(require "common.ss")
+
+(provide posts-per-day)
+
+(define dates (make-hash))
+(define date-list '())
+
+;; dates-to-count: (listof date) -> void
+;; Uses the global "dates" hash table to store counts (values) related to unique
+;; days (keys) that are built up using posts-per-day and stored in date-list
+(define (dates-to-count dlst)
+  (cond
+    [(empty? dlst) (hash-for-each dates (lambda (d c) (printf "~a ~a~n" d c)))]
+    [else
+     (letrec [(date (date->string (car dlst) "~D"))
+              (count (hash-ref dates date #f))]
+       (cond
+         [(boolean? count) (hash-set! dates date 1) (dates-to-count (cdr dlst))]
+         [else (hash-set! dates date (+ 1 count)) (dates-to-count (cdr dlst))]))]))
+
+;; posts-per-day: int int newsgroup -> void
+;; Print out the number of posts per day on the newsgroup, in a format ready for
+;; gnuplot to plot.
+;; Date headers seem to be either 32,36,37 or 43 chars long
+;; --> Parse date, save to a list, For-each save $DAY into hash table with count
+(define (posts-per-day first last newsd)
+  (cond
+    [(= first last) (dates-to-count date-list)]
+    [else (let [(message (message-getter newsd first (list date-regexp)))]
+            (cond
+              [(boolean? message) (void)]
+              [else ;(printf "~a~n~a~n" (string-length (car message)) (car message))
+               (let [(mlen (string-length (car message)))]
+               (cond
+                 [(= 32 mlen) (set! date-list (cons (string->date (substring (car message) 5) "~d ~b ~Y ~H:~M:~S ~z") date-list))]
+                 [(= 36 mlen) (set! date-list (cons (string->date (substring (car message) 5) "~a, ~d ~b ~Y ~H:~M:~S ~z") date-list))]
+                 [(= 37 mlen) (set! date-list (cons (string->date (substring (car message) 5) "~a, ~d ~b ~Y ~H:~M:~S ~z") date-list))]
+                 [(= 43 mlen) (set! date-list (cons (string->date (substring (car message) 5) "~a, ~d ~b ~Y ~H:~M:~S ~z") date-list))]))]))
+          (posts-per-day (+ first 1) last newsd)]))
diff --git a/ref-helper.ss b/ref-helper.ss
deleted file mode 100644 (file)
index ceafea1..0000000
+++ /dev/null
@@ -1,79 +0,0 @@
-;; Copyright (C) 2009  Kyle Spaans
-;;  this program is distributed under the GPL v2 or (at your option)
-;;  any later version.
-
-#lang scheme
-
-(require net/nntp)
-
-(provide message-getter get-refs make-dot-id ins-user-id ins-mid-u)
-
-;; message-getter: newsgroup_connector number regexp -> (union string false)
-;; Do the dirty work of reading the message header info from the newsgroup.
-;; Returns false if the article cannot be retreived, and a string otherwise.
-(define (message-getter group article headers)
-  (with-handlers ([article-not-in-group? (lambda (x) #f)])
-    (extract-desired-headers (head-of-message group article)
-                             headers)))
-
-;; get-refs: string -> (listof string)
-;; Given an NNTP "References:" header line, will extract all Message-IDs in it
-(define references-regexp #rx"<[^>]*>")
-(define (get-refs refline)
-  (let [(ref-match (regexp-match references-regexp refline))]
-    (cond
-      [(boolean? ref-match) empty]
-      [else (cons (car ref-match)
-                  (get-refs (substring refline
-                                      ;; Need to only go to the last matching
-                                      ;; index so that we don't go out of range
-                                       (cdar (regexp-match-positions
-                                              references-regexp
-                                              refline)))))])))
-
-;; make-dot-id: void -> string
-;; Generates a unique dot ID every time it is called, side effect of
-;; incrementing an internal counter is used.
-;; Turns an integer (internal counter) into a string of uppercase
-;; letters
-(define counter -1)
-;;;;
-(define (num2list num first)
-  (cond [(and (not first) (zero? num)) '()]
-        [else (cons (+ 65 (modulo num 26))
-                    (num2list (quotient num 26) false))]))
-(define (num2letters num first)
-  (list->string (reverse
-    (map integer->char (num2list num first)))))
-(define make-dot-id
-  (lambda ()
-      (begin
-        (set! counter (+ 1 counter))
-        (num2letters counter true))))
-
-;; ins-user-id: hash-table string string -> void
-;; Inserts user information into a hash table. Takes the table, the username
-;; (email address) and a message-id. user is used as the key and MID the
-;; value. Each user can post multiple messages, therefore MIDs are stored
-;; in another hash table along with the (date/time/order/count?) of the post
-(define (ins-user-id htable user mid)
-  (let [(uresult (hash-ref htable user #f))]
-    (if (boolean? uresult)
-        ;; New user, create hash with MID
-        (local [(define new-user-htable (make-hash))]
-          (hash-set! new-user-htable mid 0) ; user date instead?
-          (hash-set! htable user new-user-htable))
-        ;; Add MID to hash table (MIDs are assumed to be unique
-       (hash-set! uresult mid (hash-count uresult)))))
-
-;; ins-mid-u: hash-table string string -> void
-;; Inserts message-ID information into a hash table. Takes the table, the message-id
-;; and a username (email address). MID is used as the key and user the
-;; value. MIDs are unique, but multiple MIDS may have the same user value
-(define (ins-mid-u htable mid user)
-  (let [(mresult (hash-ref htable mid #f))]
-    (if (boolean? mresult)
-        ;; New MID, associate with user
-        (hash-set! htable mid user)
-        ;; Mid already exists?
-       (error 'mid-collision))))
diff --git a/thread.ss b/thread.ss
new file mode 100644 (file)
index 0000000..7b81cef
--- /dev/null
+++ b/thread.ss
@@ -0,0 +1,79 @@
+;; Copyright (C) 2009  Kyle Spaans
+;;  this program is distributed under the GPL v2 or (at your option)
+;;  any later version.
+
+;; Detect and work with threads of messages in the newsgroup.
+
+#lang scheme
+
+(require "common.ss")
+
+(provide thread-print thread-hash)
+
+(define refers (make-hash))
+
+;-------------------------
+;-------------------------
+;;; Want to put the message ID into the hash table with some kind of other unique ID
+;;; and then match references against the message ID to discover threads.
+;;; Directed edges will lead _away_ from the original post (towards follow-ups)
+;-------------------------
+;-------------------------
+
+;; look at head of the first few messages
+(define (thread-print first last newsd)
+  (cond
+    [(= first last) (printf "****************\n")]
+    [else (local ((define mesg-from (message-getter newsd first
+                                                   (list from-regexp
+                                                         mid-regexp
+                                                         ref-regexp
+                                                         subj-regexp))))
+            (cond
+             [(and (not (boolean? mesg-from)) (> (length mesg-from) 3))
+               (printf "From: ~a~nSubj: ~a~nMID:  ~a~nRefs: ~a~n~n"
+                      (car mesg-from) (cadr mesg-from) (caddr mesg-from) (get-refs (cadddr mesg-from)))]
+              [(not (boolean? mesg-from))
+              (printf "From: ~a~nSubj: ~a~nMID:  ~a~n~n"
+                      (car mesg-from) (cadr mesg-from) (caddr mesg-from))]))
+          (thread-print (+ first 1) last newsd)]))
+
+(define (thread-hash first last newsd dotfile)
+  (cond
+    [(= first last) (printf "@@@@@@@@@@@@@@@@\n")]
+    [else (local [(define mesg-from (message-getter newsd first
+                                                   (list mid-regexp  ; Ugh, the order coming out of this function
+                                                         from-regexp ; depends on what's in the headers, not the
+                                                         ref-regexp  ; order I have here. Usually From, Subj, MID, Refs
+                                                         subj-regexp)))
+                  (define node-id (make-dot-id))]
+            (cond
+             [(and (not (boolean? mesg-from)) (> (length mesg-from) 2))
+               (let [(result (map (lambda (x) (hash-ref refers x #f))
+                                  (get-refs (caddr mesg-from))))
+                     (mesg-ID (get-refs (caddr mesg-from)))]
+                 (cond
+                   [(boolean? (car result))
+                    (printf "----~nInserting MID(~a) into hash table.~n" (car mesg-ID))
+                      (fprintf dotfile "// Node ~a\n    ~a;\n" mesg-ID node-id)
+                      (hash-set! refers (car mesg-ID) node-id)]
+                   [else (printf "MIDs already in hash table?~n    >>~a<<~n" (caddr mesg-from))]))
+                 ;(if (> (length (car mesg-ID)) 1)
+                 ;    (printf "Exciting, more than one reference!~n")
+                 ;    (void)))
+               (cond [(> (length mesg-from) 3)
+                      (printf "Checking References to find threading...~n")
+                      (let* [(Refs (get-refs (cadddr mesg-from)))
+                             (hRef (hash-ref refers (car Refs) #f))]
+                        (printf "Refs:     ~a~n" Refs)
+                        (printf "          Is it in the table? ~a~n~n" hRef)
+                        (if (boolean? hRef) (void) ; (printf "          Nope.~n~n")
+                            (fprintf dotfile "    ~a -> ~a;\n" hRef node-id)))]
+                     [else ;(printf "Headers:\t ~a~n~n" mesg-from)])]
+                       (for-each (lambda (z) (printf "\t~a~n" z)) mesg-from)
+                       (newline)])]
+              [(not (boolean? mesg-from))
+               (printf "Pooppoop!~n")
+               (printf "From: ~a~nSubj: ~a~nMID:  ~a~n~n"
+                      (car mesg-from) (cadr mesg-from) (caddr mesg-from))]))
+          (thread-hash (+ first 1) last newsd)]))
diff --git a/userrel.ss b/userrel.ss
new file mode 100644 (file)
index 0000000..f3e4e7c
--- /dev/null
@@ -0,0 +1,86 @@
+;; Copyright (C) 2009  Kyle Spaans
+;;  this program is distributed under the GPL v2 or (at your option)
+;;  any later version.
+
+;; Graph the relationships between all users in the newsgroup, generate DOT
+;; code to represent them. Each unique user gets a node, and edges are drawn
+;; whenever a user replies to another user's message.
+
+#lang scheme
+
+(require "common.ss")
+
+(provide userrel)
+
+(define users (make-hash))
+(define mids (make-hash))
+
+;; userrel: int int newsgroup ioport -> void
+;; User relations: who talked to whom on the newsgroup?
+;; Create a DOT file to graph the user interactions.
+;; Store usernames (email addressses) and their message-ids in a hash table
+;; for retreival and matching later.
+(define (userrel first last newsd dotfile)
+  (fprintf dotfile "digraph cs136-userrel {\n")
+  (fprintf dotfile "// Run starting at: ~a\n" (current-seconds))
+  (fprintf dotfile "ranksep = 3\n")
+  ;(fprintf dotfile "nodesep = 1.0\n")
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  (cond
+    [(= first last) (void)]
+    [else
+     (local [(define mesg-from
+                     (message-getter newsd first
+                                     (list from-regexp  ; Ugh, the order coming out of this function
+                                           mid-regexp ; depends on what's in the headers, not the
+                                          ref-regexp)))  ; order I have here. Usually From, Subj, MID, Refs
+             (define node-id (make-dot-id))]
+       (cond
+         [(and (not (boolean? mesg-from)) (= (length mesg-from) 3))
+          (printf "--> ~a~n" (caddr mesg-from))
+          (printf " `-> Using ~a~n" (car (get-refs (caddr mesg-from))))
+                ;; Supposedly I want to use the _last_ reference from the list in that header line.
+                ;; since any reply has all references of message it replies to, plus MID.
+                ;;  ---> helper function that traverses list and prints out threading as it goes by
+                ;;  searching the hash table
+          (let [(exists (hash-ref mids (car (get-refs (caddr mesg-from))) #f))
+                (poster (hash-ref users (car mesg-from) #f))]
+            (cond
+              [(boolean? exists) (printf " `-> Uhhh, ref to post that DNE?~n")
+                        ;; consider this just like the case where there is a new post:
+                        ;;  check to see if user already exists
+                        ;;  create node but not edge
+                                 (printf "  `-> ~a :: ~a~n~n" (car mesg-from) node-id)]
+              [(boolean? poster) ;(printf " `-> Uhhh, ref to user that DNE?~n")
+                                 (printf "  |`-> ~a :: ~a~n" (car mesg-from) node-id)
+                                 (printf "  `-> ~a~n~n" exists)
+                                 (ins-mid-u mids (car (get-refs (cadr mesg-from)))
+                                                 (list (car mesg-from) node-id))
+                                 (hash-set! users (car mesg-from) node-id)
+                                 (fprintf dotfile "~a //[label=\"~a\"];\n" node-id (car mesg-from))
+                                 (fprintf dotfile "~a -> ~a //[arrowhead=\"none\", style=\"invis\"];\n" node-id (cadr exists))]
+              [else (printf "  |`-> ~a :: ~a~n" (car mesg-from) poster)
+                    (printf "  `-> ~a~n~n" exists)
+                    (fprintf dotfile "~a -> ~a //[arrowhead=\"none\", style=\"invis\"];\n" poster (cadr exists))]))
+          (userrel (+ 1 first) last newsd)]
+         [(and (not (boolean? mesg-from)) (= (length mesg-from) 2))
+          ;; Only From and MID? It's a first post.
+          (printf "--> New Post:~n")
+          (printf " `-> ~a :: ~a~n" (car mesg-from) node-id)
+          (printf " `-> MID:  ~a~n~n" (car (get-refs (cadr mesg-from))))
+          (let [(uresult (hash-ref users (car mesg-from) #f))]
+            (cond
+              ;; If user does not already exist:
+              [(boolean? uresult)
+               ;; Save a key->val: MID -> '(From node-ID)
+               (ins-mid-u mids (car (get-refs (cadr mesg-from)))
+                               (list (car mesg-from) node-id))
+               ;; Save a key->val: From -> node-ID
+               (hash-set! users (car mesg-from) node-id)
+               (fprintf dotfile "~a //[label=\"~a\"];\n" node-id (car mesg-from))]
+              ;; Else only add the MID and existing node-ID to the hash table
+              [else (ins-mid-u mids (car (get-refs (cadr mesg-from)))
+                                    (list (car mesg-from) uresult))]))
+          (userrel (+ 1 first) last newsd)]
+         [else (userrel (+ 1 first) last newsd)]))])
+  (fprintf dotfile "// Run finished at: ~a\n}\n" (current-seconds)))