X-Git-Url: https://git.xandkar.net/?a=blobdiff_plain;f=tt.rkt;h=e834505d6ffa79d0c9a727649a13779d084b508c;hb=a1473e3d2d87e21231bc57d9f320f0fbf6ec378a;hp=455e6e5d46b489194423d89a3c79a70dabcb30fe;hpb=4a94ef7b845c4a515352e4d14e46e81650841e29;p=tt.git

diff --git a/tt.rkt b/tt.rkt
index 455e6e5..e834505 100644
--- a/tt.rkt
+++ b/tt.rkt
@@ -74,34 +74,58 @@
                       (date->string (seconds->date [msg-ts_epoch msg]) #t))
                     nick uri color text)])))))
 
-(define re-msg-begin
-  ; TODO Zulu offset. Maybe in several formats. Which ones?
-  (pregexp "^[0-9]{4}-[0-9]{2}-[0-9]{2}T[0-9]{2}:[0-9]{2}:[0-9]{2}"))
+; TODO Implement rfc3339->epoch and remove dependency on rfc3339-old
 
-(define (str->msg nick uri str)
-  (if (not (regexp-match? re-msg-begin str))
-      (begin
-        (log-debug "Non-msg line from nick:~a, line:~a" nick str)
-        #f)
-      (let ([toks (string-split str (regexp "\t+"))])
-        (if (not (= 2 (length toks)))
-            (begin
-              (log-warning "Invalid msg line from nick:~a, msg:~a" nick str)
-              #f)
+(define str->msg
+  (let ([re (pregexp "^([0-9]{4}-[0-9]{2}-[0-9]{2}T[0-9]{2}:[0-9]{2}(:[0-9]{2})?)(\\.[0-9]+)?([^\\s\t]*)[\\s\t]+(.*)$")])
+    (λ (nick uri str)
+       (with-handlers*
+         ([exn:fail?
+            (λ (e)
+               (log-error "Failed to parse msg: ~v, from: ~v, at: ~v, because: ~v" str nick uri e)
+               #f)])
+         (match (regexp-match re str)
+           [(list _wholething ts s _fractional tz text)
             (let*
-              ([ts_rfc3339 (first  toks)]
-               [text       (second toks)]
+              ([ts_rfc3339 (string-append ts (if s "" ":00") (if tz tz ""))]
                [t          (string->rfc3339-record ts_rfc3339)]
+               [s          (rfc3339-record:second t)]
                ; TODO handle tz offset
-               [ts_epoch (find-seconds [rfc3339-record:second t]
+               [ts_epoch (find-seconds [if s s 0]
                                        [rfc3339-record:minute t]
                                        [rfc3339-record:hour   t]
                                        [rfc3339-record:mday   t]
                                        [rfc3339-record:month  t]
                                        [rfc3339-record:year   t])])
-              (msg ts_epoch ts_rfc3339 nick uri text))))))
+              (msg ts_epoch ts_rfc3339 nick uri text))]
+           [_
+             (log-debug "Non-msg line from nick:~a, line:~a" nick str)
+             #f])))))
 
 (module+ test
+  (let* ([tzs (for*/list ([d '("-" "+")]
+                          [h '("5" "05")]
+                          [m '("00" ":00" "57" ":57")])
+                         (string-append d h m))]
+         [tzs (list* "" "Z" tzs)])
+    (for* ([n   '("fake-nick")]
+           [u   '("fake-uri")]
+           [s   '("" ":10")]
+           [f   '("" ".1337")]
+           [z   tzs]
+           [sep (list "\t" " ")]
+           [txt '("foo bar baz" "'jaz poop bear giraffe / tea" "@*\"``")])
+          (let* ([ts (string-append "2020-11-18T22:22"
+                                    (if (non-empty-string? s) s ":00")
+                                    z)]
+                 [m  (str->msg n u (string-append ts sep txt))])
+            (check-not-false m)
+            (check-equal? (msg-nick m) n)
+            (check-equal? (msg-uri m) u)
+            (check-equal? (msg-text m) txt)
+            (check-equal? (msg-ts_rfc3339 m) ts (format "Given: ~v" ts))
+            )))
+
   (let* ([ts       "2020-11-18T22:22:09-0500"]
          [tab      "	"]
          [text     "Lorem ipsum"]
@@ -247,47 +271,58 @@
     (current-logger logger)))
 
 (module+ main
-  (require setup/getinfo)
+  (require (prefix-in info: setup/getinfo))
 
-  (current-http-client/response-auto #f)
-  (let* ([prog-name    "tt"]
-         [prog-version ((get-info (list prog-name)) 'version)]
-         [user-agent   (user-agent prog-name prog-version)])
-    (current-http-client/user-agent user-agent))
-  (let* ([use-cache
-           #f]
-         [log-level
-           'info]
-         [out-format
-           'multi-line]
-         [num_workers
-           15]) ; 15 was fastest out of the tried 1, 5, 10, 15 and 20.
+  (let ([log-level 'info])
     (command-line
+      #:program
+      "tt"
       #:once-each
-      [("-c" "--cached")
-       "Read cached data instead of downloading."
-       (set! use-cache #t)]
-
       [("-d" "--debug")
        "Enable debug log level."
        (set! log-level 'debug)]
-
-      [("-j" "--jobs")
-       njobs "Number of concurrent jobs."
-       (set! num_workers (string->number njobs))]
-
-      #:once-any
-      [("-s" "--short")
-       "Short output format"
-       (set! out-format 'single-line)]
-
-      [("-l" "--long")
-       "Long output format"
-       (set! out-format 'multi-line)]
-
-      #:args (filename)
-      (start-logger log-level)
-      (timeline-print out-format
-                      (timeline use-cache
-                                num_workers
-                                (file->feeds filename))))))
+      #:help-labels
+      ""
+      "and <command> is one of"
+      "r, read : Read the timeline."
+      ""
+      #:args (command . args)
+      (match command
+        [(or "r" "read")
+         (current-command-line-arguments (list->vector args))
+         (let ([use-cache
+                 #f]
+               [out-format
+                 'multi-line]
+               [num_workers
+                 ; 15 was fastest out of the tried 1, 5, 10, 15 and 20.
+                 15])
+           (command-line
+             #:program
+             "tt read"
+             #:once-each
+             [("-j" "--jobs")
+              njobs "Number of concurrent jobs."
+              (set! num_workers (string->number njobs))]
+             [("-c" "--cached")
+              "Read cached data instead of downloading."
+              (set! use-cache #t)]
+             #:once-any
+             [("-s" "--short")
+              "Short output format"
+              (set! out-format 'single-line)]
+             [("-l" "--long")
+              "Long output format"
+              (set! out-format 'multi-line)]
+             #:args (filename)
+             (start-logger log-level)
+             (current-http-client/response-auto #f)
+             (let* ([prog-name    "tt"]
+                    [prog-version ((info:get-info (list prog-name)) 'version)]
+                    [user-agent   (user-agent prog-name prog-version)])
+               (current-http-client/user-agent user-agent))
+             (timeline-print out-format
+                             (timeline use-cache
+                                       num_workers
+                                       (file->feeds filename)))))]
+        ))))