git.csclub.uwaterloo.ca Git - kspaans/nntp-to-dot/blob - ppd.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 ;; Count the number of posts per day on the newsgroup
   6
   7 #lang scheme
   8
   9 (require srfi/19)
  10 (require "common.ss")
  11
  12 (provide posts-per-day)
  13
  14 (define dates (make-hash))
  15 (define date-list '())
  16
  17 ;; dates-to-count: (listof date) -> void
  18 ;; Uses the global "dates" hash table to store counts (values) related to unique
  19 ;; days (keys) that are built up using posts-per-day and stored in date-list
  20 (define (dates-to-count dlst)
  21   (cond
  22     [(empty? dlst) (hash-for-each dates (lambda (d c) (printf "~a ~a~n" d c)))]
  23     [else
  24      (letrec [(date (date->string (car dlst) "~D"))
  25               (count (hash-ref dates date #f))]
  26        (cond
  27          [(boolean? count) (hash-set! dates date 1) (dates-to-count (cdr dlst))]
  28          [else (hash-set! dates date (+ 1 count)) (dates-to-count (cdr dlst))]))]))
  29
  30 ;; posts-per-day: int int newsgroup -> void
  31 ;; Print out the number of posts per day on the newsgroup, in a format ready for
  32 ;; gnuplot to plot.
  33 ;; Date headers seem to be either 32,36,37 or 43 chars long
  34 ;; --> Parse date, save to a list, For-each save $DAY into hash table with count
  35 (define (posts-per-day first last newsd)
  36   (cond
  37     [(= first last) (dates-to-count date-list)]
  38     [else (let [(message (message-getter newsd first (list date-regexp)))]
  39             (cond
  40               [(boolean? message) (void)]
  41               [else ;(printf "~a~n~a~n" (string-length (car message)) (car message))
  42                (let [(mlen (string-length (car message)))]
  43                (cond
  44                  [(= 32 mlen) (set! date-list (cons (string->date (substring (car message) 5) "~d ~b ~Y ~H:~M:~S ~z") date-list))]
  45                  [(= 36 mlen) (set! date-list (cons (string->date (substring (car message) 5) "~a, ~d ~b ~Y ~H:~M:~S ~z") date-list))]
  46                  [(= 37 mlen) (set! date-list (cons (string->date (substring (car message) 5) "~a, ~d ~b ~Y ~H:~M:~S ~z") date-list))]
  47                  [(= 43 mlen) (set! date-list (cons (string->date (substring (car message) 5) "~a, ~d ~b ~Y ~H:~M:~S ~z") date-list))]))]))
  48           (posts-per-day (+ first 1) last newsd)]))