/log-parser.rkt

 1#! /bin/sh
 2#| Hey Emacs, this is -*-scheme-*- code!
 3exec racket -l errortrace --require "$0" --main -- ${1+"$@"}
 4exec racket --require "$0" --main -- ${1+"$@"}
 5|#
 6
 7#lang racket
 8
 9(require
10 (only-in profile profile-thunk)
11 (only-in mzlib/etc this-expression-source-directory)
12 (planet schematics/schemeunit:3)
13 (planet schematics/schemeunit:3/text-ui) )
14
15(provide (struct-out utterance))
16(struct utterance (timestamp speaker target text) #:prefab)
17
18(define (string->utterance s)
19  (define (ensure-string x)
20    (cond
21     [(string? x)
22      x]
23     [(bytes? x)
24      (bytes->string/utf-8 x)]))
25  (match s
26    ;; old style: the guts are an unparsed scheme string
27    [(regexp #px"^([[:print:]]+) <= \":([^!]*)!([^@]*)@([^ ]*) PRIVMSG ([^:]+) :(.*)\"$"
28          (list _ timestamp   nick    id      host            target   text))
29     (utterance timestamp nick target text)]
30
31    ;; new style: the guts are an s-expression
32    [(regexp #px"^([[:print:]]+) <= +(\\(.*\\))" (list _ timestamp raw-string))
33     (match (read (open-input-string raw-string))
34       [(list (list 'prefix (regexp #rx"(.*)!(.*)@(.*)" (list _ nick _ _)))
35              (list 'command #"PRIVMSG")
36              (list 'params
37                    (list 'param target)
38                    (list 'param text)))
39        (apply utterance (map ensure-string (list timestamp nick target text)))])
40     ]
41    [_ #f]))
42
43(define-test-suite tests
44  (for ([line '("2010-01-19T03:01:31Z <= \":offby1!n=user@pdpc/supporter/monthlybyte/offby1 PRIVMSG ##cinema :rudybot: uptime\""
45                "2010-01-19T03:01:31Z <= ((prefix #\"offby1!n=user@pdpc/supporter/monthlybyte/offby1\") (command #\"PRIVMSG\") (params (param #\"##cinema\") (param #\"rudybot: uptime\")))")])
46
47    (check-equal? (string->utterance line)
48                  #s(utterance "2010-01-19T03:01:31Z"
49                               "offby1"
50                               "##cinema"
51                               "rudybot: uptime")))
52  )
53
54(define (pe fmt . args)
55  (apply fprintf (current-error-port) fmt args))
56
57(provide main)
58(define (main . args)
59  (define input-file-names
60    (command-line
61     #:program "log-parser"
62     #:args input-file-names
63     input-file-names))
64  (cond
65   [(null? input-file-names)
66    (displayln "You didn't specify any input files; running unit tests instead of parsing" (current-error-port))
67    (exit (if (positive?  (run-tests tests)) 1 0))]
68   [(< 1 (length input-file-names))
69    (error 'log-parser "I want at most one input file name; instead you gave me ~s" input-file-names)]
70   [else
71    (let ([input-file-name (build-path (this-expression-source-directory) (car input-file-names))]
72          [output-file-name "parsed-log"])
73      (call-with-input-file
74          input-file-name
75        (lambda (ip)
76          (pe "Reading from ~a; writing to ~a..." input-file-name output-file-name)
77          (port-count-lines! ip)
78          (profile-thunk
79           (lambda ()
80             (call-with-output-file output-file-name
81               (lambda (op)
82                 (for ([line (in-lines ip)])
83                   (let ([utz (string->utterance line)])
84                     (when utz
85                       (write utz op)
86                       (newline op)))))
87               #:exists 'truncate)))))
88      (pe "done~%"))]))