#!/usr/bin/env gosh
;;;
;;; Test and bench march SKK server.
;;;  - Gauche script
;;;
;;; $Id: testskksv,v 1.6 2003/11/21 07:59:15 hos Exp $
;;;

(use srfi-1)
(use gauche.time)
(use gauche.net)
(use gauche.uvector)
(use gauche.parseopt)
(use slib)
(require 'printf)

(define repeat-num 5)

(define startup-timer (make <real-time-counter>))
(define request-timer (make <real-time-counter>))

(define hit-cnt 0)

(define (test-request key in out)
  (let ((reqstr (string-append "1" key " ")))
    (time-counter-start! request-timer)
    (display reqstr out) (flush out)
    (let* ((res1st (read-byte in))
	   (endbytes (if (= res1st #x31) ;if #\1
			 '(#x0a)
			 '(#x0a #x20)))
	   (res (let loop ((byte (read-byte in))
			   (res '()))
		  (if (memv byte endbytes)
		      res
		      (loop (read-byte in)
			    (cons byte res))))))
      (time-counter-stop! startup-timer)
      (time-counter-stop! request-timer)
      (let ((resstr (u8vector->string
		     (list->u8vector (cons res1st
					   (reverse res))))))
	(if (not (or (= res1st #x31)
		     (= res1st #x34)))
	    (errorf "wrong result: \"~a\", \"~a\""
		    reqstr resstr))
	(if (= res1st #x31)
	    (set! hit-cnt (+ hit-cnt 1)))))))

(define (main args)
  (let-args (cdr args)
      ((i4 "4|ipv4=ss")
       (i6 "6|ipv6=ss")
       (ux "u|unix=s"))
    (if (not (or i4 i6 ux))
	(format (current-error-port)
		"Usage: ~a [-4 HOST PORT] [-6 HOST PORT] [-u PATH]\n"
		*program-name*)
	(let* ((addr (or (and i4 (make <sockaddr-in>
				   :host (car i4)
				   :port (or (sys-getservbyname (cadr i4)
								"tcp")
					     (string->number (cadr i4))
					     (error "invalid port"
						    (cadr i4)))))
			 (and i6 (make <sockaddr-in6>
				   :host (car i6)
				   :port (or (sys-getservbyname (cadr i6)
								"tcp")
					     (string->number (cadr i6))
					     (error "invalid port"
						    (cadr i6)))))
			 (and ux (make <sockaddr-un>
				   :path ux))))
	       (key-list (port-fold cons '() read-line))
	       (num-of-key (length key-list)))
	  (let loop ((startup-time-list '())
		     (request-time-list '())
		     (cnt 1))
	    (format #t "starting test (~d/~d) ... " cnt repeat-num) (flush)
	    (set! hit-cnt 0)
	    (time-counter-reset! startup-timer)
	    (time-counter-reset! request-timer)
	    (time-counter-start! startup-timer)
	    (let* ((sock (make-client-socket addr))
		   (in (socket-input-port sock))
		   (out (socket-output-port sock :buffering :modest))
		   (test-proc (lambda (key) (test-request key in out))))
	      (for-each test-proc key-list)
	      (let ((startup-time (* (time-counter-value startup-timer) 1000))
		    (request-time (* (/ (time-counter-value request-timer)
					num-of-key) 1000)))
		(printf "done (%.3f/%.3f/%.2f)\n"
			startup-time request-time
			(* (/ hit-cnt num-of-key) 100))
		(flush)
		(if (< cnt repeat-num)
		    (begin
		      (display "0" out) (flush out)
		      (socket-close sock)
		      (loop (cons startup-time startup-time-list)
			    (cons request-time request-time-list)
			    (+ 1 cnt)))
		    (let* ((startup-time-list (cons startup-time
						    startup-time-list))
			   (request-time-list (cons request-time
						    request-time-list))
			   (sv-ver (begin
				     (display "2" out) (flush out)
				     (string-incomplete->complete
				      (read-block 4096 in))))
			   (sv-host (begin
				      (display "3" out) (flush out)
				      (string-incomplete->complete
				       (read-block 4096 in))))
			   (startup-time-avg
			    (/ (fold
				+ 0
				(cdr (reverse (cdr (sort startup-time-list)))))
			       (- repeat-num 2)))
			   (request-time-avg
			    (/ (fold
				+ 0
				(cdr (reverse (cdr (sort request-time-list)))))
			       (- repeat-num 2))))
		      (display "\n")
		      (printf "server                      : %a (%a)\n"
			      sv-ver sv-host)
		      (printf "total # of requests         : %d (%d x %d)\n"
			      (* num-of-key repeat-num) num-of-key repeat-num)
		      (printf "avg time for startup [ms]   : %9.3f\n"
			      startup-time-avg)
		      (printf "avg time for a request [ms] : %9.3f\n"
			      request-time-avg)
		      (printf "avg requests/sec            : %8.2f\n"
			      (/ 1000 request-time-avg))))))))))
  0)

;; Local variables:
;; mode: scheme
;; end: