#!/bin/sh
: ; exec klone $0 "$@"
; The above line finds the klone executable in the $PATH

(setq USAGE
    "USAGE: fix-koala-bot [filename]
clean up a log file from the Koala Bot IRC Log
filename is modified in place. If no argument is given, acts as a filter
  - removes dates
  - aligns starts of texts
  - remove consecutive names if they are the same
  - prints time in pauses longer than 15mn
  - wraps lines")

;;=============================================================================
;;                    option parsing
;;=============================================================================

(setq arguments (getopts USAGE
    ("-fromuser" username from-user "lists all text from the last entry from this user")
))

(if (> (length arguments) 1)
  (progn (print-format *standard-error* "%0\n" USAGE) (exit 1)))

(setq file (getn arguments 0))

(if (and file (not (file-stats file)))
  (progn (print-format *standard-error* "file %0 do not exist\n" file) 
    (exit 1)))

;;=============================================================================
;;                    constants
;;=============================================================================

(setq re-header "^([[][^]]*[]] +[a-zA-Z]+ +[a-zA-Z]+ +[0-9]+ +[0-9]+:[0-9]+:[0-9]+ [0-9]+: )")
(setq re-named-line (regcomp (+ re-header "([<][^>]*[>]) (.*)$")))
(setq re-command-line (regcomp (+ re-header "([*][*][*]) (.*)$")))
(setq re-time (regcomp
    "^[[][^]]*[]] +[a-zA-Z]+ +[a-zA-Z]+ +[0-9]+ +(([0-9]+):([0-9]+)):"
))
(setq re-log-line (regcomp "^([<][^>]*[>]) (.*)$"))
(setq re-log-command (regcomp "^[*][ ]([^ ]+) (.*)$"))
(setq re-log-perso (regcomp "^[>] (.*)$"))

(defvar unknown-name "<???>")
(defvar user-name 
  (if (getenv "IRCNICK") (+ "<" (getenv "IRCNICK") ">")
    (getenv "USER") (+ "<" (getenv "USER") ">")
    "<Me>"
))
(setq latency 15)			;if no msgs in N minutes, prints hour
(setq old-name unknown-name)
(setq old-time -1000)
(setq max-name-length 3)
(setq lines (list))

;;=============================================================================
;;                    process file
;;=============================================================================

(defun main ()
  (setq fd (if file (open file) *standard-input*))
  ;; first, gobble up the whole file
  (while (setq line (read-line fd ()))
					;check time, prints if > latency
    (setq time old-time)
    (if (regexec re-time line) (progn
	(setq time-string (regsub re-time 1))
	(setq time (+ (* 60 (Int (regsub re-time 2)))
	    (Int (regsub re-time 3))))
	(if (> (- time old-time) latency) 
	  (put lines -1 (list "***" (+ "TIME: " time-string)))
	)
	(setq old-time time)
    ))
    
    (if 
      (regexec re-named-line line) (progn ;user texts
	(setq name (regsub re-named-line 2))
	(setq text (regsub re-named-line 3))
      )
      (regexec re-command-line line) (progn ;irc infos
	(setq name (regsub re-command-line 2))
	(setq text (regsub re-command-line 3))
      )
      (regexec re-log-line line) (progn	;lines from personal log files
	(setq name (regsub re-log-line 1))
	(setq text (regsub re-log-line 2))
      )
      (regexec re-log-command line) (progn ;actions from personal log files
	(setq name (+ "* " (regsub re-log-command 1)))
	(setq text (regsub re-log-command 2))
      )
      (regexec re-log-perso line) (progn	;lines from personal log files
	(setq name user-name)
	(setq text (regsub re-log-perso 1))
      )
      (progn				;trap ill-formed lines
	(setq name unknown-name)
	(setq text line))
    )
					;adds to the list of parsed lines
    (put lines -1 (list (if (= name old-name) "" name) text))
    (if (> (length name) max-name-length) (setq max-name-length (length name)))
    (setq old-name name)
  )
  
  (setq fd ())				;close fd
  
  ;; then truncate and rewrite it
  (setq fd (if file (open file :direction :output :if-exists :supersede)
      *standard-output*
  ))

  ;; from-user option
  (if from-user (setq lines (last-lines lines from-user)))

  ;; and prints, aligns and word-wraps all the texts
  (dolist (line lines)
    (print-format fd "%0%1 %2\n"
      (make-string (- max-name-length (length (getn line 0))))	;pad
      (getn line 0)				;name
      (fold-text (getn line 1) :margin (+ max-name-length 1)) ;text
  ))
  (flush fd)
)

;; useful func: word-wraps a text

(defvar fold-text:re (regcomp "^([^\n]*)\n?(.*)$"))
(defun fold-text (text &key (margin 0) (right-margin 78) &aux
    (lines (list))
    line
    (len (- right-margin margin))
    pos
    res
  )
  (while (> (length text) 0)
    (regexec fold-text:re text)
    (setq line (regsub fold-text:re 1))
    (setq text (regsub fold-text:re 2))
    (if (> (length line) len) (progn	;cut
	(setq pos len)
	(while (and (> pos 0) (/= #\  (getn line pos)))
	  (incf pos -1)
	)
	(if (<= pos 0) (progn
	    (setq pos len)
	    (insert line pos #\ )
	))
	(if (> pos 0) (progn
	    (setq text (+ (subseq line (+ pos 1)) " " text))
	    (setq line (subseq line 0 pos))
    ))))
    (put lines -1 line)	
  )
  (setq res (copy ""))
  (dolist (line lines)
    (if (> (length res) 0) (insert res -1 (+ "\n" (make-string margin))))
    (insert res -1 line)
  )
  res
)

;; list only lines after the last line of some user

(defun last-lines (lines user &aux last)
  (setq re-user (regcomp (re-nocase  (+ "^[<]" user "[>]$"))))
  (dotimes (n (length lines))
    (if (regexec re-user (getn (getn lines n) 0))
      (setq last n)
  ))
  (if last (setq lines (subseq lines last)))
  lines
)

;;; let's do it!
(main)

;;; EMACS MODES
;;; Local Variables: ***
;;; mode:lisp ***
;;; End: ***