#!/usr/bin/env gosh

(use srfi-19) ; for string->date
(use gauche.sequence) ; for group-collection

(define *time-template* "~d/~b/~Y:~H:~M:~S ~z") ; 24/Oct/2006:20:14:10 +0900
(define *regexp-safe*
  #/^(\S+) (\S+) (\S+) \[([^\]]+)\]/)
(define *regexp-combined* ; LogFormat "%h %l %u %t \"%r\" %>s %b \"%{Referer}i\" \"%{User-Agent}i\"" combined
  #/^(\S+) (\S+) (\S+) \[([^\]]+)\] \"([^\"]*)\" (\S+) (\S+) \"([^\"]*)\" \"([^\"]*)\"/)
(define *regexp-common* ; LogFormat "%h %l %u %t \"%r\" %>s %b" common
  #/^(\S+) (\S+) (\S+) \[([^\]]+)\] \"([^\"]*)\" (\S+) (\S+)/)

(define-class <access> ()
  ((host :init-keyword :host)
   (user :init-keyword :user)
   (time :init-keyword :time)
   (request :init-keyword :request)
   (status :init-keyword :status)
   (nbytes :init-keyword :nbytes)
   (referer :init-keyword :referer)
   (ua :init-keyword :ua)))

(define-method write-object ((c <access>) port)
  (format port "~a - ~a [~a] \"~a\" ~a ~a"
		  (ref c 'host)
		  (ref c 'user)
		  (date->string (ref c 'time) *time-template*)
		  (ref c 'request)
		  (ref c 'status)
		  (ref c 'nbytes)))

(define (preprocess-port iport)
  (let pp ((line (read-line iport)))
	(rxmatch-cond
	  (test (eof-object? line) (values #f #f))
	  (test (< 10240 (string-length line))
			(rxmatch-cond
			  ((rxmatch *regexp-safe* line)
			   (#f h l u t)
			   (values line (string->date t *time-template*)))
			  (else
			   (pp (read-line iport)))))
	  ((rxmatch *regexp-combined* line)
	   (#f h l u t r s b rfr ua)
	   (values line (string->date t *time-template*)))
	  ((rxmatch *regexp-common* line)
	   (#f h l u t r s b)
	   (values line (string->date t *time-template*)))
	  (else
	   (pp (read-line iport))))))

(define (port->nodes iport)
  (receive (line start)
	  (preprocess-port iport)
	(if (not line)
		(values #f #f #f)
		(let lp ((line line)
				 (end start)
				 (result '()))
		  (rxmatch-cond
			(test (eof-object? line)
				  (values result start end))
			(test (< 10240 (string-length line))
				  (rxmatch-cond
					((rxmatch *regexp-safe* line)
					 (#f h l u t)
					 (let ((temp (string->date t *time-template*)))
					   (lp (read-line iport)
						   temp
						   (cons (make <access>
								   :host h
								   :user u
								   :time temp)
								 result))))
					(else
					 (lp (read-line iport) end result))))
			((rxmatch *regexp-combined* line)
			 (#f h l u t r s b rfr ua)
			 (let ((temp (string->date t *time-template*)))
			   (lp (read-line iport)
				   temp
				   (cons (make <access>
						   :host h
						   :user u
						   :time temp
						   :request r
						   :status s
						   :nbytes b
						   :referer rfr
						   :ua ua)
						 result))))
			((rxmatch *regexp-common* line)
			 (#f h l u t r s b)
			 (let ((temp (string->date t *time-template*)))
			   (lp (read-line iport)
				   temp
				   (cons (make <access>
						   :host h
						   :user u
						   :time temp
						   :request r
						   :status s
						   :nbytes b)
						 result))))
			(else
			 (lp (read-line iport) end result)))))))

(define (log->nodes path) (call-with-input-file path port->nodes))

(define (main args)
  (define (usage)
	(format (current-error-port) "usage: log.scm <path>\n")
	(exit 1))
  (define hour=? (every-pred
				  (lambda (t1 t2)
					(= (date-day t1)
					   (date-day t2)))
				  (lambda (t1 t2)
					(= (date-hour t1)
					   (date-hour t2)))))
  (define (date<? d1 d2) (time<? (date->time-utc d1) (date->time-utc d2)))
  (define (put-date d)
	(format #t "---------------------------------------------------------------------- [~a]\n" (date->string d "~d/~b/~Y")))
  (case (length args)
	((1) (usage))
	((2) (receive (nodes start end)
			 (if (string=? "-" (cadr args))
				 (port->nodes (current-input-port))
				 (log->nodes (cadr args)))
		   (if (not nodes)
			   'exit
			   (let ((groups (group-collection nodes
											   :key (cut ref <> 'time)
											   :test hour=?))
					 (h (make-time 'time-duration 0 (* 60 60))))
				 (unless (= 0 (date-hour start)) (put-date start))
				 (let lp ((t start))
				   (cond ((and (date<? end t) (not (hour=? end t)))
						  'exit)
						 ((find (lambda (g) (hour=? t (ref (car g) 'time))) groups)
						  =>
						  (lambda (g)
							(let ((num (length g)))
							  (when (= 0 (date-hour t)) (put-date t))
							  (format #t "~2,'0d|~73a~7,d\n"
									  (date-hour t)
									  ;(make-string num #\*)
									  (make-string (inexact->exact (round (/ num 100))) #\*)
									  num))
							(lp (time-utc->date (add-duration (date->time-utc t) h)))))
						 (else
						  (when (= 0 (date-hour t)) (put-date t))
						  (format #t "~2,'0d|                                                                               0\n" (date-hour t))
						  (lp (time-utc->date (add-duration (date->time-utc t) h)))
						  )))
				 (format #t "total: ~d\n" (length nodes))))))
	(else (usage)))
  0)